diff options
64 files changed, 6302 insertions, 2508 deletions
diff --git a/macros/ar_psd.sci b/macros/ar_psd.sci index 540dfec..1953043 100644 --- a/macros/ar_psd.sci +++ b/macros/ar_psd.sci @@ -1,40 +1,263 @@ -function [P, F]= ar_psd(A, varargin) -//Calculate the power spectrum of the autoregressive model -//Calling Sequence -// [PSD,F_OUT]=ar_psd (A, V) -// [PSD,F_OUT]=ar_psd (A, V, FREQ) -// [PSD,F_OUT]=ar_psd (A, V, FREQ, FS) -// [PSD,F_OUT]=ar_psd (..., RANGE) -// [PSD,F_OUT]=ar_psd (..., METHOD) -// [PSD,F_OUT]=ar_psd (..., PLOTTYPE) -//Parameters -//A:List of M=(order+1) autoregressive model coefficients. The first element of "ar_coeffs" is the zero-lag coefficient, which always has a value of 1. -//V:Square of the moving-average coefficient of the AR model. -//FREQ:Frequencies at which power spectral density is calculated, or a scalar indicating the number of uniformly distributed frequency values at which spectral density is calculated. (default = 256) -//FS:Sampling frequency (Hertz) (default=1) -//Range: 'half', 'onesided' : frequency range of the spectrum is from zero up to but not including sample_f/2. Power from negative frequencies is added to the positive side of the spectrum.'whole', 'twosided' : frequency range of the spectrum is-sample_f/2 to sample_f/2, with negative frequencies stored in "wrap around" order after the positive frequencies; e.g. frequencies for a 10-point 'twosided' spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 'shift', 'centerdc' : same as 'whole' but with the first half of the spectrum swapped with second half to put the zero-frequency value in the middle. (See "help fftshift". If "freq" is vector, 'shift' is ignored. If model coefficients "ar_coeffs" are real, the default range is 'half', otherwise default range is 'whole'. -// Method:'fft': use FFT to calculate power spectrum. 'poly': calculate power spectrum as a polynomial of 1/z N.B. this argument is ignored if the "freq" argument is a vector. The default is 'poly' unless the "freq" argument is an integer power of 2. -// Plot type:'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db':specifies the type of plot. The default is 'plot', which means linear-linear axes. 'squared' is the same as 'plot'. 'dB' plots "10*log10(psd)". This argument is ignored and a spectrum is not plotted if the caller requires a returned value. -//PSD: estimate of power-spectral density -//F_OUT: frequency values -//Description -//If the FREQ argument is a vector (of frequencies) the spectrum is calculated using the polynomial method and the METHOD argument is ignored. For scalar FREQ, an integer power of 2, or METHOD = "FFT", causes the spectrum to be calculated by FFT. Otherwise, the spectrum is calculated as a polynomial. It may be computationally more efficient to use the FFT method if length of the model is not much smaller than the number of frequency values. The spectrum is scaled so that spectral energy (area under spectrum) is the same as the time-domain energy (mean square of the signal). -//Examples -//[a,b]= ar_psd([1,2,3],2) - - funcprot(0); - rhs= argn(2); - if(rhs <2 | rhs>5) - error("Wrong number of input arguments"); - end - select(rhs) - case 2 then - [P,F]= callOctave("ar_psd", A, varargin(1)); - case 3 then - [P,F]= callOctave("ar_psd", A, varargin(1), varargin(2)); - case 4 then - [P,F]= callOctave("ar_psd", A, varargin(1), varargin(2), varargin(3)); - case 5 then - [P,F]= callOctave("ar_psd", A, varargin(1), varargin(2), varargin(3), varargin(4)); - end +function varargout = ar_psd(a, v, varargin) +//Calculate the power spectrum of the autoregressive model. + +//Calling Sequence: +// [psd, f_out] = ar_psd(a, v) +// [psd, f_out] = ar_psd (a, v, freq) +// [psd, f_out] = ar_psd (a, v, freq, fs) +// [psd, f_out] = ar_psd (..., range) +// [psd, f_out] = ar_psd (..., method) +// [psd, f_out] = ar_psd (..., plottype) + +//Parameters: +//Every parameter except for the first two is optional. +// +//a- List of m=(order + 1) autoregressive model coefficients. The first element of "ar_coeffs" is the zero-lag coefficient, which always has a value of 1. +//v- Square of the moving-average coefficient of the AR model. +//freq: Frequencies at which power spectral density is calculated, or a scalar indicating the number of uniformly distributed frequency values at which spectral density is calculated. (default = 256) +//fs- Sampling frequency (Hertz) (default=1) +//range- 'half', 'onesided'- frequency range of the spectrum is from zero up to but not including sample_f/2. Power from negative frequencies is added to the positive side of the spectrum +//'whole', 'twosided'- frequency range of the spectrum is-sample_f/2 to sample_f/2, with negative frequencies stored in "wrap around" order after the positive frequencies; e.g. frequencies for a 10-point 'twosided' spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 +//'shift', 'centerdc'- same as 'whole' but with the first half of the spectrum swapped with second half to put the zero-frequency value in the middle. If "freq" is vector, 'shift' is ignored. If model coefficients "ar_coeffs" are real, the default range is 'half', otherwise default range is 'whole'. +//Method- +//'fft'- use fft to calculate power spectrum. +//'poly'- calculate power spectrum as a polynomial of 1/z N.B. this argument is ignored if the "freq" argument is a vector. The default is 'poly' unless the "freq" argument is an integer power of 2. +//Plot type- 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db': specifies the type of plot. The default is 'plot', which means linear-linear axes. +//'squared' is the same as 'plot'. 'dB' plots "10*log10(psd)". This argument is ignored and a spectrum is not plotted if the caller requires a returned value. +//psd: estimate of power-spectral density. +//f_out: frequency values. + +//Description: +//If the 'freq' argument is a vector (of frequencies) the spectrum is calculated using the polynomial method and the METHOD argument is ignored. For scalar 'freq', an integer power of 2, or method = "fft", causes the spectrum to be calculated by fft. Otherwise, the spectrum is calculated as a polynomial. It may be computationally more efficient to use the fft methodif length of the model is not much smaller than the number of frequency values. The spectrum is scaled so that spectral energy (area under spectrum) is the same as the time-domain energy (mean square of the signal). + +//Examples: +//[a,b]= ar_psd([1,2,3], 2) + + funcprot(0); + // Check fixed arguments + if nargin < 2 then + error("ar_psd: needs at least 2 args. Use help ar_psd."); + elseif ~isvector(a) | length(a) < 2 then + error("ar_psd: arg 1 (a) must be vector, length >= 2."); + elseif ~isscalar(v) then + error("ar_psd: arg 2 (v) must be real scalar >0."); + else + real_model = isreal(a); + // Default values for optional arguments + freq = 256; + user_freqs = 0; // Boolean: true for user-specified frequencies + Fs = 1.0; + // FFT padding factor (is also frequency range divisor): 1=whole, 2=half. + pad_fact = 1 + real_model; + do_shift = 0; + force_FFT = 0; + force_poly = 0; + plot_type = 1; + // Decode and check optional arguments + end_numeric_args = 0; + for iarg = 1:length(varargin) + arg = varargin(iarg); + end_numeric_args = end_numeric_args | (type(arg) == 10); + // Skip empty arguments + if isempty(arg) then + // Do nothing + elseif (type(arg) ~= 10) then + if end_numeric_args then + error("ar_psd: control arg must be string."); + // First optional numeric arg is "freq" + elseif iarg == 1 then + user_freqs = isvector(arg) & length(arg) > 1; + if ~isscalar(arg) & ~user_freqs then + error("ar_psd: arg 3 (freq) must be vector or scalar."); + elseif ~user_freqs & (~isreal(arg) | fix(arg) ~= arg | arg <= 2 | arg >= 1048576) then + error("ar_psd: arg 3 (freq) must be integer >=2, <=1048576"); + elseif user_freqs & ~isreal(arg) then + error("ar_psd: arg 3 (freq) vector must be real."); + end + freq = arg(:); // -> column vector + // Second optional numeric arg is "Fs" - sampling frequency + elseif iarg == 2 then + if ~isscalar(arg) | ~isreal(arg) | arg <= 0 then + error("ar_psd: arg 4 (Fs) must be real positive scalar."); + end + Fs = arg; + else + error("ar_psd: control arg must be string."); + end + // Decode control-string arguments + elseif ~strcmp(arg, "plot") | ~strcmp(arg, "squared") then + plot_type = 1; + elseif ~strcmp(arg, "semilogx") then + plot_type = 2; + elseif ~strcmp(arg, "semilogy") then + plot_type = 3; + elseif ~strcmp(arg, "loglog") then + plot_type = 4; + elseif ~strcmp(arg, "dB") then + plot_type = 5; + elseif ~strcmp(arg, "fft") then + force_FFT = 1; + force_poly = 0; + elseif ~strcmp(arg, "poly") then + force_FFT = 0; + force_poly = 1; + elseif ~strcmp(arg, "half") | ~strcmp(arg, "onesided") then + pad_fact = 2; // FFT zero-padding factor (pad FFT to double length) + do_shift = 0; + elseif ~strcmp(arg, "whole") | ~strcmp(arg, "twosided") then + pad_fact = 1; // FFT zero-padding factor (do not pad) + do_shift = 0; + elseif ~strcmp(arg, "shift") | ~strcmp(arg, "centerdc") then + pad_fact = 1; + do_shift = 1; + else + error("ar_psd: string arg: illegal value: %s", arg); + end + end + // End of decoding and checking args + if user_freqs then + // User provides (column) vector of frequencies + if or(abs(freq) > Fs/2) then + error("ar_psd: arg 3 (freq) cannot exceed half sampling frequency."); + elseif pad_fact == 2 & or(freq < 0) then + error("ar_psd: arg 3 (freq) must be positive in onesided spectrum"); + end + freq_len = length(freq); + fft_len = freq_len; + use_FFT = 0; + do_shift = 0; + else + // Internally generated frequencies + freq_len = freq; + freq = (Fs / pad_fact / freq_len) * (0:freq_len - 1)'; + // Decide which method to use (poly or FFT) + is_power_of_2 = modulo(log(freq_len), log(2)) < 10 * %eps; + use_FFT = (~force_poly & is_power_of_2) | force_FFT; + fft_len = freq_len * pad_fact; + end + // Calculate denominator of Equation 2.28, Kay and Marple, ref [1] Jr.: + len_coeffs = length(a); + if use_FFT then + // FFT method + x = [a(:); zeros(fft_len - len_coeffs, 1)]; + fft_out = fft(x); + else + // Polynomial method + // Complex data on "half" frequency range needs -ve frequency values + if pad_fact == 2 & ~real_model then + freq = [freq; -freq(freq_len:-1:1)]; + fft_len = 2 * freq_len; + end + fft_out = horner(a($:-1:1), exp((-%i * 2 * %pi / Fs) * freq)); + end + // The power spectrum (PSD) is the scaled squared reciprocal of amplitude + // of the FFT/polynomial. This is NOT the reciprocal of the periodogram. + // The PSD is a continuous function of frequency. For uniformly + // distributed frequency values, the FFT algorithm might be the most + // efficient way of calculating it. + psd = (v / Fs) ./ (fft_out .* conj(fft_out)); + // Range='half' or 'onesided', + // Add PSD at -ve frequencies to PSD at +ve frequencies + // N.B. unlike periodogram, PSD at zero frequency _is_ doubled. + if pad_fact == 2 then + freq = freq(1:freq_len); + if real_model then + // Real data, double the psd + psd = 2 * psd(1:freq_len); + elseif use_FFT then + // Complex data, FFT method, internally-generated frequencies + psd = psd(1:freq_len) + [psd(1); psd(fft_len:-1:freq_len + 2)]; + else + // Complex data, polynomial method + // User-defined and internally-generated frequencies + psd = psd(1:freq_len) + psd(fft_len:-1:freq_len + 1); + end + // Range='shift' + // Disabled for user-supplied frequencies + // Shift zero-frequency to the middle (pad_fact == 1) + elseif do_shift then + len2 = fix((fft_len + 1) / 2); + psd = [psd(len2 + 1:fft_len); psd(1:len2)]; + freq = [freq(len2 + 1:fft_len) - Fs; freq(1:len2)]; + end + // Plot the spectrum if there are no return variables. + if nargout() >= 2 then + varargout(1) = psd; + varargout(2) = freq; + elseif nargout() == 1 then + varargout(1) = psd; + else + if plot_type == 1 then + plot(freq, psd); + elseif plot_type == 2 then + semilogx(freq, psd); + elseif plot_type == 3 then + semilogy(freq, psd); + elseif plot_type == 4 then + loglog(freq, psd); + elseif plot_type == 5 then + plot(freq, 10 * log10(psd)); + end + end + end endfunction + +//tests: + +//a = [1, -0.5]; +////v = 1; +//[psd, freq] = ar_psd(a, v); +//plot(freq, psd); +//title('Power Spectral Density of the AR Model'); +//xlabel('Frequency'); +//ylabel('Power/Frequency'); + +//a = [1, -1.5, 0.7]; +//v = 2; +//Fs = 2.0; +//[psd, freq] = ar_psd(a, v, 512, Fs); +//plot(freq, psd); +//title('Power Spectral Density with Different Sampling Frequency'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency'); + +//a = [1, -0.9, 0.4]; +//v = 0.8; +//Fs = 1.0; +//ar_psd(a, v, 512, Fs, 'semilogx'); +//title('Power Spectral Density (Semilogx)'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency'); +// +//figure(); +//ar_psd(a, v, 512, Fs, 'loglog'); +//title('Power Spectral Density (Loglog)'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency'); + +//a = [1, -0.7, 0.2]; +//v = 1.5; +//Fs = 1.0; +//[psd_fft, freq] = ar_psd(a, v, 512, Fs, 'fft'); +//[psd_poly, freq] = ar_psd(a, v, 512, Fs, 'poly'); +//plot(freq, psd_fft, 'r', freq, psd_poly, 'b'); +//title('Power Spectral Density (FFT vs Polynomial)'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency'); +//legend('FFT Method', 'Polynomial Method'); + +//a = [1, -1.2, 0.5]; +//v = 1; +//[psd_half, freq_half] = ar_psd(a, v, 512, 1, 'half'); +//[psd_whole, freq_whole] = ar_psd(a, v, 512, 1, 'whole'); +//subplot(2, 1, 1); +//plot(freq_half, psd_half); +//title('Power Spectral Density (Half Spectrum)'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency'); +// +//subplot(2, 1, 2); +//plot(freq_whole, psd_whole); +//title('Power Spectral Density (Whole Spectrum)'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency'); diff --git a/macros/arma_rnd.sci b/macros/arma_rnd.sci index 5e9ca12..fb428cc 100644 --- a/macros/arma_rnd.sci +++ b/macros/arma_rnd.sci @@ -1,27 +1,20 @@ +function x = arma_rnd (a, b, v, t, n) //Return a simulation of the ARMA model. - -//Calling Sequence +//Calling Sequence: //arma_rnd (a, b, v, t, n) //arma_rnd (a, b, v, t) - -//Parameters -//a: vector -//b: vector +//Parameters: +//a: Real vector +//b: Real vector //v: Variance //t: Length of output vector //n: Number of dummy x(i) used for initialization - -//Description -//This is an Octave function. -//The ARMA model is defined by -// -//x(n) = a(1) * x(n-1) + … + a(k) * x(n-k) -// + e(n) + b(1) * e(n-1) + … + b(l) * e(n-l) +//Description: +//The ARMA model is defined by x(n) = a(1) * x(n-1) + … + a(k) * x(n-k) + e(n) + b(1) * e(n-1) + … + b(l) * e(n-l) //in which k is the length of vector a, l is the length of vector b and e is Gaussian white noise with variance v. The function returns a vector of length t. -// -//The optional parameter n gives the number of dummy x(i) used for initialization, i.e., a sequence of length t+n is generated and x(n+1:t+n) is returned. If n is omitted, n = 100 is used. - -//Examples +//The optional parameter n gives the number of dummy x(i) used for initialization, i.e., a sequence of length t+n is generated and x(n+1:t+n) is returned. +//If n is omitted, n = 100 is used. +//Examples: //a = [1 2 3 4 5]; //b = [7 8 9 10 11]; //v = 10; @@ -30,36 +23,13 @@ //arma_rnd (a, b, v, t, n) //Output : // ans = -// // 61400.907 // 158177.11 // 407440.29 // 1049604. // 2703841.3 - -//function res = arma_rnd (a, b, v, t, n) -//funcprot(0); -//lhs = argn(1) -//rhs = argn(2) -//if (rhs < 5 | rhs > 6) -//error("Wrong number of input arguments.") -//end -// -//select(rhs) -// -// case 5 then -// res = callOctave("arma_rnd",a, b, v, t) -// -// case 6 then -// res = callOctave("arma_rnd",a, b, v, t, n) -// -// end -//endfunction - -function x = arma_rnd (a, b, v, t, n) - - funcprot(); + funcprot(0); [nargout,nargin] = argn() ; if (nargin == 4) @@ -69,7 +39,7 @@ function x = arma_rnd (a, b, v, t, n) error ("arma_rnd: N must be a scalar"); end else - error("arma_rnd: invalid input"); + error("Wrong number of input arguments."); end if ((min (size (a)) > 1) | (min (size (b)) > 1)) @@ -85,16 +55,31 @@ function x = arma_rnd (a, b, v, t, n) a = matrix (a, ar, 1); b = matrix (b, br, 1); - - // Apply our notational convention. a = [1; -a]; b = [1; b]; n = min (n, ar + br); - e = sqrt (v) * rand(t + n, 1); x = filter (b, a, e); x = x(n + 1 : t + n); endfunction + +//input validation: +//a = [1, 2, 3, 4]; +//b = [5, 6, 7]; +//assert_checkerror("arma_rnd()", "Wrong number of input arguments."); +//assert_checkerror("arma_rnd(1, 2, 3, 4, 5, 6)", "Wrong number of input arguments."); +//assert_checkerror("arma_rnd(a, b, 5, 2, a);", "arma_rnd: N must be a scalar"); +//assert_checkerror("arma_rnd(a, b, 5, a);", "arma_rnd: T must be a scalar"); +//assert_checkerror("arma_rnd([1 2; 3 4], [5 6; 7 8], 5, 1);", "arma_rnd: A and B must not be matrices"); + +//tests: +//NOTE: The output of arma_rnd is supposed to be random, so we cannot expect the same output for equivalent input. +//a = [1, 2, 3, 4]; +//b = [5, 6, 7, 8]; +//assert_checkequal(size(arma_rnd(a, b, 5, 1)), [1 1]); +//assert_checkequal(size(arma_rnd(a, b, 5, 2, 100)), [2 1]); +//assert_checkequal(size(arma_rnd(a', b', 1, 10, 50)), [10 1]); +//assert_checkequal(size(arma_rnd(a, b', 1, 4, 5)), [4 1]); diff --git a/macros/autoreg_matrix.sci b/macros/autoreg_matrix.sci index 2b70ced..95eb356 100644 --- a/macros/autoreg_matrix.sci +++ b/macros/autoreg_matrix.sci @@ -1,59 +1,53 @@ +function x = autoreg_matrix (y, k) // Given a time series (vector) Y, return a matrix with ones in the first column and the first K lagged values of Y in the other columns. - -//Calling Sequence +//Calling Sequence: //autoreg_matrix(Y, K) - -//Parameters -//Y: Vector -//K: Scalar or Vector - -//Description +//Parameters: +//Y: vector +//K: scalar +//Description: // Given a time series (vector) Y, return a matrix with ones in the first column and the first K lagged values of Y in the other columns. -// //In other words, for T > K, '[1, Y(T-1), ..., Y(T-K)]' is the t-th row of the result. -// //The resulting matrix may be used as a regressor matrix in autoregressions. - -//Examples -//autoreg_matrix([1,2,3],2) +//Examples: +//autoreg_matrix([1,2,3], 2) //ans = // 1. 0. 0. // 1. 1. 0. // 1. 2. 1. - - -//function y = autoreg_matrix(Y, varargin) -//funcprot(0); -//rhs = argn(2) -//if(rhs<2 | rhs>2) -//error("Wrong number of input arguments."); -//end -// -// select(rhs) -// case 2 then -// y = callOctave("autoreg_matrix", Y, varargin(1)); -// end -//endfunction - -function X = autoreg_matrix (y, k) - funcprot(0); - [nargout, nargin] = argn() ; - if (nargin ~= 2) - error('autoreg_matrix: invalid input') ; + if (argn(2) ~= 2) + error("autoreg_matrix: wrong number of input arguments") ; end if (~ (isvector (y))) - error ("autoreg_matrix: Y must be a vector"); + error ("autoreg_matrix: y must be a vector"); end T = length (y); y = matrix(y, T, 1); - X = ones (T, k+1); - for j = 1 : k; - X(:, j+1) = [(zeros (j, 1)); y(1:T-j)]; + x = ones (T, k+1); + for j = 1 : k + x(:, j+1) = [(zeros(j, 1)); y(1:T-j)]; end endfunction + +//input validation: +//assert_checkerror("autoreg_matrix(1)", "autoreg_matrix: wrong number of input arguments"); +//assert_checkerror("autoreg_matrix(1, 2, 3)", "Wrong number of input arguments."); +//assert_checkerror("autoreg_matrix(1, 2)", "autoreg_matrix: y must be a vector"); +//assert_checkerror("autoreg_matrix([1, 2; 3, 4], 2)", "autoreg_matrix: y must be a vector"); + +//tests: +//assert_checkequal(autoreg_matrix([1, 2], -1), []); +//assert_checkequal(autoreg_matrix([1, 2, 3], 2), [1, 0, 0; 1, 1, 0; 1, 2, 1]); +//assert_checkequal(autoreg_matrix([1, 2, 3], 2), autoreg_matrix([1; 2; 3], 2)); +//assert_checkequal(autoreg_matrix([1, 2, 3, 4, 5], 0), [1; 1; 1; 1; 1]); +//assert_checkequal(autoreg_matrix([-1; -3; -5; -7; -9], 5), [1 0 0 0 0 0;1 -1 0 0 0 0;1 -3 -1 0 0 0;1 -5 -3 -1 0 0;1 -7 -5 -3 -1 0]) +//assert_checkequal(autoreg_matrix([1+2*%i, 5+4*%i, -4*%i, -1-6*%i], 1), [1, 0; 1, 1 + 2*%i; 1, 5 + 4*%i; 1, -4*%i]); +//assert_checkequal(autoreg_matrix([1+2*%i, 5+4*%i, -4*%i, -1-6*%i], 3), autoreg_matrix([1+2*%i; 5+4*%i; -4*%i; -1-6*%i], 3)); +//assert_checkequal(autoreg_matrix([-%i; -3-%i; 5+6*%i; 7+9*%i;], 3), [1 0 0 0;1 -%i 0 0;1 -3-%i -%i 0;1 5+6*%i -3-%i -%i]); +//assert_checkequal(autoreg_matrix([-%i; -3-%i; 5+6*%i; 7+9*%i;], 0), [1; 1; 1; 1]); diff --git a/macros/besselap.sci b/macros/besselap.sci index 2ed0047..1e7d952 100644 --- a/macros/besselap.sci +++ b/macros/besselap.sci @@ -1,17 +1,14 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt -// Original contribution: FOSSEE, IIT Bombay // Original Source : https://octave.sourceforge.io/signal/ -// Modifieded by: Sonu Sharma, RGIT Mumbai +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - - function [zero, pole, gain]=besselap(n) //Bessel analog filter prototype. @@ -44,38 +41,44 @@ function [zero, pole, gain]=besselap(n) // zero = // // [] - + // Dependencies + // prepad funcprot(0); [nargout, nargin] = argn() ; - if (nargin>1 | nargin<1) error("besselap : wrong number of input argument") end - // interpret the input parameters if (~(length(n)==1 & n == round(n) & n > 0)) error ("besselap: filter order n must be a positive integer"); end - p0=1; p1=[1 1]; for nn=2:n px=(2*nn-1)*p1; py=[p0 0 0]; - px=prepad(px,max(length(px),length(py)),0); + px=prepad(px,max(length(px),length(py))); py=prepad(py,length(px)); p0=p1; p1=px+py; end // p1 now contains the reverse bessel polynomial for n - // scale it by replacing s->s/w0 so that the gain becomes 1 p1=p1.*p1(length(p1)).^((length(p1)-1:-1:0)/(length(p1)-1)); - zero=[]; pole=roots(p1); gain=1; - endfunction + +/* +Note : The function is tested with Octave's outputs as a reference. +# all passed +[zero, pole, gain] = besselap (1) +[zero, pole, gain] = besselap (2) +[zero, pole, gain] = besselap (7) +[zero, pole, gain] = besselap (13) +[zero, pole, gain] = besselap (43) + +*/
\ No newline at end of file diff --git a/macros/besself.sci b/macros/besself.sci index c52f3ac..a6eef80 100644 --- a/macros/besself.sci +++ b/macros/besself.sci @@ -1,15 +1,14 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt // Original Source : https://octave.sourceforge.io/signal/ -// Modifieded by:Sonu Sharma, RGIT Mumbai +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - function [a, b, c, d] = besself (n, w, varargin) //Bessel filter design. @@ -20,22 +19,17 @@ function [a, b, c, d] = besself (n, w, varargin) //[b, a] = besself (n, [Wl, Wh], "stop") //[z, p, g] = besself (…) //[…] = besself (…, "z") - - //Parameters //n: positive integer value (order of filter) //Wc: positive real value, // 1).Analog 3dB cutoff frequency/frequencies for analog filter, in the range [0, Inf] {rad/sec} // 2).Normalised digital 3dB cutoff frequency/frequencies for digital filter, in the range [0, 1] {dimensionless} - //Description //This function generates a Bessel filter. The default is a Laplace space (s) or analog filter. //If second argument is scalar the third parameter takes in high or low, the default value being low. The cutoff is Wc rad/sec. //If second argument is vector of length 2 ie [Wl Wh] then third parameter may be pass or stop default is pass for bandpass and band reject filter respectively //[z,p,g] = besself(...) returns filter as zero-pole-gain rather than coefficients of the numerator and denominator polynomials. //[...] = besself(...,’z’) returns a discrete space (Z) filter. Wc must be less than 1 {dimensionless}. - - //Examples //[b, a]=besself(2,.3,"high","z") //Output : @@ -46,14 +40,14 @@ function [a, b, c, d] = besself (n, w, varargin) // // 0.4668229 - 0.9336457 0.4668229 // - + // Dependencies + // besselap bilinear sftrans zp2tf funcprot(0); [nargout nargin] = argn(); if (nargin > 4 | nargin < 2 | nargout > 4 | nargout < 2) error("besself: invalid number of inputs") end - // interpret the input parameters if (~ (isscalar (n) & (n == fix (n)) & (n > 0))) error ("besself: filter order N must be a positive integer"); @@ -79,14 +73,13 @@ function [a, b, c, d] = besself (n, w, varargin) error ("besself: expected [high|stop] or [s|z]"); end end - // FIXME: Band-pass and stop-band currently non-functional, remove // this check once low-pass to band-pass transform is implemented. if (~ isscalar (w)) error ("besself: band-pass and stop-band filters not yet implemented"); end - [rows_w colums_w] = size(w); + [rows_w columns_w] = size(w); if (~ ((length (w) <= 2) & (rows_w == 1 | columns_w == 1))) error ("besself: frequency must be given as WC or [WL, WH]"); @@ -115,7 +108,6 @@ function [a, b, c, d] = besself (n, w, varargin) if (digital) [zero, pole, gain] = bilinear (zero, pole, gain, T); end - // convert to the correct output form if (nargout == 2) // a = real (gain * poly (zero)); @@ -127,7 +119,28 @@ function [a, b, c, d] = besself (n, w, varargin) c = gain; else // output ss results - // [a, b, c, d] = zp2ss (zero, pole, gain); + // FIXME : test zp2ss + //[a, b, c, d] = zp2ss (zero, pole, gain); error("besself: yet not implemented in state-space form OR invalid number of o/p arguments") end endfunction + +/* +Note : This function is tested with Octave's outputs as a reference. +# Test input validation +[a, b] = besself () // error passed +[a, b] = besself (1) // error passed +[a, b] = besself (1, 2, 3, 4, 5) // error passed +[a, b] = besself (.5, .2) // error passed +[a, b] = besself (3, .2, "invalid") // error passed + //[b, a] = besself(n, Wc) +[b a] = besself(2,1000) // passed +//[b, a] = besself (n, Wc, "high") +[b a] = besself(7,0.3,"high") // passed +//[b, a] = besself (n, [Wl, Wh]) +[b a] = besself(4,[1000 5000]) // error: besself: band-pass and stop-band filters not yet implemented +//[b, a] = besself (n, [Wl, Wh], "stop") +[b a] = besself(4,[1000 5000],"stop") // besself: band-pass and stop-band filters not yet implemented +//[z, p, g] = besself (…) +[z,p,g] = besself(9,0.8,"high") // passed +*/
\ No newline at end of file diff --git a/macros/bilinear.sci b/macros/bilinear.sci index d1ee3f7..1aa408a 100644 --- a/macros/bilinear.sci +++ b/macros/bilinear.sci @@ -1,15 +1,14 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt // Original Source : https://octave.sourceforge.io/signal/ -// Modifieded by:Sonu Sharma, RGIT Mumbai +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - function [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) //Transforms a s-plane filter (Analog) into a z-plane filter (Digital) using Bilinear transformation @@ -48,13 +47,15 @@ function [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) // b = // // 0. - 0.1666667 - 0.3333333 2.5 - + // Dependencies + // tf2zp postpad zp2tf prepad funcprot(0); [nargout nargin] = argn(); ieee(2); if nargin==3 T = Sg; + // FIXME : tf2zp is not tested yet [Sz, Sp, Sg] = tf2zp(Sz, Sp); elseif nargin~=4 error("bilinear: invalid number of inputs") @@ -77,9 +78,6 @@ function [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) if Zg == 0 & nargout == 3 then error("bilinear: invalid value of gain due to zero(s) at infinity avoid z-p-g form and use tf form ") end - - - Zp = (2+Sp*T)./(2-Sp*T); SZp = size(Zp); if isempty(Sz) @@ -88,8 +86,6 @@ function [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) Zz = [(2+Sz*T)./(2-Sz*T)]; Zz = postpad(Zz, p, -1); end - - if nargout==2 // zero at infinity Zz1 = []; @@ -115,3 +111,17 @@ function [Zz, Zp, Zg] = bilinear(Sz, Sp, Sg, T) end ieee(0); endfunction +/* +// FIXME- not working with three argument + +Note : This function is tested with Octave's outputs as a reference. + +[Zb,Za] = bilinear([1 0],[1 1],1,0.5) // passed +[Zb, Za] = bilinear([], [], 1, 1) // error PASSED +[Zb, Za] = bilinear([0], [], 1, 0.5) // error PASSED +[Zb, Za] = bilinear([], [0], 1, 0.5) // PASSED + +[Zb, Za] = bilinear([2], [1], 1, 0.5) // PASSED +[Zb, Za] = bilinear([1; -1], [0.5; -0.5], 2, 1) //PASSED +[Zb, Za] = bilinear([0], [1], 1, 1) //PASSED +*/
\ No newline at end of file diff --git a/macros/bitrevorder.sci b/macros/bitrevorder.sci index cf27cd8..7ffe2ec 100644 --- a/macros/bitrevorder.sci +++ b/macros/bitrevorder.sci @@ -1,54 +1,48 @@ -// Returns input data in bit-reversed order - -// Calling Sequence -//[y,i] = bitrevorder(x) -//y = bitrevorder(x) - -// Parameters -//x: Vector of real or complex values -//y: input vector in bit reverse order -//i: indices - -// Description -//This function returns the input data after reversing the bits of the indices and reordering the elements of the input array. - -// Examples -//x = [%i,1,3,6*%i] ; -//[y i]=bitrevorder(x) -//Output : -// i = -// -// 1. 3. 2. 4. -// y = -// -// i 3. 1. 6.i - - -//************************************************************************************* -//-------------------version1 (using callOctave / errored)----------------------------- -//************************************************************************************* - -//function [y,i]=bitrevorder(x) -//funcprot(0); -//[lhs,rhs]=argn(0); -//if (rhs<1) then -// error ("Wrong number of input arguments.") -//end -//[y,i]=callOctave("bitrevorder",x) -// -//endfunction - -//************************************************************************************* -//-----------------------------version2 (pure scilab code)----------------------------- -//************************************************************************************* +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in function [y, i] = bitrevorder (x) + // Returns input data in bit-reversed order + // + // Calling Sequence + //[y,i] = bitrevorder(x) + //y = bitrevorder(x) + + // Parameters + //x: Vector of real or complex values + //y: input vector in bit reverse order + //i: indices + + // Description + //This function returns the input data after reversing the bits of the indices and reordering the elements of the input array. + + // Examples + //x = [%i,1,3,6*%i] ; + //[y i]=bitrevorder(x) + //Output : + // i = + // + // 1. 3. 2. 4. + // y = + // + // i 3. 1. 6.i + // Dependencies + // digitrevorder funcprot(0); [nargout, nargin] = argn() ; if (nargin ~= 1) - print_usage (); - elseif (~ isvector (x)) + error("bitrevorder: Usage : [ y , i ] = bitrevorder(x) "); + elseif ( ~isvector(x) & ~isscalar(x) ) error ("bitrevorder: X must be a vector"); elseif (fix (log2 (length (x))) ~= log2 (length (x))) error ("bitrevorder: X must have length equal to an integer power of 2"); @@ -57,3 +51,22 @@ function [y, i] = bitrevorder (x) [y, i] = digitrevorder (x, 2); endfunction +/* +tests +assert_checkequal (bitrevorder (0), 0); //passed +assert_checkequal (bitrevorder (0:1), 0:1); //passed +assert_checkequal (bitrevorder ([0:1]'), [0:1]'); //passed +assert_checkequal (bitrevorder (0:7), [0 4 2 6 1 5 3 7]); //passed +assert_checkequal (bitrevorder ([0:7]'), [0 4 2 6 1 5 3 7]'); // passed +assert_checkequal (bitrevorder ([0:7]*%i), [0 4 2 6 1 5 3 7]*%i); // passed +assert_checkequal (bitrevorder ([0:7]'*%i), [0 4 2 6 1 5 3 7]'*%i); // passed +assert_checkequal (bitrevorder (0:15), [0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15]); //passed + + Test input validation + // error testing +assert_checkerror (bitrevorder ()); +assert_checkerror bitrevorder (1, 2); +assert_checkerror bitrevorder ([]); +assert_checkerror bitrevorder (0:2); + +*/
\ No newline at end of file diff --git a/macros/cceps.sci b/macros/cceps.sci index f026256..b87d4bf 100644 --- a/macros/cceps.sci +++ b/macros/cceps.sci @@ -1,63 +1,75 @@ -function y = cceps (x,correct) -//Return the complex cepstrum of the vector x -//Calling Sequence +function y = cceps(x, correct) +//Return the complex cepstrum of the vector x. +//Calling Sequence: //cceps (x) //cceps(x, correct) -//Parameters -//x: vector. -//correct: if 1, a correction method is applied. -//Description -//This function return the complex cepstrum of the vector x. If the optional argument correct has the value 1, a correction method is applied. The default is not to do this. -//Examples -//cceps([1,2,3],1) -//ans = 1.9256506 - // 0.9634573 -// - 1.0973484 - -if(argn(2)<1 | argn(2)>2) -error("Wrong number of input arguments.") -end - if argn(2)==1 then - correct=0; -end - - [r, c]=size(x) - if (c ~= 1) +//Parameters: +//x: vector +//correct: If 1, a correction method is applied. +//Description: +//This function return the complex cepstrum of the vector x. +//If the optional argument correct has the value 1, a correction method is applied. The default is not to do this. +//Examples: +//cceps([1,2,3], 1) +//ans = 1.9256506 +// 0.9634573 +// -1.0973484 + + if(argn(2) < 1 | argn(2) > 2) + error("Wrong number of input arguments."); + end + + if (argn(2) == 1) + correct = 0; + end + + [r, c] = size(x); + if (c ~= 1) if (r == 1) - x = x; + x = x'; r = c; else error ("x must be a vector"); end end - - F = fft1(x); - if (min (abs (F)) == 0) - error ('bad signal x, some Fourier coefficients are zero.'); + + F = fft(x); + if (min(abs(F)) == 0) + error('bad signal x, some Fourier coefficients are zero.'); end - h = fix (r / 2); + + h = fix (r / 2); cor = 0; - if (2 * h == r) - cor = (c & (real (F (h + 1)) < 0)); + if (2*h == r) + cor = (correct & (real(F(h + 1)) < 0)); if (cor) - F = fft1 (x(1:r-1)) - if (min (abs (F)) == 0) - error ('bad signal x, some Fourier coefficients are zero.'); + F = fft(x(1:r-1)); + if (min(abs(F)) == 0) + error('bad signal x, some Fourier coefficients are zero.'); end end end - y = fftshift1 (ifft1 ((log (F))')); + y = fftshift(ifft((log (F)))); - //## make result real - if (c) - y = real (y); + if (correct) + y = real(y); if (cor) - // ## make cepstrum of same length as input vector y (r) = 0; end end - endfunction +//input validation: +//assert_checkerror("cceps()", "Wrong number of input arguments."); +//assert_checkerror("cceps(1, 2, 3)", "Wrong number of input arguments."); +//assert_checkerror("cceps([1, 2; 3, 4])", "x must be a vector"); +//assert_checkerror("cceps(0)", 'bad signal x, some Fourier coefficients are zero.'); +//assert_checkerror("cceps(zeros(10, 1))", 'bad signal x, some Fourier coefficients are zero.'); +//tests: +//assert_checkalmostequal(cceps([1, 2, 3]), [1.9257; 0.9635; -1.0973], 0.5*10^-4); +//assert_checkequal(cceps([1, 2, 3]), cceps([1, 2, 3], 1)); +//assert_checkequal(cceps([-1, -2, -3]), cceps([-1; -2; -3])); +//assert_checkalmostequal(cceps([1+2*%i; -2-2*%i; -3+2*%i]), [0.4734+1.1174*%i; 1.2144+1.5358*%i; -0.1899+0.0247*%i], 5*10^-3); +//assert_checkalmostequal(cceps([1+2*%i; -2-2*%i; -3+2*%i], 1), [0.4734; 1.2144; -0.1899], 5*10^-4); diff --git a/macros/cell2sos.sci b/macros/cell2sos.sci index 39402b3..7cd657d 100644 --- a/macros/cell2sos.sci +++ b/macros/cell2sos.sci @@ -1,95 +1,110 @@ -function [s,g] = cell2sos(c) -//Converts a cell array to a second order section matrix -//Calling Sequences -//s=cell2sos(c) -//[s,g]=cell2sos(c) -//Parameters -//c -//A cell array -//g -//The scalar gain -//Description -//s=cell2sos(c) converts a a cell array c = { {B1},{A1}, {B2},{A2}, ... {BL},{AL}} -//to an L-by-6 second-order-section matrix s given by: -// s = [B1 A1 -// B2 A2 -// ... -// BL AL] -//numerator vector Bi and denominator vector Ai contains the coefficients of a -//linear or quadratic polynomial. If the polynomial is linear, the coefficients -//zero-padded on the right. -//[s,g]=cell2sos(c) estimates the gain from the leading term of the cell array -//c={ {[g1,g2]},{B1},{A1}, {B2},{A2}, ... {BL},{AL}} to give g=g1/g2 as the gain -//Example -//c=cell(1,5); -// -//c(1,1).entries=[2, 1]; -// -//c(1,2).entries=rand(1,3); -// -//c(1,3).entries=rand(1,3); -// -//c(1,4).entries=rand(1,3); -// -//c(1,5).entries=rand(1,3); -// -// c = -// column 1 to 3 -// -//![2,1] [0.2113249,0.7560439,0.0002211] [0.3303271,0.6653811,0.6283918] ! -// -// column 4 to 5 -// -//![0.8497452,0.6857310,0.8782165] [0.0683740,0.5608486,0.6623569] ! -//[s,g]=cell2sos(c); -//s = -// -// column 1 to 5 -// -// 0.2113249 0.7560439 0.0002211 0.3303271 0.6653811 -// 0.8497452 0.6857310 0.8782165 0.0683740 0.5608486 -// -// column 6 -// -// 0.6283918 -// 0.6623569 -// -//g = -// -// 2. -//Author -//Ankur Mallick - if(argn(2)~=1) then - error("Wrong number of input arguments"); - end +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Author: Abinash Singh Under FOSSEE Internship +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +/* +Calling Sequence : + sos = cell2sos(cll) + [sos,g] = cell2sos(cll) +Description + sos = cell2sos(cll) generates a matrix sos containing the coefficients of the filter system described by the second-order section cell array cll. + [sos,g] = cell2sos(cll) also returns the scale gain g. + + Second-order section cell-array representation, specified as a cell array. + +Input Argument: + For a filter system with L sections, specify 'cll' using this structure: + + * Cell array with L elements — For unity-gain filter systems. Each element of the cell + array corresponds to a second-order section. The kth cell array element of 'cll' + + cll{k} = {[b_0k b_1k b_2k] [1 a_1k a_2k]} + + contains the coefficients from the kth second-order-section of the filter system H(z): + + H(z) = product(k=1 to L) H_k(z) + = product(k=1 to L) (b_0k + b_1k*z^(-1) + b_2k*z^(-2))/(1 + a_1k*z^(-1) + a_2k*z^(-2)) + + * Cell array with L+1 elements — If the gain of the filter system is different from 1. + The first element of 'cll' contains the system gains at the numerator (g_n) and at + the denominator (g_d). Then, the function appends each element of the cell array for + the corresponding second-order section. + + The first and the k+1th cell array element of 'cll' - L=prod(size(c)); - for i=1:L - if(type(c(i))~=17) - error('Cell contents must themselves be cell objects'); + cll{1} = {g_n g_d} + cll{k+1} = {[b_0k b_1k b_2k] [1 a_1k a_2k]} + + contain the system gain and the coefficients from the kth second-order section of + the filter system H(z), respectively, such that: + + H(z) = (g_n/g_d) * product(k=1 to L) H_k(z) + = (g_n/g_d) * product(k=1 to L) (b_0k + b_1k*z^(-1) + b_2k*z^(-2))/(1 + a_1k*z^(-1) + a_2k*z^(-2)) + +Output Argument: + Second-order section representation, returned as an L-by-6 matrix, where L is the + number of second-order sections. The matrix + + sos = [b_01 b_11 b_21 1 a_11 a_21] + [b_02 b_12 b_22 1 a_12 a_22] + [ ⋮ ⋮ ⋮ ⋮ ⋮ ⋮ ] + [b_0L b_1L b_2L 1 a_1L a_2L] + + represents the second-order sections of H(z): + + H(z) = g * product(k=1 to L) H_k(z) + = g * product(k=1 to L) (b_0k + b_1k*z^(-1) + b_2k*z^(-2))/(1 + a_1k*z^(-1) + a_2k*z^(-2)) +*/ + +function [s,g] = cell2sos(c) + if(argn(2)~=1) then + error("cell2sos: Wrong number of input arguments"); end - end - if (argn(1)==2) - d=c(1).entries; - if(length(d)==2) - g1=d(1); - g2=d(2); - g=g1/g2; - c=c(2:L); - else - g=1; + L=prod(size(c)); + k=1 + for i=1:L + if(type(c(i))~=17) + error('cell2sos: Cell contents must themselves be cell objects'); + end + end + gain_p = 0 + if length(cell2mat(c{1}))== 2 then + gain_vec=cell2mat(c{1}) + k=gain_vec(1)/gain_vec(2) + L=L-1 + gain_p=1 + end + s = zeros(L,6); + for i=1:L + if gain_p + s(i,:)=cell2mat(cll{i+1}) + else + s(i,:)=cell2mat(cll{i}) + end end - end - L=prod(size(c)); - s=zeros(L/2,6); - for i=1:2:L-1 - j=ceil(i/2) - b=c(i).entries; - a=c(i+1).entries; - b=b(:).'; - a=a(:).'; - b=[b,zeros(1,3-length(b))]; - a=[a,zeros(1,3-length(b))]; - s(j,:)=[b,a]; - end + if nargout < 2 then + s(1,1:3)= k * s(1,1:3) + else + g=k; + end endfunction + +/* +cll = {{[3 6 7] [1 1 2]} + {[1 4 5] [1 9 3]} + {[2 7 1] [1 7 8]}}; +sos = cell2sos(cll) // passed + +cll = {{1 2} {[3 6 7] [1 1 2]} + {[1 4 5] [1 9 3]} + {[2 7 1] [1 7 8]}}; +sos = cell2sos(cll) // passed + +*/
\ No newline at end of file diff --git a/macros/clustersegment.sci b/macros/clustersegment.sci index 07957ee..811930a 100644 --- a/macros/clustersegment.sci +++ b/macros/clustersegment.sci @@ -1,27 +1,83 @@ -function c = clustersegment(s) +function contRange = clustersegment(xhi) //This function calculates boundary indexes of clusters of 1’s. -//Calling Sequence -//c = clustersegment(s) +//Calling Sequence: +//contRange = clustersegment(xhi) //Parameters -//s: scalar, vector or matrix of real numbers (clusters of 1s) -//c: output variable, cell array of size 1 by N, where N is the number of rows in s -//Description -//This is an Octave function. +//xhi: scalar, vector or matrix of real numbers (clusters of 1s) +//contRange: output variable, cell array of size 1 by Np, where Np is the number of rows in 'xhi' +//Description: //This function calculates boundary indexes of clusters of 1’s. //This function calculates the initial and end indices of the sequences of 1's present in the input argument. -//The output variable c is a cell array of size 1 by N, where N is the number of rows in s and each element has two rows indicating the initial index and end index of the cluster of 1's respectively. The indexing starts from 1. -//Examples -//y = clustersegment ([0,1,0,0,1,1]) +//The output variable 'contRange' is a cell array of size 1 by Np, where Np is the number of rows in 'xhi' and each element has two rows indicating the initial index and end index of the cluster of 1's respectively. The indexing starts from 1. +//Examples: +//y = clustersegment([0,1,0,0,1,1]) //y = // 2. 5. -// 2. 6. +// 2. 6. -funcprot(0); -rhs = argn(2) -if(rhs~=1) -error("Wrong number of input arguments.") -end + funcprot(0); + if (argn(2) ~= 1) + error("Wrong number of input arguments."); + end + warning('off'); + + bool_discon = diff (xhi, 1, 2); + [Np Na] = size (xhi); + contRange = cell (1, Np); -c = callOctave("clustersegment", s) + for i = 1:Np + idxUp = find (bool_discon(i,:) > 0) + 1; + idxDwn = find (bool_discon(i,:) < 0); + tLen = length (idxUp) + length (idxDwn); + + if (xhi(i,1) == 1) + contRange{i}(1) = 1; + contRange{i}(2:2:tLen+1) = idxDwn; + contRange{i}(3:2:tLen+1) = idxUp; + else + contRange{i}(1:2:tLen) = idxUp; + contRange{i}(2:2:tLen) = idxDwn; + end + + if (xhi(i, $) == 1) + contRange{i}($+1) = Na; + end + + tLen = length (contRange{i}); + if (tLen ~= 0) + contRange{i} = matrix(contRange{i}, 2, tLen / 2); + end + + end + + if (Np == 1) + contRange = cell2mat (contRange); + end endfunction + +//tests: +//assert_checkerror("clustersegment()", "Wrong number of input arguments."); +//assert_checkerror("clustersegment(1, 2)", "Wrong number of input arguments."); +// +//assert_checkequal(clustersegment(1), [1; 1]); +//assert_checkequal(clustersegment(-5), []); +//assert_checkequal(clustersegment(3*%i), []); +//assert_checkequal(clustersegment([0 0 1 1 1 0 0 1 0 0 0 1 1]), [3 8 12; 5 8 13]); +// +//ranges = clustersegment([-1; 1; 2; 1]); +//assert_checkequal(ranges{1, 1}, []); +//assert_checkequal(ranges{1, 2}, [1; 1]); +//assert_checkequal(ranges{1, 3}, []); +//assert_checkequal(ranges{1, 4}, [1; 1]); +// +//ranges = clustersegment([-1-2*%i; 1; 2*%i; 3+4*%i]) +//assert_checkequal(ranges{1, 1}, []); +//assert_checkequal(ranges{1, 2}, [1; 1]); +//assert_checkequal(ranges{1, 3}, []); +//assert_checkequal(ranges{1, 4}, []); +// +//ranges = clustersegment([-1 1 1; 1 -1 1; -1 -1 1]) +//assert_checkequal(ranges{1, 1}, [2; 3]); +//assert_checkequal(ranges{1, 2}, [1 3; 1 3]); +//assert_checkequal(ranges{1, 3}, [3; 3]); diff --git a/macros/cummax.sci b/macros/cummax.sci index e9a68e5..465b515 100644 --- a/macros/cummax.sci +++ b/macros/cummax.sci @@ -1,4 +1,15 @@ -function M = cummax(varargin) +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 13 March 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +function [M , iM] = cummax(varargin) // Cumulative maximum // // Calling Sequence @@ -11,7 +22,8 @@ function M = cummax(varargin) // The operation is performed along the dimension specified by dim // M = cummax(_,direction) // direction specifies as the direction of operation - // + // [M , iM] = cummax(..) + // If called with two output arguments the index of the maximum value is also returned. // Parameters // A - real|complex numbers - vector|matrix // Input Array @@ -32,15 +44,6 @@ function M = cummax(varargin) // M = cummax(v) // // Expected output: [8 9 9 10 10 10 10 10 10 10] - // - // Authors - // Ayush Baid - // - // See Also - // cummax | cumprod | cumsum | max | max - - - [numOutArgs,numInArgs] = argn(0); // ** Checking number of arguments @@ -50,8 +53,8 @@ function M = cummax(varargin) error(77,msg); end - if numOutArgs~=1 then - msg = "cummax: Wrong number of output argument; 1 expected"; + if numOutArgs > 2 then + msg = "cummax: Wrong number of output argument; 1 or 2 expected"; error(78,msg); end @@ -103,11 +106,11 @@ function M = cummax(varargin) end // extracting direction - if strcmpi(directionArg,"reverse")==0 then + if strcmp(directionArg,"reverse")==0 then isForward = %f; - elseif strcmpi(directionArg,"forward")==0 then + elseif strcmp(directionArg,"forward")==0 then isForward = %t; - elseif strcmpi(directionArg,"")~=0 then + elseif strcmp(directionArg,"")~=0 then msg = "cummax: Wrong value for argument #3 (direction)"; error(53,msg); end @@ -132,7 +135,18 @@ function M = cummax(varargin) end M = matrix(M_,sizeA); - + + if numOutArgs == 2 then + // calculating the index + // for vectors + iM = zeros(sizeA(1),sizeA(2)); + for i=1:sizeA(1) + for j=1:sizeA(2) + index = find (M(i,j) == A(i,:) ) + iM(i,j) = index(1) + end + end + end endfunction @@ -191,6 +205,16 @@ function out = cummaxVec(inp,isForward) end end end - - endfunction +/* +# tests +[w, iw] = cummax ([1 3 2 6 4 5]); // passed +x = [1 2 3; 4 1 2; 3 5 1]; +w = cummax(x); //passsed + +x = [1 2 3; 4 1 2; 3 5 1]; +w = cummax(x, 2); // passed + +x = [1 2 3; 4 1 2; 3 5 1]; +[w,iw] = cummax(x, 2); // passed +*/
\ No newline at end of file diff --git a/macros/cummin.sci b/macros/cummin.sci index fccbd52..7a4db33 100644 --- a/macros/cummin.sci +++ b/macros/cummin.sci @@ -1,4 +1,15 @@ -function M = cummin(varargin) +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 13 March 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +function [M ,iM ]= cummin(varargin) // Cumulative minimum // // Calling Sequence @@ -12,6 +23,8 @@ function M = cummin(varargin) // M = cummin(_,direction) // direction specifies as the direction of operation // + // [M , iM] = cummin(..) + // If called with two output arguments the index of the minimum value is also returned. // Parameters // A - real|complex numbers - vector|matrix // Input Array @@ -33,25 +46,17 @@ function M = cummin(varargin) // // Expected output: [8 8 1 1 1 1 1 1 1 1] // - // Authors - // Ayush Baid - // - // See Also - // cummax | cumprod | cumsum | max | min - - - [numOutArgs,numInArgs] = argn(0); // ** Checking number of arguments if numInArgs<1 | numInArgs>3 then - msg = "cummin: Wrong number of input argument; 1-6 expected"; + msg = "cummin: Wrong number of input argument; 1-3 expected"; error(77,msg); end - if numOutArgs~=1 then - msg = "cummin: Wrong number of output argument; 1 expected"; + if numOutArgs > 2 then + msg = "cummin: Wrong number of output argument; 1 or 2 expected"; error(78,msg); end @@ -103,11 +108,11 @@ function M = cummin(varargin) end // extracting direction - if strcmpi(directionArg,"reverse")==0 then + if strcmp(directionArg,"reverse")==0 then isForward = %f; - elseif strcmpi(directionArg,"forward")==0 then + elseif strcmp(directionArg,"forward")==0 then isForward = %t; - elseif strcmpi(directionArg,"")~=0 then + elseif strcmp(directionArg,"")~=0 then msg = "cummin: Wrong value for argument #3 (direction)"; error(53,msg); end @@ -132,7 +137,17 @@ function M = cummin(varargin) end M = matrix(M_,sizeA); - + if numOutArgs == 2 then + // calculating the index + // for vectors + iM = zeros(sizeA(1),sizeA(2)); + for i=1:sizeA(1) + for j=1:sizeA(2) + index = find (M(i,j) == A(i,:) ) + iM(i,j) = index(1) + end + end + end endfunction @@ -202,3 +217,19 @@ function out = cumminVec(inp,isForward) endfunction + +/* +# tests +w = cummin ([5 4 6 2 3 1]) // passed + +[w,iw] = cummin ([5 4 6 2 3 1]) // passed + +x = [1 2 3; 4 1 2; 3 5 1]; +result = cummin(x) // passed + +x = [1 2 3; 4 1 2; 3 5 1]; +result = cummin(x, 2) //passsed + +x = [1 2 3; 4 1 2; 3 5 1]; +[w,iw] = cummin(x, 2) //passsed +*/
\ No newline at end of file diff --git a/macros/deconv.sci b/macros/deconv.sci index 1c4d8fa..08ea92b 100644 --- a/macros/deconv.sci +++ b/macros/deconv.sci @@ -1,104 +1,106 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in function [b, r] = deconv (y, a) -// calling sequence: -// [b,r]= deconv (y, a) -// Deconvolve two vectors. -// -// [b, r] = deconv (y, a) solves for b and r such that -// y = conv (a, b) + r. -// -// If y and a are polynomial coefficient vectors, b will -// contain the coefficients of the polynomial quotient and r will be -// a remainder polynomial of lowest order. -//Test cases: -//1. -//[b, r] = deconv ([3, 6, 9, 9], [1, 2, 3]) -//Output: -//b=[3, 0] -//r=[0, 0, 0, 9] + if (nargin ~= 2) + error("deconv : Two arguments are required "); + end -//2. -//[b, r] = deconv ([3, 6], [1; 2; 3]) -//Output: -//b = 0. -//r= [- 2. ; 8] + if (~isvector(y) && ~isscalar(y)) + error ("deconv: Y must be vector"); + end +if ( ~isvector(a) && ~isscalar(a)) + error ("deconv: A must be vector"); +end + // Ensure A is oriented as Y. + if ((size(y,1)==1 && size(a,2)==1) || (size(y,2)==1 && size(a,1)==1)) + a = a.'; + end + + la = length (a); + ly = length (y); + + lb = ly - la + 1; + + if (ly > la) + x = zeros (size (y,1) - size (a,1) + 1,size(y,2)-size(a,2)+1); + x(1) = 1; + [b, r] = filter (y, a, x); + r = r * a(1); + elseif (ly == la) + [b, r] = filter (y, a, 1); + r = r * a(1); + else + b = 0; + r = y; + end + + if (nargout() > 1) + if (ly >= la) + r = [zeros(ly - la + 1, 1); r(1:la - 1)]; + // Respect the orientation of Y + r = matrix (r, size (y,1),size(y,2)); + end + end +endfunction +/* + //test + [b, r] = deconv ([3, 6, 9, 9], [1, 2, 3]); + assert_checkequal (b, [3, 0]); + assert_checkequal (r, [0, 0, 0, 9]); + //test + [b, r] = deconv ([3, 6], [1, 2, 3]); + assert_checkequal (b, 0); + assert_checkequal (r, [3, 6]); + //test + [b, r] = deconv ([3, 6], [1; 2; 3]); + assert_checkequal (b, 0); + assert_checkequal (r, [3, 6]); - [nargout,nargin]=argn(); +//test + [b,r] = deconv ([3; 6], [1; 2; 3]); + assert_checkequal (b, 0); + assert_checkequal (r, [3; 6]); - if (nargin ~= 2) - error ("wrong number of input arguments"); - end +//test + [b, r] = deconv ([3; 6], [1, 2, 3]); + assert_checkequal (b, 0); + assert_checkequal (r, [3; 6]); - if (~ (isvector (y) & isvector (a))) - error ("deconv: both arguments must be vectors"); - end + assert_checkequal (deconv ((1:3)',[1, 1]), [1; 1]) - la = length (a); - ly = length (y); +// Test input validation +// error deconv (1) +// error deconv (1,2,3) +// error <Y .* must be vector> deconv ([3, 6], [1, 2; 3, 4]) +// error <A must be vector> deconv ([3, 6], [1, 2; 3, 4]) - lb = ly - la + 1; +//test + y = (10:-1:1); + a = (4:-1:1); + [b, r] = deconv (y, a); + assert_checkequal (conv (a, b) + r, y); - // Ensure A is oriented as Y. - if (diff (size (y)) * diff (size (a)) < 0) - a = permute (a, [2, 1]); - end - if (ly > la) - o=size (y) - size (a) + 1; - x = zeros (o(1),o(2)); - x(1) = 1; - b = filter (real(y), real(a), x); - elseif (ly == la) - b = filter (real(y), real(a), 1); - else - b = 0; - end +//test + [b, r] = deconv ([1, 1], 1); + assert_checkequal (r, [0, 0]); - lc = la + length (b) - 1; - if (ly == lc) - if (length(a)==length(b) | length(a)>length(b)) - if isrow(a) - q=conv(a,b); - - u=[]; - for i=1:length(y) - u=[u;q]; - end - - w=[]; - if (isrow(y)) - for i=1:length(q) - w=[w;y]; - end - else - for i=1:length(q) - w=[w,y]; - end - end - - r = w-u; - - r=diag(r); - end - end - r=y-conv(a,b); - - -elseif(la~=lc) - // Respect the orientation of Y" - if (size (y,"r") <= size (y,"c")) - r = [(zeros (1, lc - ly)), y] - conv (a, b); - else - r = [(zeros (lc - ly, 1)); y] - conv (a, b); - end - if (ly < la) - // Trim the remainder is equal to the length of Y. - r = r($-(length(y)-1):$); - end -end +//test + [b, r] = deconv ([1; 1], 1); + assert_checkequal (r, [0; 0]); -endfunction + */ diff --git a/macros/detrend1.sci b/macros/detrend1.sci index 52ac26f..29b0201 100644 --- a/macros/detrend1.sci +++ b/macros/detrend1.sci @@ -1,23 +1,72 @@ -function y = detrend1(x, varargin) -//This function removes the best fit of a polynomial of order P from the data X -//Calling Sequence -//detrend1(X,P) -//Parameters -//X: Input vecor or matrix. -//P: The order of polnomial -//Description -//If X is a vector, 'detrend1(X, P)' removes the best fit of apolynomial of order P from the data X.If X is a matrix, 'detrend1(X, P)' does the same for each column in X. -// -//The second argument P is optional. If it is not specified, a value of 1 is assumed. This corresponds to removing a linear trend. -//The order of the polynomial can also be given as a string, in which case P must be either "constant" (corresponds to 'P=0') or "linear"(corresponds to 'P=1') - rhs= argn(2); - if(rhs<1 | rhs> 2) - error("Wrong number of input arguments"); - end - select(rhs) - case 1 then - y= callOctave("detrend", x); - case 2 then - y= callOctave("detrend", x , varargin(1)); - end +function y = detrend1 (x, p) +//Remove the best fit of a polynomial of order p from the data x. +//Calling Sequence: +//detrend1(x,p) +//Parameters: +//x: Input vecor or matrix +//p: The order of polnomial +//Description: +//If X is a vector, 'detrend1(X, P)' removes the best fit of apolynomial of order P from the data X. +//If X is a matrix, 'detrend1(X, P)' does the same for each column in X. +//The second argument p is optional. If it is not specified, a value of 1 is assumed. This corresponds to removing a linear trend. +//The order of the polynomial can also be given as a string, in which case p must be either "constant" (corresponds to 'P=0') or "linear" (corresponds to 'P=1') +//Example: +//detrend1([1, 6, 9]) +//ans = [ -0.3333, 0.6667, -0.3333] + + funcprot(0); + rhs = argn(2); + if (rhs < 1 | rhs > 2) + error("detrend1: wrong number of input arguments"); + end + + if (rhs == 1) + p = 1; + end + + if (~or(type(x)==[1 5 8]) | ndims (x) > 2) + error ("detrend1: X must be a numeric vector or matrix"); + end + + if (type(p) == 10 & ~strcmp(p, "constant", 'i')) + p = 0; + elseif (type(p) == 10 & ~strcmp(p, "linear", 'i')) + p = 1; + elseif (~isscalar(p) | p < 0 | p ~= fix (p)) + error ("detrend1: P must be constant, linear, or a positive integer"); + end + + [m, n] = size (x); + if (m == 1) + x = x.'; + end + + r = size(x, 'r'); + b = ((1 : r).' * ones (1, p + 1)) .^ (ones (r, 1) * (0 : p)); + y = x - b * (b \ x); + + if (m == 1) + y = y.'; + end + endfunction +// +//input validation: +//assert_checkerror("detrend1()", "detrend1: wrong number of input arguments"); +//a = "string"; +//assert_checkerror("detrend1(a)", "detrend1: X must be a numeric vector or matrix"); +//assert_checkerror("detrend1(%T)", "detrend1: X must be a numeric vector or matrix"); +//assert_checkerror("detrend1(1, -1)", "detrend1: P must be constant, linear, or a positive integer"); +//assert_checkerror("detrend1(1, 1.25)", "detrend1: P must be constant, linear, or a positive integer"); + +//tests: +//N = 32; +//x = (0:1:N-1)/N + 2; +//y = detrend1(x); +//assert_checktrue(abs (y(:)) < 20*%eps); +//assert_checkequal(detrend1([2, 5, 8]), detrend1([2. 5, 8], "linear")); +//assert_checkequal(detrend1([2, 5, 8], 0), detrend1([2. 5, 8], "constant")); +//assert_checkalmostequal(detrend1([1; 6; 9], "constant"), [-4.33333; 0.66666; 3.66666], 5*10^-5); +//assert_checkalmostequal(detrend1([5, 12, 14; 8, 16, 14; 5, 10, 12]), [-1, -1.6666, -0.3333; 2, 3.3333, 0.6666; -1, -1.6666, -0.3333], 5*10^-4); +//assert_checkalmostequal(detrend1([-5-5*%i; 2+%i; -4+3*%i], "linear"), [-2.1667-0.6667*%i; 4.3333+1.3333*%i; -2.1667-0.6667*%i], 5*10^-4); +//assert_checkalmostequal(detrend1([5*%i, 1+2*%i,; -8, -1-6*%i], 0), [4+2.5*%i, 1+4*%i; -4-2.5*%i, -1-4*%i], 5*10^-4); diff --git a/macros/digitrevorder.sci b/macros/digitrevorder.sci index 886c43f..0137542 100644 --- a/macros/digitrevorder.sci +++ b/macros/digitrevorder.sci @@ -1,36 +1,43 @@ -// Returns input data in digit-reversed order - -// Calling Sequence -//[y,i] = digitrevorder(x,r) -//y = digitrevorder(x,r) - -// Parameters -//x: Vector of real or complex values -//r: radix / base -//y: input vector in digit reverse order -//i: indices - -// Description -//This function returns the input data after reversing the digits of the indices and reordering the elements of the input array. - -// Examples -//x = [%i,1,3,6*%i] ; -//r = 2 ; -//[y i]=digitrevorder(x, r) -//Output : -// i = -// -// 1. 3. 2. 4. -// y = -// -// i 3. 1. 6.i +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in function [y, i] = digitrevorder (x, r) - funcprot(0); - [nargout, nargin] = argn() ; + // Returns input data in digit-reversed order + // Calling Sequence + //[y,i] = digitrevorder(x,r) + //y = digitrevorder(x,r) + // Parameters + //x: Vector of real or complex values + //r: radix / base + //y: input vector in digit reverse order + //i: indices + // Description + //This function returns the input data after reversing the digits of the indices and reordering the elements of the input array. + // Examples + //x = [%i,1,3,6*%i] ; + //r = 2 ; + //[y i]=digitrevorder(x, r) + //Output : + // i = + // + // 1. 3. 2. 4. + // y = + // + // i 3. 1. 6.i + funcprot(0); + [nargout, nargin] = argn() ; if (nargin > 2 | nargin <= 1) error("digitrevorder : invalid number of inputs") - elseif (~ isvector (x)) + elseif ( ~isvector(x) & ~isscalar(x)) error ("digitrevorder : X must be a vector"); elseif (~ (isscalar (r) & r == fix (r) & r >= 2 & r <= 36)) error ("digitrevorder : R must be an integer between 2 and 36"); @@ -41,27 +48,37 @@ function [y, i] = digitrevorder (x, r) end end - old_ind = 0:length(x) - 1; - - //new_ind = base2dec(mtlb_fliplr(dec2base(old_ind, r)), r); //it works only on octave - old_ind_base = dec2base(old_ind, r) ; - new_ind_base = [] ; - b = [] ; - for i=1:length(x) - new_ind_base = [new_ind_base mtlb_fliplr(old_ind_base(i))]; - end - new_ind = base2dec(new_ind_base,r) ; - //end of index conversion - + old_ind = 0:max(size(x)) - 1; + new_ind = base2dec (strrev(dec2base (old_ind, r)), r); i = new_ind + 1; y(old_ind + 1) = x(i); - - [rows_x columns_x] = size(x) ; - - if (columns_x == 1) - y = y'; + if (size(x,2)== 1) + y = y(:); else - i = i; + i = i.'; end - endfunction + +/* +// tests base 0 2 OK +assert_checkequal (digitrevorder (0, 2), 0); // passed +assert_checkequal (digitrevorder (0, 36), 0); //passed +assert_checkequal (digitrevorder (0:3, 4), 0:3); //passed +assert_checkequal (digitrevorder ([0:3]', 4), [0:3]');//passed +assert_checkequal (digitrevorder (0:7, 2), [0 4 2 6 1 5 3 7]);//passed +assert_checkequal (digitrevorder ([0:7]', 2), [0 4 2 6 1 5 3 7]');//passed +assert_checkequal (digitrevorder ([0:7]*%i, 2), [0 4 2 6 1 5 3 7]*%i); //passed +assert_checkequal (digitrevorder ([0:7]'*%i, 2), [0 4 2 6 1 5 3 7]'*%i);//passed +assert_checkequal (digitrevorder (0:15, 2), [0 8 4 12 2 10 6 14 1 9 5 13 3 11 7 15]); // passed + +//FIXME : debug the failed test +assert_checkequal (digitrevorder (0:15, 4), [0 4 8 12 1 5 9 13 2 6 10 14 3 7 11 15]); // failed + +//Test input validation - passed +error digitrevorder (); +error digitrevorder (1); +error digitrevorder (1, 2, 3); +error digitrevorder ([], 1); +error digitrevorder ([], 37); +error digitrevorder (0:3, 8); +*/
\ No newline at end of file diff --git a/macros/dst1.sci b/macros/dst1.sci index 7f2165f..c2f84ed 100644 --- a/macros/dst1.sci +++ b/macros/dst1.sci @@ -1,28 +1,62 @@ -function y = dst1(x, varargin) +function y = dst1(x, n) //Computes the type I discrete sine transform of x -//Calling Sequence +//Calling Sequence: //y= dst1(x) //y= dst1(x,n) -//Parameters +//Parameters: //x: real or complex valued vector //n= Length to which x is trimmed before transform -//Description -//This is an Octave function. -//Computes the type I discrete sine transform of x. If n is given, then x is padded or trimmed to length n before computing the transform. If x is a matrix, compute the transform along the columns of the the matrix. -funcprot(0); - -lhs= argn(1); -rhs= argn(2); - -if(rhs>2) -error("Wrong number of input arguments"); -end - -select(rhs) - case 1 then - y = callOctave("dst", x); - case 2 then - y = callOctave("dst", x, varargin(1)); -end +//Description: +//Computes the type 1 discrete sine transform of x. If n is given, then x is padded or trimmed to length n before computing the transform. +//If x is a matrix, compute the transform along the columns of the the matrix. +//Example: +//dst1([1 3 6]) +//ans = [7.94974, -5, 1.94974] + + funcprot(0); + rhs = argn(2); + if (rhs < 1 | rhs > 2) + error("ds1: wrong number of input arguments"); + end + + transpose = (size(x, 'r') == 1); + if (transpose) + x = x (:); + end + + [nr, nc] = size(x); + if (rhs == 1) + n = nr; + elseif (n > nr) + x = [ x ; zeros(n-nr, nc) ]; + elseif (n < nr) + x (nr-n+1 : n, :) = []; + end + + d = [ zeros(1, nc); x; zeros(1, nc); -flipdim(x, 1) ]; + y = fft(d, -1, find(size(d) ~= 1, 1))/2*%i; + y = y(2:nr+1, :); + if (isreal(x)) + y = real (y); + end + + if (transpose) + y = y.'; + end + endfunction +//input validation: +//assert_checkerror("dst1()", "ds1: wrong number of input arguments"); +//assert_checkerror("dst1(1, 2, 3)", "Wrong number of input arguments."); + +//tests: +//x = log(linspace(0.1,1,32)); +//y = dst1(x); +//assert_checkalmostequal(y(3), sum(x.*sin(3*%pi*[1:32]/33)), 100*%eps); +// +//assert_checkalmostequal(dst1([-1; -3; -6]), [-7.9497; 5.0000; -1.9497], 5*10^-5); +//assert_checkalmostequal(dst1([-1 2 2], 5), [3.2321, 0.8660, -3.0000], 5*10^-5); +//assert_checkalmostequal(dst1([1+2*%i, 5+3*%i, 8+2*%i]), [11.3639+5.8284*%i, -7.0000-0*%i, 1.3640-0.1716*%i], 5*10^-4); +//assert_checkalmostequal(dst1([1+2*%i; 5+3*%i; 8+2*%i], 2), [7.7942+3.4641*%i; -6.0622-0*%i; 0], 5*10^-5); +//assert_checkalmostequal(dst1([-1-3*%i, 4*%i; -2-7*%i, 3]), [-2.5981-8.6603*%i, 2.5981+3.4641*%i; 0.8660+3.4641*%i, -2.5981+3.4641*%i], 5*10^-5); diff --git a/macros/durbinlevinson.sci b/macros/durbinlevinson.sci index 74dbb46..9fb647b 100644 --- a/macros/durbinlevinson.sci +++ b/macros/durbinlevinson.sci @@ -1,27 +1,88 @@ -function y= durbinlevinson(C, varargin) -// Perform one step of the Durbin-Levinson algorithm.. +function [newphi, newv] = durbinlevinson (c, oldphi, oldv) +// Perform one step of the Durbin-Levinson algorithm. //Calling Sequence -// durbinlevinson (C); -// durbinlevinson (C, OLDPHI); -// durbinlevinson (C, OLDPHI, OLDV); -//Parameters -//C: The vector C specifies the autocovariances '[gamma_0, ..., gamma_t]' from lag 0 to T. -//OLDPHI: It specifies the coefficients based on C(T-1). -//OLDV: It specifies the corresponding error. -//Description -//This is an Octave function. +// durbinlevinson(c) +// durbinlevinson(c, oldphi) +// durbinlevinson(c, oldphi, oldv) +//Parameters: +//c: The vector c specifies the autocovariances '[gamma_0, ..., gamma_t]' from lag 0 to t. +//oldphi: It specifies the coefficients based on c(t-1). +//oldv: It specifies the corresponding error. +//Description: //Perform one step of the Durbin-Levinson. -//If OLDPHI and OLDV are omitted, all steps from 1 to T of the algorithm are performed. - rhs=argn(2); - if(rhs<1 | rhs>3) - error("Wrong number of input arguments"); - end - select(rhs) - case 1 then - y=callOctave("durbinlevinson",C); - case 2 then - y=callOctave("durbinlevinson",C, varargin(1)); - case 3 then - y=callOctave("durbinlevinson",C, varargin(1), varargin(2)); - end -endfunction
\ No newline at end of file +//If 'oldphi' and 'oldv' are omitted, all steps from 1 to t of the algorithm are performed. +//Example: +//durbinlevinson([1, 2, 3], 1, 2) +//ans = [0.5, 0.5] + + funcprot(0); + rhs = argn(2); + + if (rhs ~= 1 & rhs ~= 3) + error("durbinlevinson: wrong number of input arguments"); + end + + if (size(c, 'c') > 1) + c = c'; + end + + newphi = 0; + newv = 0; + + if (rhs == 3) + t = length (oldphi) + 1; + if (length (c) < t + 1) + error ("durbinlevinson: arg1 (c) is too small"); + end + + if (oldv == 0) + error ("durbinlevinson: arg3 (oldv) must be non-zero"); + end + + if (size(oldphi, 'r') > 1) + oldphi = oldphi'; + end + + newphi = zeros (1, t); + newphi(1) = (c(t+1) - oldphi * c(2:t)) / oldv; + for i = 2 : t + newphi(i) = oldphi(i-1) - newphi(1) * oldphi(t-i+1); + end + newv = (1 - newphi(1)^2) * oldv; + + else + tt = length (c)-1; + oldphi = c(2) / c(1); + oldv = (1 - oldphi^2) * c(1); + + for t = 2 : tt + newphi = zeros (1, t); + newphi(1) = (c(t+1) - oldphi * c(2:t)) / oldv; + for i = 2 : t + newphi(i) = oldphi(i-1) - newphi(1) * oldphi(t-i+1); + end + newv = (1 - newphi(1)^2) * oldv; + oldv = newv; + oldphi = newphi; + end + + end +endfunction + +//input validation: +//assert_checkerror("durbinlevinson()", "durbinlevinson: wrong number of input arguments"); +//assert_checkerror("durbinlevinson(1, 2, 3, 4)", "Wrong number of input arguments."); +//assert_checkerror("durbinlevinson([1, 2], [1, 2, 3], 5)", "durbinlevinson: arg1 (c) is too small"); +//assert_checkerror("durbinlevinson([1, 2, 3, 4], [1, 2], 0)", "durbinlevinson: arg3 (oldv) must be non-zero"); + +//test mx1 input: +//assert_checkequal(durbinlevinson([2, 4, 3]), durbinlevinson([2, 4, 3], 2, -6)); +//assert_checkequal(durbinlevinson([9, 12, 43, 55], 3, -4), [-1.75, 8.25]); +//assert_checkequal(durbinlevinson([2, 5, 3, 5, 7], [2, 6], -4), [5.75, -32.5, -5.5]); +//assert_checkequal(durbinlevinson([6, 5, 8, 4], [1; 2], -1), [17, -33, -15]); + +//test 1xm input: +//assert_checkequal(durbinlevinson([1; 4; 7]), [0.6, 1.6]); +//assert_checkequal(durbinlevinson([3; 6; 7], -5, -2), [-18.5, -97.5]); +//assert_checkequal(durbinlevinson([3; 6; 4; 2; 1; 9], [4; 6; 5], 3), [-19, 99, 120, 81]); +//assert_checkequal(durbinlevinson([6; 5; 8; 4], [1, 2], -1), [17, -33, -15]); diff --git a/macros/ellip.sci b/macros/ellip.sci index ab34458..1dc8435 100644 --- a/macros/ellip.sci +++ b/macros/ellip.sci @@ -1,15 +1,14 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt // Original Source : https://octave.sourceforge.io/signal/ -// Modifieded by:Sonu Sharma, RGIT Mumbai +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - function [a, b, c, d] = ellip (n, rp, rs, w, varargin) //Elliptic or Cauer filter design with rp dB of passband ripple and rs dB of stopband attenuation. @@ -59,7 +58,8 @@ function [a, b, c, d] = ellip (n, rp, rs, w, varargin) // column 5 // // 0.0202774 - + // Dependencies + // ellipap sftrans bilinear zp2tf funcprot(0); [nargout nargin] = argn(); @@ -85,7 +85,7 @@ function [a, b, c, d] = ellip (n, rp, rs, w, varargin) case "stop" stop = %T; case "low" - stop = %T; + stop = %F; case "pass" stop = %F; else @@ -93,7 +93,7 @@ function [a, b, c, d] = ellip (n, rp, rs, w, varargin) end end - [rows_w colums_w] = size(w); + [rows_w columns_w] = size(w); if (~ ((length (w) <= 2) & (rows_w == 1 | columns_w == 1))) error ("ellip: frequency must be given as WP or [WL, WH]"); @@ -119,7 +119,7 @@ function [a, b, c, d] = ellip (n, rp, rs, w, varargin) // Prewarp the digital frequencies if (digital) T = 2; // sampling frequency of 2 Hz - w = 2 / T * tan (%pi * w / T); + w = (2 / T )* tan (%pi * w / T); end // Generate s-plane poles, zeros and gain @@ -139,8 +139,8 @@ function [a, b, c, d] = ellip (n, rp, rs, w, varargin) if (nargout == 2) [a b] = zp2tf(zero, pole, gain); elseif (nargout == 3) - a = zero; - b = pole; + a = conj(zero'); + b = conj(pole'); c = gain; else // output ss results @@ -148,3 +148,49 @@ function [a, b, c, d] = ellip (n, rp, rs, w, varargin) error("ellip: yet not implemented in state-space form OR invalid number of o/p arguments") end endfunction + +/* +%% Test input validation // all passed +error [a, b] = ellip () +error [a, b] = ellip (1) +error [a, b] = ellip (1, 2) +error [a, b] = ellip (1, 2, 3) +error [a, b] = ellip (1, 2, 3, 4, 5, 6, 7) +error [a, b] = ellip (.5, 2, 40, .2) +error [a, b] = ellip (3, 2, 40, .2, "invalid") + +test + +//[b, a] = ellip (n, rp, rs, [wl, wh]) +[b, a] = ellip (5, 1, 90, [.1 .2]); // passed + +//[b, a] = ellip (n, rp, rs, wp) +[A, B] = ellip (6, 3, 50, .6); //passed + +//[b, a] = ellip (n, rp, rs, [wl, wh], "stop") +[b, a] = ellip (5, 1, 90, [.1 .2],"stop"); // passed + +//[b, a] = ellip (n, rp, rs, wp, "high") +[A, B] = ellip (6, 3, 50, .6,"high"); // passed + +//[b, a] = ellip (n, rp, rs, [wl, wh]) +[b, a] = ellip (5, 1, 90, [.1 .2],"s"); // passed + +//[b, a] = ellip (n, rp, rs, wp) +[A, B] = ellip (6, 3, 50, .6,"z"); // passed + +//[b, a] = ellip (n, rp, rs, [wl, wh], "stop") +[b, a] = ellip (5, 1, 90, [.1 .2],"pass"); // passed + +//[b, a] = ellip (n, rp, rs, wp, "high") +[A, B] = ellip (6, 3, 50, .6,"low"); // passed + + +//[z, p, g] = ellip (…) +[z, p, g] = ellip (6, 3, 50, .6); // passed + +[z,p,g] = ellip( 10,15,4,.9,"s") // passed + +test + [a, b, c, d] = ellip (6, 3, 50, .6); // not implemented yet + */
\ No newline at end of file diff --git a/macros/fftfilt.sci b/macros/fftfilt.sci index ab171ce..1f696ab 100644 --- a/macros/fftfilt.sci +++ b/macros/fftfilt.sci @@ -1,3 +1,14 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in function y = fftfilt(b, x, varargin) // Performs FFT-based FIR filtering using overlap-add method // @@ -31,13 +42,7 @@ function y = fftfilt(b, x, varargin) // x = sin(1:2000); // b = [1 1/4;1/3 1/5]; // y = fftfilt(b,x); - // - // Authors - // Ayush Baid - - - - + [numOutArgs,numInArgs] = argn(0); // ** Checking number of arguments @@ -201,4 +206,4 @@ function y = fftfilt(b, x, varargin) end -endfunction +endfunction
\ No newline at end of file diff --git a/macros/fftshift1.sci b/macros/fftshift1.sci index cdff99a..db22891 100644 --- a/macros/fftshift1.sci +++ b/macros/fftshift1.sci @@ -1,32 +1,81 @@ -function y= fftshift1(X,DIM) -//Perform a shift of the vector X, for use with the 'fft1' and 'ifft1' functions, in order the move the frequency 0 to the center of the vector or matrix. -//Calling Sequence -// fftshift1 (X) -// fftshift1 (X, DIM) -//Parameters -//X:It is a vector of N elements corresponding to time samples -//DIM: The optional DIM argument can be used to limit the dimension along which the permutation occurs -//Description -//This is an Octave function. -//Perform a shift of the vector X, for use with the 'fft1' and 'ifft1' functions, in order the move the frequency 0 to the center of the vector or matrix. -// -//If X is a vector of N elements corresponding to N time samples spaced by dt, then 'fftshift1 (fft1 (X))' corresponds to frequencies -// -//f = [ -(ceil((N-1)/2):-1:1)*df 0 (1:floor((N-1)/2))*df ] -// -//where df = 1 / dt. -// -//If X is a matrix, the same holds for rows and columns. If X is an array, then the same holds along each dimension. -// -//The optional DIM argument can be used to limit the dimension along which the permutation occurs. - rhs= argn(2); - if(rhs <1 | rhs >2) - error('Wrong number of Input arguments'); - end - select(rhs) - case 1 then - y=callOctave("fftshift",X); - case 2 then - y=callOctave("fftshift",X,DIM); - end +function y = fftshift1(x, dim) +//Performs a shift of the vector x, for use with the fft1 and ifft1 functions, in order to move the frequency 0 to the center of the vector or matrix. +//Calling Sequence: +// fftshift1(x) +// fftshift1(x, dim) +//Parameters: +//x- It is a vector of N elements corresponding to time samples +//dim- The optional DIM argument can be used to limit the dimension along which the permutation occurs +//Examples: +//x = [0:6] +//fftshift1(x) +//ans = +//4 5 6 0 1 2 3 + + funcprot(0); + rhs = argn(2); + if (rhs < 1 | rhs > 2) then + error ("fftshift1: wrong number of arguments"); + end + + if (~or(type(x) == [1 5 8 10 4 6])) + error ("fftshitft1: arg1 (x) must be a vector or matrix"); + end + + if (rhs == 1) then + dim = 1:max(size(size(x))); + else + if (~(isscalar(dim) & dim > 0 & dim == fix(dim))) then + error ("fftshift1: arg2 (dim) must be a positive integer"); + end + end + + for d = dim + sz = size(x); + sz2 = ceil(sz(d) / 2); + dim_idx = [sz2+1:sz(d), 1:sz2]; + if (d == 1) then + x = x(dim_idx, :); + elseif ( d == max(size(size(x))) ) then + x = x(:, dim_idx); + else + idx = repmat({':'}, 1, max(size(size(x)))); + idx(d) = {dim_idx}; + x = x(idx{:}); + end + end + y = x; + endfunction + +//input validation: +//assert_checkerror("fftshift1()", "fftshift1: wrong number of arguments"); +//assert_checkerror("fftshift1(1, 2, 3)", "Wrong number of input arguments."); +//assert_checkerror("fftshift1(0:2, -1)", "fftshift1: arg2 (dim) must be a positive integer"); +//assert_checkerror("fftshift1(0:2, 0:3)", "fftshift1: arg2 (dim) must be a positive integer"); + +//test mx1 input: +//x = [0:7]; +//y = fftshift1 (x); +//assert_checkequal (y, [4 5 6 7 0 1 2 3]); +//assert_checkequal (fftshift1(y), x); + +//test 1xm input: +//x = [0:7]'; +//y = fftshift1(x); +//assert_checkequal(y, [4;5;6;7;0;1;2;3]); +//assert_checkequal(fftshift1(y), x); + +//test mxn input: +//x = [0:3]; +//x = [x;2*x;3*x+1;4*x+1]; +//y = fftshift1(x); +//assert_checkequal(y, [[7 10 1 4];[9 13 1 5];[2 3 0 1];[4 6 0 2]]); +//assert_checkequal(fftshift1(y), x); + +//test dim is provided: +//x = [0:3]; +//x = [x;2*x;3*x+1;4*x+1]; +//y = fftshift1(x, 1); +//assert_checkequal(y, [[1 4 7 10];[1 5 9 13];[0 1 2 3];[0 2 4 6]]); +//assert_checkequal(fftshift1(y, 1), x); diff --git a/macros/filter2.sci b/macros/filter2.sci index b8b48e4..f565e14 100644 --- a/macros/filter2.sci +++ b/macros/filter2.sci @@ -1,33 +1,70 @@ -function Y = filter2 (B, X, SHAPE) -//Apply the 2-D FIR filter B to X. -//Calling Sequence -//Y = filter2(B, X) -//Y = filter2(B, X, SHAPE) -//Parameters -//B, X: Matrix -// SHAPE: -// 'full': pad X with zeros on all sides before filtering. -// 'same': unpadded X (default) -// 'valid': trim X after filtering so edge effects are no included. -//Description -//This function applies the 2-D FIR filter B to X. If the argument SHAPE is specified, return an array of the desired shape. -//Examples +function y = filter2 (b, x, shape) +//Apply the 2-D FIR filter b to x. +//Calling Sequence: +//y = filter2(b, x) +//y = filter2(b, x, shape) +//Parameters: +//b, x: vectors +//If the optional argument 'shape' is specified, return a vector of the desired shape. +//Possible values are: +// "full"- pad x with zeros on all sides before filtering. +// "same"- unpadded x (default) +// "valid"- trim x after filtering so edge effects are no included. +//Examples: //filter2([1,3], [4,5]) -//ans = -// 19. 5. -funcprot(0); -lhs = argn(1) -rhs = argn(2) -if (rhs < 2 | rhs > 3) -error("Wrong number of input arguments.") -end +//ans = +//[19, 5] -select(rhs) - - case 2 then - Y=callOctave("filter2",B,X) - case 3 then - Y = callOctave("filter2",B,X,SHAPE) + funcprot(0); + rhs = argn(2); + + if (rhs < 2 | rhs > 3) then + error("filter2: wrong number of input arguments"); + end + if (rhs < 3) then + shape = "same"; + end + [nr, nc] = size(b); + A = x; + B = b(nr:-1:1, nc:-1:1); + fullConv = convol2d(A, B); + sizeA = size(A); + sizeB = size(B); + sizeFull = size(fullConv); + + select(shape) + case "full" + y = fullConv; + case "same" + startRow = floor(sizeB(1) / 2) + 1; + startCol = floor(sizeB(2) / 2) + 1; + endRow = startRow + sizeA(1) - 1; + endCol = startCol + sizeA(2) - 1; + y = fullConv(startRow:endRow, startCol:endCol); + case "valid" + startRow = sizeB(1); + startCol = sizeB(2); + endRow = sizeFull(1) - sizeB(1) + 1; + endCol = sizeFull(2) - sizeB(2) + 1; + if endRow >= startRow & endCol >= startCol then + y = fullConv(startRow:endRow, startCol:endCol); + else + y = []; + end + else + error("Invalid shape parameter."); end endfunction + +//input validation: +//assert_checkerror("filter2()", "filter2: wrong number of input arguments"); +//assert_checkerror("filter2(1, 2, 3, 4)", "Wrong number of input arguments."); + +//tests: +//assert_checkequal(filter2([1, 2; 3, 5], [1, 3; 5, 7]), [57, 24; 19, 7]); +//assert_checkequal(filter2(1, 5), filter2(1, 5, "same")); +//assert_checkequal(filter2([1, 2], [4; 5; 6], "full"), [8, 4; 10, 5; 12, 6]); +//assert_checkequal(filter2([3; 1], [5; 4], "valid"), 19); +//x=1; +//assert_checkequal(filter2([3 x*2; 3*x+1 9^x], [5 7; 4 8], "valid"), 117); diff --git a/macros/findpeaks.sci b/macros/findpeaks.sci index 3e7ce47..a96dff7 100644 --- a/macros/findpeaks.sci +++ b/macros/findpeaks.sci @@ -1,58 +1,330 @@ -function [PKS, LOC, EXTRA] = findpeaks(DATA, varargin) -//This function find peaks on DATA. -//Calling Sequence -//[PKS, LOC, EXTRA] = findpeaks(DATA) -//[PKS, LOC, EXTRA] = findpeaks(..., PROPERTY, VALUE) -//[PKS, LOC, EXTRA] = findpeaks(..., "DoubleSided") -//Description -//Peaks of a positive array of data are defined as local maxima. For double-sided data, they are maxima of the positive part and minima of the negative part. DATA is expected to be a single column vector. -// -//The function returns the value of DATA at the peaks in PKS. The index indicating their position is returned in LOC. -// -//The third output argument is a structure with additional information: -// -//"parabol": -// A structure containing the parabola fitted to each returned peak. The structure has two fields, "x" and "pp". The field "pp" contains the coefficients of the 2nd degree polynomial and "x" the extrema of the intercal here it was fitted. -// -//"height": -// The estimated height of the returned peaks (in units of DATA). -// -//"baseline": -// The height at which the roots of the returned peaks were calculated (in units of DATA). -// -//"roots": -// The abscissa values (in index units) at which the parabola fitted to each of the returned peaks crosses the "baseline" value. The width of the peak is calculated by 'diff(roots)'. -// -//This function accepts property-value pair given in the list below: -// -//"MinPeakHeight": -// Minimum peak height (positive scalar). Only peaks that exceed this value will be returned. For data taking positive and negative values use the option "DoubleSided". Default value '2*std (abs (detrend (data,0)))'. -// -//"MinPeakDistance": -// Minimum separation between (positive integer). Peaks separated by less than this distance are considered a single peak. This distance is also used to fit a second order polynomial to the peaks to estimate their width, therefore it acts as a smoothing parameter. Default value 4. -// -//"MinPeakWidth": -// Minimum width of peaks (positive integer). The width of the peaks is estimated using a parabola fitted to the neighborhood of each peak. The neighborhood size is equal to the value of "MinPeakDistance". The width is evaluated at the half height of the peak with baseline at "MinPeakHeight". Default value 2. -// -//"DoubleSided": -// Tells the function that data takes positive and negative values. The base-line for the peaks is taken as the mean value of the function. This is equivalent as passing the absolute value of the data after removing the mean. -funcprot(0); -rhs=argn(2); -lhs=argn(1) -if(rhs<1 | rhs>2) then - error("Wrong number of input arguments."); -end -if(lhs<3 | lhs>3) then - error("Wrong number of output arguments."); -end +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +function [pks ,idx, varargout] = findpeaks (data, varargin) +/* + + [pks, loc, extra] = findpeaks (data) + … = findpeaks (…, property, value) + … = findpeaks (…, "DoubleSided") + Finds peaks on data. + + Peaks of a positive array of data are defined as local maxima. For double-sided data, they are maxima of the positive part and minima of the negative part. data is expected to be a single column vector. + + The function returns the value of data at the peaks in pks. The index indicating their position is returned in loc. + + The third output argument is a structure with additional information: + + "parabol" + A structure containing the parabola fitted to each returned peak. The structure has two fields, "x" and "pp". The field "pp" contains the coefficients of the 2nd degree polynomial and "x" the extrema of the interval where it was fitted. + + "height" + The estimated height of the returned peaks (in units of data). + + "baseline" + The height at which the roots of the returned peaks were calculated (in units of data). + + "roots" + The abscissa values (in index units) at which the parabola fitted to each of the returned peaks realizes its width as defined below. + + This function accepts property-value pair given in the list below: + + "MinPeakHeight" + Minimum peak height (non-negative scalar). Only peaks that exceed this value will be returned. For data taking positive and negative values use the option "DoubleSided". Default value eps. + + "MinPeakDistance" + Minimum separation between (positive integer). Peaks separated by less than this distance are considered a single peak. This distance is also used to fit a second order polynomial to the peaks to estimate their width, therefore it acts as a smoothing parameter. The neighborhood size is equal to the value of "MinPeakDistance". Default value 1. + + "MinPeakWidth" + Minimum width of peaks (positive integer). The width of the peaks is estimated using a parabola fitted to the neighborhood of each peak. The width is calculated with the formula + + a * (width - x0)^2 = 1 + where a is the concavity of the parabola and x0 its vertex. Default value 1. + + "MaxPeakWidth" + Maximum width of peaks (positive integer). Default value Inf. + + "DoubleSided" + Tells the function that data takes positive and negative values. The base-line for the peaks is taken as the mean value of the function. This is equivalent as passing the absolute value of the data after removing the mean. +*/ + + if (nargin < 1) + error("findpeaks:InsufficientInputArguments\nfindpeaks: DATA must be given"); + end + + if (~(isvector (data) && length (data) >= 3)) + error ("findpeaks:InvalidArgument\nfindpeaks: DATA must be a vector of at least 3 elements"); + end + transpose = (size(data,1) == 1); + if (transpose) + data = data.'; + end + __data__ = abs (detrend (data, 'c')); + // --- Parse arguments --- // +[ dSided, minH, minD, minW, maxW ] = parser ( varargin(:) ); + + if (dSided) + temp = __data__ + __data__ = data + data = temp + temp = [] // free temp + elseif (min (data) < 0) + error ("findpeaks:InvalidArgument\nData contains negative values. You may want to DoubleSided option"); + end + // Rough estimates of first and second derivative + df1 = diff (data, 1) + df1=df1([1; [1:length(df1)].']); + df2 = diff (data, 2) + df2=df2([1; 1; [1:length(df2)].']); + + // check for changes of sign of 1st derivative and negativity of 2nd + // derivative. + // <= in 1st derivative includes the case of oversampled signals. + idx = find (df1.*[df1(2:$); 0] <= 0 & [df2(2:$); 0] < 0); + + // Get peaks that are beyond given height + tf = data(idx) > minH; + idx = idx(tf); + + // sort according to magnitude + [_, tmp] = gsort (data(idx)); + idx_s = idx(tmp); + + // Treat peaks separated less than minD as one + D = abs (bsminuseq (idx_s)); + D = D + diag(ones(1,size(D,1))*%nan); // eliminate diagonal cpmparison + + if (or(D(:) < minD)) // FIXME : this branch is not tested + i = 1; + peak = cell (); + node2visit = 1:size(D,1); + visited = []; + idx_pruned = idx_s; + + // debug +// h = plot(1:length(data),data,"-",idx_s,data(idx_s),'.r',idx_s,data(idx_s),'.g'); +// set(h(3),"visible","off"); + + while (~isempty (node2visit)) + + d = D(node2visit(1),:); + + visited = [visited node2visit(1)]; + node2visit(1) = []; + + neighs = setdiff (find (d < minD), visited); + if ( ~isempty (neighs)) + // debug +// set(h(3),"xdata",idx_s(neighs),"ydata",data(idx_s(neighs)),"visible","on") +// pause(0.2) +// set(h(3),"visible","off"); + + idx_pruned = setdiff (idx_pruned, idx_s(neighs)); + + visited = [visited neighs]; + node2visit = setdiff (node2visit, visited); + + // debug +// set(h(2),"xdata",idx_pruned,"ydata",data(idx_pruned)) +// pause + end + + end + idx = idx_pruned; + end + + extra = struct ("parabol", [], "height", [], "baseline", [], "roots", []); + + // Estimate widths of peaks and filter for: + // width smaller than given. + // wrong concavity. + // not high enough + // data at peak is lower than parabola by 1% + // position of extrema minus center is bigger equal than minD/2 + // debug +// h = plot(1:length(data),data,"-",idx,data(idx),'.r',... +// idx,data(idx),'og',idx,data(idx),'-m'); +// set(h(4),"linewidth",2) +// set(h(3:4),"visible","off"); + + idx_pruned = idx; + n = length (idx); + np = length (data); + struct_count = 0; + + for i=1:n + ind = (floor (max(idx(i)-minD/2,1)) : ... + ceil (min(idx(i)+minD/2,np))).'; + pp = zeros (1,3); + // If current peak is not local maxima, then fit parabola to neighbor + if or(data(idx(i)-1) == data(idx(i))) + // sample on left same as peak + xm = 0; + pp = ones (1,3); + elseif or(data(ind) > data(idx(i))) + pp = polyfit (ind, data(ind), 2); + xm = -pp(2)^2 / (2*pp(1)); // position of extrema + H = polyval (pp, xm); // value at extrema + else // use it as vertex of parabola + H = data(idx(i)); + xm = idx(i); + pp = zeros (1,3); + pp(1) = pinv((ind-xm).^2 ) * (data(ind)-H); + pp(2) = - 2 * pp(1) * xm; + pp(3) = H + pp(1) * xm^2; + end + + // debug +// x = linspace(ind(1)-1,ind(end)+1,10); +// set(h(4),"xdata",x,"ydata",polyval(pp,x),"visible","on") +// set(h(3),"xdata",ind,"ydata",data(ind),"visible","on") +// pause(0.2) +// set(h(3:4),"visible","off"); + +// thrsh = min (data(ind([1 end]))); +// rz = roots ([pp(1:2) pp(3)-thrsh]); +// width = abs (diff (rz)); + width = sqrt (abs(1 / pp(1))); + + if ( (width > maxW || width < minW) || pp(1) > 0 || H < minH || data(idx(i)) < 0.99*H ||abs (idx(i) - xm) > minD/2) then + idx_pruned = setdiff (idx_pruned, idx(i)); + elseif (nargout > 2) + struct_count=struct_count+1; + extra.parabol(struct_count).x = ind([1 $]); + extra.parabol(struct_count).pp = pp; + + extra.roots(struct_count,1:2)= xm + [-width width]/2; + extra.height(struct_count) = H; + extra.baseline(struct_count) = mean ([H minH]); + end + + // debug +// set(h(2),"xdata",idx_pruned,"ydata",data(idx_pruned)) +// pause(0.2) -select(rhs) -case 1 then - [PKS, LOC, EXTRA] = callOctave("findpeaks", DATA); -case 2 then - [PKS, LOC, EXTRA] = callOctave("findpeaks", DATA, varargin(1)); -case 3 then - [PKS, LOC, EXTRA] = callOctave("findpeaks", DATA, varargin(1), varargin(2)); end + + + idx = idx_pruned; + if (dSided) + pks = __data__(idx); + else + pks = data(idx); + end + + if (transpose) + pks = pks.'; + idx = idx.'; + end + idx = idx.'; + if (nargout() > 2) + varargout(1) = extra; + end + endfunction +/* +demo +pi = %pi ; + t = 2*pi*linspace(0,1,1024)'; + y = sin(3.14*t) + 0.5*cos(6.09*t) + 0.1*sin(10.11*t+1/6) + 0.1*sin(15.3*t+1/3); + data1 = abs(y); + [pks idx] = findpeaks(data1); + data2 = y; + [pks2 idx2] = findpeaks(data2,"DoubleSided"); + [pks3 idx3] = findpeaks(data2,"DoubleSided","MinPeakHeight",0.5); + + subplot(1,2,1) + plot(t,data1,t(idx),data1(idx),'xm') + subplot(1,2,2) + plot(t,data2,t(idx2),data2(idx2),"xm",t(idx3),data2(idx3),"or") + legend("Location","NorthOutside","Orientation","horizontal"); +/////////////////////////////// octave version ///////////////////////////// + t = 2*pi*linspace(0,1,1024)'; + y = sin(3.14*t) + 0.5*cos(6.09*t) + 0.1*sin(10.11*t+1/6) + 0.1*sin(15.3*t+1/3); + data1 = abs(y); + [pks idx] = findpeaks(data1); + data2 = y; + [pks2 idx2] = findpeaks(data2,"DoubleSided"); + [pks3 idx3] = findpeaks(data2,"DoubleSided","MinPeakHeight",0.5); + subplot(1,2,1) + plot(t,data1,t(idx),data1(idx),'xm') + axis tight + subplot(1,2,2) + plot(t,data2,t(idx2),data2(idx2),"xm",t(idx3),data2(idx3),"or") + axis tight + legend("Location","NorthOutside","Orientation","horizontal"); +////////////////////octvae version end //////////////////////////////////////////// +assert_checkequal(size(pks),[11 1]); +assert_checkequal(size(idx),[11 1]); +assert_checkequal(size(pks2),[11 1]); +assert_checkequal(size(idx2),[11 1]); +assert_checkequal(size(pks3),[8 1]); +assert_checkequal(size(idx3),[8 1]); + //---------------------------------------------------------------------------- + + Finding the peaks of smooth data is not a big deal! +// Not as accurate as Octave +demo + t = 2*pi*linspace(0,1,1024)'; + y = sin(3.14*t) + 0.5*cos(6.09*t) + 0.1*sin(10.11*t+1/6) + 0.1*sin(15.3*t+1/3); + data = abs(y + 0.1*rand(length(y),1,'normal')); + [pks idx] = findpeaks(data,"MinPeakHeight",1); + dt = t(2)-t(1); + [pks2 idx2] = findpeaks(data,"MinPeakHeight",1,"MinPeakDistance",round(0.5/dt)); + subplot(1,2,1) + plot(t,data,t(idx),data(idx),'or') + subplot(1,2,2) + plot(t,data,t(idx2),data(idx2),'or') + + ///octave version/////////////////////////////////////////////////////// + t = 2*pi*linspace(0,1,1024)'; + y = sin(3.14*t) + 0.5*cos(6.09*t) + 0.1*sin(10.11*t+1/6) + 0.1*sin(15.3*t+1/3); + data = abs(y + 0.1*randn(length(y),1)); + [pks idx] = findpeaks(data,"MinPeakHeight",1); + dt = t(2)-t(1); + [pks2 idx2] = findpeaks(data,"MinPeakHeight",1,"MinPeakDistance",round(0.5/dt)); + subplot(1,2,1) + plot(t,data,t(idx),data(idx),'or') + subplot(1,2,2) + plot(t,data,t(idx2),data(idx2),'or') + ///////////////////////////////////DO not run enclosed on scilab////////////////////////////////////////////////////// + assert_checkequal(size(pks),[86 1]); + assert_checkequal(size(pks2),[7 1]); + assert_checkequal(size(idx),[86 1]); + assert_checkequal(size(idx2),[7 1]); + + //---------------------------------------------------------------------------- + // Noisy data may need tuning of the parameters. In the 2nd example, + // MinPeakDistance is used as a smoother of the peaks. + +assert_checkequal (findpeaks ([1, 1, 1]),[]) +assert_checkequal (findpeaks ([1; 1; 1]),[]) + + +test + // Test input vector is an oversampled sinusoid with clipped peaks + x = min (3, cos (2*pi*[0:8000] ./ 600) + 2.01); + assert_checkequal (~isempty (findpeaks (x)),%t) + + +test + x = [1 10 2 2 1 9 1]; + [pks, loc] = findpeaks(x); + assert_checkequal (loc, [2 6]) + assert_checkequal (pks, [10 9]) + +// Test input validation +error findpeaks () +error findpeaks (1) +error findpeaks ([1, 2]) + +*/ diff --git a/macros/freqz.sci b/macros/freqz.sci index dc71b75..4579da3 100644 --- a/macros/freqz.sci +++ b/macros/freqz.sci @@ -1,71 +1,247 @@ -function [H, W] = freqz(B, varargin) -//This function returns the complex frequency response H of the rational IIR filter whose numerator and denominator coefficients are B and A, respectively. -//Calling Sequence -//[H, W] = freqz(B, A, N, "whole") -//[H, W] = freqz(B) -//[H, W] = freqz(B, A) -//[H, W] = freqz(B, A, N) -//H = freqz(B, A, W) -//[H, W] = freqz(..., FS) -//freqz(...) -//Parameters -//B, A, N: Integer or Vector -//Description -// Return the complex frequency response H of the rational IIR filter whose numerator and denominator coefficients are B and A, respectively. -// -//The response is evaluated at N angular frequencies between 0 and 2*pi. -// -//The output value W is a vector of the frequencies. -// -//If A is omitted, the denominator is assumed to be 1 (this corresponds to a simple FIR filter). -// -//If N is omitted, a value of 512 is assumed. For fastest computation, N should factor into a small number of small primes. -// -//If the fourth argument, "whole", is omitted the response is evaluated at frequencies between 0 and pi. -// -// 'freqz (B, A, W)' -// -//Evaluate the response at the specific frequencies in the vector W. The values for W are measured in radians. -// -// '[...] = freqz (..., FS)' -// -//Return frequencies in Hz instead of radians assuming a sampling rate FS. If you are evaluating the response at specific frequencies W, those frequencies should be requested in Hz rather than radians. -// -// 'freqz (...)' -// -//Plot the magnitude and phase response of H rather than returning them. -//Examples -//H = freqz([1,2,3], [4,3], [1,2,5]) -//ans = -// 0.4164716 - 0.5976772i - 0.4107690 - 0.2430335i 0.1761948 + 0.6273032i -funcprot(0); -rhs=argn(2); -lhs=argn(1); -if(rhs<2 | rhs>4) then - error("Wrong number of input arguments."); -end -if (lhs<1 | lhs>2) - error("Wrong number of output arguments."); -end -if (lhs==1) then -select(rhs) -case 1 then - H = callOctave("freqz",B); -case 2 then - H = callOctave("freqz",B, varargin(1)); -case 3 then - H = callOctave("freqz",B, varargin(1), varargin(2)); -end -elseif (lhs==2) then - select(rhs) -case 1 then - [H, W] = callOctave("freqz",B); -case 2 then - [H, W] = callOctave("freqz",B, varargin(1)); -case 3 then - [H, W] = callOctave("freqz",B, varargin(1), varargin(2)); -case 4 then - [H, W] = callOctave("freqz", B, varargin(1), varargin(2), varargin(3)); -end -end +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh , Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in + +// Example usage of freqz in different formats: +// [h, w] = freqz (b, a, n, "whole") +// [h, w] = freqz (b) +// [h, w] = freqz (b, a) +// [h, w] = freqz (b, a, n) +// h = freqz (b, a, w) +// [h, w] = freqz (…, Fs) +// freqz (...) + +/* +Return the complex frequency response `h` of the rational IIR filter whose +numerator and denominator coefficients are `b` and `a`, respectively. + +The response is evaluated at `n` angular frequencies between 0 and 2*pi. + +The output value `w` is a vector of the frequencies. + +If `a` is omitted, the denominator is assumed to be 1 (this corresponds to a simple FIR filter). + +If `n` is omitted, a value of 512 is assumed. For fastest computation, `n` should factor into a small number of small primes. + +If the fourth argument, "whole", is omitted, the response is evaluated at frequencies between 0 and pi. + +freqz (b, a, w) + +Evaluate the response at the specific frequencies in the vector `w`. The values for `w` are measured in radians. + +[...] = freqz (…, Fs) + +Return frequencies in Hz instead of radians assuming a sampling rate `Fs`. If you are evaluating the response at specific frequencies `w`, those frequencies should be requested in Hz rather than radians. + +freqz (...) + +Plot the magnitude and phase response of `h` rather than returning them. +*/ +// Dependencies +// fft1 unwrap2 postpad +function [h_r, f_r] = freqz (b, a, n, region, Fs) + + if (nargin < 1) + error("Invalid numbers of inputs"); + elseif (nargin == 1) + // Response of an FIR filter. + a = []; + n = []; + region =[]; + Fs = []; + elseif (nargin == 2) + // Response of an IIR filter + n = []; + region = []; + Fs = []; + elseif (nargin == 3) + region =[]; + Fs = []; + elseif (nargin == 4) + Fs = []; + if (~ (type(region)==10) && ~ isempty(region)) + Fs = region; + region = []; + end + end + + if (isempty (b)) + b = 1; + elseif (~ isvector (b)) + error ("freqz: B must be a vector"); + end + if (isempty (a)) + a = 1; + elseif (~ isvector (a)) + error ("freqz: A must be a vector"); + end + if (isempty (n)) + n = 512; + elseif (isscalar (n) && n < 1) + error ("freqz: N must be a positive integer"); + end + if (isempty (region)) + if (isreal (b) && isreal (a)) + region = "half"; + else + region = "whole"; + end + end + if (isempty (Fs)) + freq_norm = %t; + if (nargout == 1) + Fs = 2; + else + Fs = 2*%pi; + end + else + freq_norm = %f; + end + // FIXME : nargout != 0 even if no output parameter is used + // FIXME : problem in argn() or nargin function + //plot_output = (nargout == 0); + plot_output = (nargout == 1) // temp fix + whole_region = ~strcmp (region, "whole"); + + a = a(:); + b = b(:); + + if (~ isscalar (n)) + // Explicit frequency vector given + w = n; + f = n; + if (nargin == 4) + // Sampling rate Fs was specified + w = 2*%pi*f/Fs; + end + k = max (length (b), length (a)); + hb = polyval (postpad (b, k), exp (%i*w)); + ha = polyval (postpad (a, k), exp (%i*w)); + else + // polyval(fliplr(P),exp(jw)) is O(p n) and fft(x) is O(n log(n)), + // where p is the order of the polynomial P. For small p it + // would be faster to use polyval but in practice the overhead for + // polyval is much higher and the little bit of time saved isn't + // worth the extra code. + k = max (length (b), length (a)); + if (k > n/2 && nargout == 0) + // Ensure a causal phase response. + n = n * 2 .^ ceil (log2 (2*k/n)); + end + + if (whole_region) + N = n; + if (plot_output) + f = Fs * (0:n).' / N; // do 1 more for the plot + else + f = Fs * (0:n-1).' / N; + end + else + N = 2*n; + if (plot_output) + n = n + 1; + end + f = Fs * (0:n-1).' / N; + end + + pad_sz = N*ceil (k/N); + b = postpad (b, pad_sz); + a = postpad (a, pad_sz); + + hb = zeros (n, 1); + ha = zeros (n, 1); + + for i = 1:N:pad_sz + fftresult = fft1 (postpad (b(i:i+N-1), N))(1:n); + if size(fftresult,1) == 1 then fftresult = fftresult';end + hb = hb + fftresult ; + tempfftresult=fft1 (postpad (a(i:i+N-1), N))(1:n); + if size(tempfftresult,1) == 1 then tempfftresult = tempfftresult';end + ha = ha + tempfftresult; + end + + end + + h = hb ./ ha; + + if (plot_output) + // Plot and don't return values. + if (whole_region && isscalar (n)) + h($+1) = h(1); // Solution is periodic. Copy first value to end. + end + freqz_plot (f, h, freq_norm); + end + // Return values and don't plot. + h_r = h; + f_r = f; + + endfunction +function freqz_plot (w, h, freq_norm) + if (nargin < 2) + error("Invalid numbers of inputs"); + end + + if nargin < 3 then + freq_norm = %f + end + n = size(max(w)); + mag = 20 * log10 (abs (h)); + phase = unwrap2 (angle (h)); + + if (freq_norm) + x_label = 'Normalized Frequency (\times\pi rad/sample)'; + else + x_label = "Frequency (Hz)"; + end + subplot (2, 1, 1); + plot (w, mag); + xgrid; + xlabel (x_label); + ylabel ("Magnitude (dB)"); + + subplot (2, 1, 2); + plot (w, phase*360/(2*%pi)); + xgrid; + xlabel (x_label); + ylabel ("Phase (degrees)"); + +endfunction +/* +// passed +testif HAVE_FFTW # correct values and fft-polyval consistency + // butterworth filter, order 2, cutoff pi/2 radians + b = [0.292893218813452 0.585786437626905 0.292893218813452]; + a = [1 0 0.171572875253810]; + [h,w] = freqz (b,a,32); + +//passed +testif HAVE_FFTW # whole-half consistency + b = [1 1 1]/3; + [h,w] = freqz (b,1,32,"whole"); + + [h2,w2] = freqz (b,1,16,"half"); + + +//passed +testif HAVE_FFTW # Sampling frequency properly interpreted + b = [1 1 1]/3; a = [1 0.2]; + [h,f] = freqz (b,a,16,320); + + [h2,f2] = freqz (b,a,[0:15]*10,320); + + [h3,f3] = freqz (b,a,32,"whole",320); + + +// Test input validation +// FIXME: Need to put tests here and simplify input validation in the main code. + +*/ diff --git a/macros/fwhm.sci b/macros/fwhm.sci index 732f623..bb9c186 100644 --- a/macros/fwhm.sci +++ b/macros/fwhm.sci @@ -1,43 +1,148 @@ -function [f] = fwhm(y, varargin) +function myfwhm = fwhm(y, varargin) //This function computes peak full width at half minimum or at another level of peak minimum for vector or matrix data y supplied as input. -//Calling Sequence +//Calling Sequence: //f = fwhm (y) //f = fwhm (x, y) //f = fwhm (…, "zero") //f = fwhm (…, "min") //f = fwhm (…, "alevel", level) //f = fwhm (…, "rlevel", level) -//Parameters -//y: vector or matrix - -//Description -//This is an Octave function. -//This function computes peak full width at half minimum or at another level of peak minimum for vector or matrix data y supplied as input. -//If y is a matrix, fwhm is calculated for each column as a row vector. +//Parameters: +//y- vector or matrix. If y is a matrix, fwhm is calculated for each column as a row vector. //The second argument is by default "zero" which computes the fwhm at half maximum. If it is "min", fwhm is computed at middle curve. //The option "rlevel" computes full-width at the given relative level of peak profile. //The option "alevel" computes full-width at the given absolute level of y. +//Description: +//This function computes peak full width at half minimum or at another level of peak minimum for vector or matrix data y supplied as input. //This function returns 0 if FWHM does not exist. -//Examples +//Examples: //fwhm([1,2,3;9,-7,0.6],[4,5,6]) -//ans = 0. -funcprot(0); - -rhs = argn(2) -if(rhs<1 | rhs>5) -error("Wrong number of input arguments.") -end - -select(rhs) - case 1 then - f = callOctave("fwhm",y) - case 2 then - f = callOctave("fwhm",y,varargin(1)) - case 3 then - f = callOctave("fwhm",y,varargin(1),varargin(2)) - case 4 then - f = callOctave("fwhm",y,varargin(1),varargin(2),varargin(3)) - case 5 then - f = callOctave("fwhm",y,varargin(1),varargin(2),varargin(3),varargin(4)) - end +//ans = 0; + + funcprot(0); + if nargin < 1 || nargin > 5 + error("Wrong number of input arguments."); + end + opt = 'zero'; + is_alevel = 0; + level = 0.5; + if nargin == 1 + x = 1:max(size(y)); + else + if type(varargin(1)) == 10 + x = 1:max(size(y)); + k = 1; + else + x = y; + y = varargin(1); + k = 2; + end + while k <= max(size(varargin)) + if ~strcmp(varargin(k), 'alevel') + is_alevel = 1; + k = k+1; + if k > max(size(varargin)) + error('option alevel requires an argument'); + end + level = varargin(k); + if ~isreal(level) || max(size(level)) > 1 + error('argument of alevel must be real number'); + end + k = k+1; + break + end + if (~strcmp(varargin(k), 'zero') || ~strcmp(varargin(k), 'min')) + opt = varargin(k); + k = k+1; + end + if k > max(size(varargin)) break; end + if ~strcmp(varargin(k), 'rlevel') + k = k+1; + if k > max(size(varargin)) + error('option rlevel requires an argument'); + end + level = varargin(k); + if ~isreal(level) || max(size(level)) > 1 || level(1) < 0 || level(:) > 1 + error('argument of rlevel must be real number from 0 to 1 (it is 0.5 for fwhm)'); + end + k = k+1; + break + end + break + end + if k ~= max(size(varargin))+1 + error('fwhm: extraneous option(s)'); + end + end + + // test the y matrix + [nr, nc] = size(y); + if (nr == 1 & nc > 1) then + y = y'; + nr = nc; + nc = 1; + end + + if max(size(x)) ~= nr then + error('dimension of input arguments do not match'); + end + + // Shift matrix columns so that y(+-xfwhm) = 0: + if is_alevel then + // case: full-width at the given absolute position + y = y - level; + else + if opt == 'zero' then + // case: full-width at half maximum + y = y - level * repmat(mtlb_max(y), nr, 1); + else + // case: full-width above background + y = y - level * repmat((mtlb_max(y) + mtlb_min(y)), nr, 1); + end + end + + myfwhm = zeros(1, nc); // default: 0 for fwhm undefined + for n = 1:nc + yy = y(:, n); + ind = find((yy(1:$ - 1) .* yy(2:$)) <= 0); + if mtlb_max(size(ind)) >= 2 & yy(ind(1)) > 0 then // must start ascending + ind = ind(2:$); + end + [mx, imax] = mtlb_max(yy); // protection against constant or (almost) monotonous functions + if max(size(ind)) >= 2 & imax >= ind(1) & imax <= ind($) then + ind1 = ind(1); + ind2 = ind1 + 1; + xx1 = x(ind1) - yy(ind1) * (x(ind2) - x(ind1)) / (yy(ind2) - yy(ind1)); + ind1 = ind($); + ind2 = ind1 + 1; + xx2 = x(ind1) - yy(ind1) * (x(ind2) - x(ind1)) / (yy(ind2) - yy(ind1)); + myfwhm(n) = xx2 - xx1; + end + end endfunction + +//tests: +//x = -%pi:0.001:%pi; y = cos(x); +//assert_checkalmostequal(fwhm(x, y), 2.094395, 0.5*10^-5); +//assert_checktrue( abs(fwhm(x, y) - 2*%pi/3) < 0.01 ); + +//assert_checktrue(fwhm(-10:10) == 0 && fwhm(ones(1,50)) == 0); + +//x=1:3; +//y=[-1,3,-1]; +//assert_checktrue(abs(fwhm(x,y)-0.75)<0.001 && abs(fwhm(x,y,'zero')-0.75) < 0.001 && abs(fwhm(x,y,'min')-1.0) < 0.001); + +//x=1:3; +//y=[-1,3,-1]; +//assert_checktrue(abs(fwhm(x,y, 'rlevel', 0.1)-1.35) < 0.001 && abs(fwhm(x,y,'zero', 'rlevel', 0.1)-1.35) < 0.001 && abs(fwhm(x,y,'min', 'rlevel', 0.1)-1.40) < 0.001); + +//x=1:3; +//y=[-1,3,-1]; +//assert_checktrue(abs(fwhm(x,y, 'alevel', 2.5)-0.25) < 0.001 && abs(fwhm(x,y,'alevel', -0.5)-1.75) < 0.001); + +//x=-10:10; +//assert_checktrue(fwhm(x.*x) == 0); + +//x=-5:5; +//y=18-x.*x; +//assert_checktrue( abs(fwhm(y)-6.0) < 0.001 && abs(fwhm(x,y,'zero')-6.0) < 0.001 && abs(fwhm(x,y,'min')-7.0 ) < 0.001); diff --git a/macros/fwhmjlt.sci b/macros/fwhmjlt.sci index 129bffc..0821930 100644 --- a/macros/fwhmjlt.sci +++ b/macros/fwhmjlt.sci @@ -1,40 +1,145 @@ -function [f]=fwhmjlt(y,varargin) -//This function Computes peak full-width at half maximum - -//calling sequence -//f = fwhm (y) -//f = fwhm (x, y) -//f = fwhm (…, "zero") -//f = fwhm (…, "min") -//f = fwhm (…, "alevel", level) -//f = fwhm (…, "rlevel", level) - -//Description -//Compute peak full-width at half maximum (FWHM) or at another level of peak maximum for vector or matrix data y, optionally sampled as y(x). If y is a matrix, return FWHM for each column as a row vector. -//The default option "zero" computes fwhm at half maximum, i.e. 0.5*max(y). The option "min" computes fwhm at the middle curve, i.e. 0.5*(min(y)+max(y)). -//The option "rlevel" computes full-width at the given relative level of peak profile +function myfwhm = fwhmjlt(y, varargin) +//This function computes peak full width at half minimum or at another level of peak minimum for vector or matrix data y supplied as input. +//Calling Sequence: +//f = fwhmjlt(y) +//f = fwhmjlt(x, y) +//f = fwhmjlt(…, "zero") +//f = fwhmjlt(…, "min") +//f = fwhmjlt(…, "alevel", level) +//f = fwhmjlt(…, "rlevel", level) +//Parameters: +//y- vector or matrix. If y is a matrix, fwhm is calculated for each column as a row vector. +//The second argument is by default "zero" which computes the fwhm at half maximum. If it is "min", fwhm is computed at middle curve. +//The option "rlevel" computes full-width at the given relative level of peak profile. //The option "alevel" computes full-width at the given absolute level of y. - -//Example +//Description: +//This function computes peak full width at half minimum or at another level of peak minimum for vector or matrix data y supplied as input. +//This function returns 0 if FWHM does not exist. +//Examples: //t=-50:0.01:50; //y=(1/(2*sqrt(2*%pi)))*exp(-(t.^2)/8); //z=fwhmjlt(y) //Output: 470.96442 -rhs = argn(2) -if(rhs<1 | rhs>5) -error("Wrong number of input arguments.") -end - select(rhs) - case 1 then - f = callOctave("fwhm",y) - case 2 then - f = callOctave("fwhm",y,varargin(1)) - case 3 then - f = callOctave("fwhm",y,varargin(1),varargin(2)) - case 4 then - f = callOctave("fwhm",y,varargin(1),varargin(2),varargin(3)) - case 5 then - f = callOctave("fwhm",y,varargin(1),varargin(2),varargin(3),varargin(4)) - end + funcprot(0); + if nargin < 1 || nargin > 5 + error("Wrong number of input arguments."); + end + opt = 'zero'; + is_alevel = 0; + level = 0.5; + if nargin == 1 + x = 1:max(size(y)); + else + if type(varargin(1)) == 10 + x = 1:max(size(y)); + k = 1; + else + x = y; + y = varargin(1); + k = 2; + end + while k <= max(size(varargin)) + if ~strcmp(varargin(k), 'alevel') + is_alevel = 1; + k = k+1; + if k > max(size(varargin)) + error('option alevel requires an argument'); + end + level = varargin(k); + if ~isreal(level) || max(size(level)) > 1 + error('argument of alevel must be real number'); + end + k = k+1; + break + end + if (~strcmp(varargin(k), 'zero') || ~strcmp(varargin(k), 'min')) + opt = varargin(k); + k = k+1; + end + if k > max(size(varargin)) break; end + if ~strcmp(varargin(k), 'rlevel') + k = k+1; + if k > max(size(varargin)) + error('option rlevel requires an argument'); + end + level = varargin(k); + if ~isreal(level) || max(size(level)) > 1 || level(1) < 0 || level(:) > 1 + error('argument of rlevel must be real number from 0 to 1 (it is 0.5 for fwhm)'); + end + k = k+1; + break + end + break + end + if k ~= max(size(varargin))+1 + error('fwhmjlt: extraneous option(s)'); + end + end + + [nr, nc] = size(y); + if (nr == 1 & nc > 1) then + y = y'; + nr = nc; + nc = 1; + end + + if max(size(x)) ~= nr then + error('dimension of input arguments do not match'); + end + + if is_alevel then + y = y - level; + else + if opt == 'zero' then + y = y - level * repmat(mtlb_max(y), nr, 1); + else + y = y - level * repmat((mtlb_max(y) + mtlb_min(y)), nr, 1); + end + end + + myfwhm = zeros(1, nc); + for n = 1:nc + yy = y(:, n); + ind = find((yy(1:$ - 1) .* yy(2:$)) <= 0); + if mtlb_max(size(ind)) >= 2 & yy(ind(1)) > 0 + ind = ind(2:$); + end + [mx, imax] = mtlb_max(yy); + if max(size(ind)) >= 2 & imax >= ind(1) & imax <= ind($) then + ind1 = ind(1); + ind2 = ind1 + 1; + xx1 = x(ind1) - yy(ind1) * (x(ind2) - x(ind1)) / (yy(ind2) - yy(ind1)); + ind1 = ind($); + ind2 = ind1 + 1; + xx2 = x(ind1) - yy(ind1) * (x(ind2) - x(ind1)) / (yy(ind2) - yy(ind1)); + myfwhm(n) = xx2 - xx1; + end + end endfunction + +//tests: +//x = -%pi:0.001:%pi; y = cos(x); +//assert_checkalmostequal(fwhmjlt(x, y), 2.094395, 0.5*10^-5); +//assert_checktrue( abs(fwhmjlt(x, y) - 2*%pi/3) < 0.01 ); + +//assert_checktrue(fwhmjlt(-10:10) == 0 && fwhmjlt(ones(1,50)) == 0); + +//x=1:3; +//y=[-1,3,-1]; +//assert_checktrue(abs(fwhmjlt(x,y)-0.75)<0.001 && abs(fwhmjlt(x,y,'zero')-0.75) < 0.001 && abs(fwhmjlt(x,y,'min')-1.0) < 0.001); + +//x=1:3; +//y=[-1,3,-1]; +//assert_checktrue(abs(fwhmjlt(x,y, 'rlevel', 0.1)-1.35) < 0.001 && abs(fwhmjlt(x,y,'zero', 'rlevel', 0.1)-1.35) < 0.001 && abs(fwhmjlt(x,y,'min', 'rlevel', 0.1)-1.40) < 0.001); + +//x=1:3; +//y=[-1,3,-1]; +//assert_checktrue(abs(fwhmjlt(x,y, 'alevel', 2.5)-0.25) < 0.001 && abs(fwhmjlt(x,y,'alevel', -0.5)-1.75) < 0.001); + +//x=-10:10; +//assert_checktrue(fwhmjlt(x.*x) == 0); + +//x=-5:5; +//y=18-x.*x; +//assert_checktrue( abs(fwhmjlt(y)-6.0) < 0.001 && abs(fwhmjlt(x,y,'zero')-6.0) < 0.001 && abs(fwhmjlt(x,y,'min')-7.0 ) < 0.001); diff --git a/macros/h1_z_deriv.sci b/macros/h1_z_deriv.sci new file mode 100644 index 0000000..65e87e8 --- /dev/null +++ b/macros/h1_z_deriv.sci @@ -0,0 +1,47 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +function b = h1_z_deriv(n, p, ts) + + // Build the vector d that holds coefficients for all the derivatives of H1(z) + // The results reads d(n)*z^(1)*(d/dz)^(1)*H1(z) + d(n-1)*z^(2)*(d/dz)^(2)*H1(z) +...+ d(1)*z^(n)*(d/dz)^(n)*H1(z) + d = (-1)^n; // Vector with the derivatives of H1(z) + for i= (1:n-1) + d = [d 0]; // Shift result right (multiply by -z) + d = d + prepad(polyder(d), i+1, 0, 2); // Add the derivative + end + + // Build output vector + b = zeros (1, n + 1); + for i = (1:n) + b = b + d(i) * prepad(h1_deriv(n-i+1), n+1, 0, 2); + end + b = b * ts^(n+1)/factorial(n); + // Multiply coefficients with p^i, where i is the index of the coeff. + b = b.*p.^(n+1:-1:1); +endfunction + +// Find (z^n)*(d/dz)^n*H1(z), where H1(z)=ts*z/(z-p), ts=sampling period, +// p=exp(sm*ts) and sm is the s-domain pole with multiplicity n+1. +// The result is (ts^(n+1))*(b(1)*p/(z-p)^1 + b(2)*p^2/(z-p)^2 + b(n+1)*p^(n+1)/(z-p)^(n+1)), +// where b(i) is the binomial coefficient bincoeff(n,i) times n!. Works for n>0. + +function b = h1_deriv(n) + b = factorial(n)*nchoosek(n,0:n); // Binomial coefficients: [1], [1 1], [1 2 1], [1 3 3 1], etc. + b = b*(-1)^n; +endfunction + +function y = polyder(a) + y = poly(flipdim(a,2),'a','coeff') + y = derivat(y) + y = coeff(y) +endfunction + diff --git a/macros/hurst.sci b/macros/hurst.sci index 27507fb..bd48ee7 100644 --- a/macros/hurst.sci +++ b/macros/hurst.sci @@ -1,21 +1,47 @@ -function y = hurst(x) -// Estimate the Hurst parameter of sample X via the rescaled r statistic. -//Calling Sequence -//hurst(X) -//variable=hurst(X) -//Parameters -//X: X is a matrix, the parameter of sample X via the rescaled r statistic -//Description -//This is an Octave function. -//This function estimates the Hurst parameter of sample X via the rescaled rstatistic. -funcprot(0); -rhs= argn(2); -if(rhs<1 | rhs>1) - error("Wrong number of input arguments"); -end +function H = hurst(x) +//Estimate the Hurst parameter of sample X via the rescaled range statistic. +//Calling Sequence: +//hurst(x) +//Parameters: +//x: x is a vector or matrix +//Description: +//This function estimates the Hurst parameter of sample x using the rescaled range statistic. +//If x is a matrix, the parameter is estimated for every column. +//Examples: +//hurst([10, 15, 3]) +//ans = 0.045019 + + funcprot(0); + if (argn(2) ~= 1) + error("hurst: wrong number of input arguments"); + end + + if (isscalar(x)) + error ("hurst: argument must not be a scalar"); + end + if (isvector(x)) + x = x(:); + end + + [xr, xc] = size (x); + + s = stdev(x, 'r'); + y = []; + for i = 1:xr + y(i, :) = x(i, :) - mean(x, 'm'); + end + w = cumsum(y); + RS = (max(w, 'r') - min(w, 'r')) ./ s; + H = log(RS) / log(xr); -select(rhs) - case 1 then - y= callOctave("hurst", x); -end endfunction + +//input validation: +//assert_checkerror("hurst()", "hurst: wrong number of input arguments"); +//assert_checkerror("hurst(1, 2, 3)", "Wrong number of input arguments."); +//assert_checkerror("hurst(1)", "hurst: argument must not be a scalar"); + +//tests: +//assert_checkalmostequal(hurst([1, 5, 7, 14, 6]), 0.31180, 5*10^-5); +//assert_checkalmostequal(hurst([3; 6; 9; 5]), 0.24271, 5*10^-5); +//assert_checkalmostequal(hurst([-1, 9, 4; 7, 4, -3; 6, 12, -18]),[ 0.124902, 0.063474, 0.084510], 5*10^-5); diff --git a/macros/ifftshift1.sci b/macros/ifftshift1.sci index 7426130..c81a285 100644 --- a/macros/ifftshift1.sci +++ b/macros/ifftshift1.sci @@ -1,24 +1,83 @@ -function y= ifftshift1(X,DIM) +function y = ifftshift1(x, dim) //Undo the action of the 'fftshift1' function. -//Calling Sequence -// ifftshift1 (X) -// ifftshift1 (X, DIM) -//Parameters -//X:It is a vector of N elements corresponding to time samples -//DIM: The optional DIM argument can be used to limit the dimension along which the permutation occurs -//Description -//This is an Octave function. -//Undo the action of the 'fftshift1' function. -// -//For even length X, 'fftshift1' is its own inverse, but odd lengths differ slightly. - rhs= argn(2); - if(rhs <1 | rhs >2) - error('Wrong number of Input arguments'); - end - select(rhs) - case 1 then - y=callOctave("ifftshift",X); - case 2 then - y=callOctave("ifftshift",X,DIM); - end -endfunction
\ No newline at end of file +//Calling Sequence: +// ifftshift1(x) +// ifftshift1(x, dim) +//Parameters: +//x- It is a vector of N elements corresponding to time samples +//dim- The optional DIM argument can be used to limit the dimension along which the permutation occurs +//Description: +//Undoes the action of the 'fftshift1' function. For 'x' of even length 'fftshift1' is its own inverse, but odd lengths differ slightly. +//Examples: +//x = [1, 2, 3, 4]; +//ifftshift1(fftshift1(x)); +//ans = +//[1, 2, 3, 4]; + + funcprot(0); + rhs = argn(2); + if (rhs < 1 | rhs > 2) then + error ("ifftshift1: wrong number of arguments"); + end + + if (~or(type(x) == [1 5 8 10 4 6])) + error ("ifftshitft1: arg1 (x) must be a vector or matrix"); + end + + if (rhs == 1) then + dim = 1:max(size(size(x))); + else + if (~(isscalar(dim) & dim > 0 & dim == fix(dim))) then + error ("ifftshift1: arg2 (dim) must be a positive integer"); + end + end + + for d = dim + sz = size(x); + sz2 = floor(sz(d) / 2); + dim_idx = [sz2+1:sz(d), 1:sz2]; + if (d == 1) then + x = x(dim_idx, :); + elseif ( d == max(size(size(x))) ) then + x = x(:, dim_idx); + else + idx = repmat({':'}, 1, max(size(size(x)))); + idx(d) = {dim_idx}; + x = x(idx{:}); + end + end + y = x; + +endfunction + +//input validation: +//assert_checkerror("ifftshift1()", "ifftshift1: wrong number of arguments"); +//assert_checkerror("ifftshift1(1, 2, 3)", "Wrong number of input arguments."); +//assert_checkerror("ifftshift1(0:2, -1)", "ifftshift1: arg2 (dim) must be a positive integer"); +//assert_checkerror("ifftshift1(0:2, 0:3)", "ifftshift1: arg2 (dim) must be a positive integer"); + +//test mx1 input: +//x = [0:7]; +//y = ifftshift1(x); +//assert_checkequal(y, [4 5 6 7 0 1 2 3]); +//assert_checkequal(ifftshift1(y), x); + +//test 1xm input: +//x = [0:6]'; +//y = ifftshift1(x); +//assert_checkequal(y, [3;4;5;6;0;1;2]); +//assert_checkequal(ifftshift1(y), [6;0;1;2;3;4;5]); + +//test mxn input: +//x = [0:3]; +//x = [x;2*x;3*x+1;4*x+1]; +//y = ifftshift1(x); +//assert_checkequal(y, [[7 10 1 4];[9 13 1 5];[2 3 0 1];[4 6 0 2]]); +//assert_checkequal(ifftshift1(y), x); + +//test dim is provided: +//x = [0:3]; +//x = [x;2*x;3*x+1;4*x+1]; +//y = ifftshift1(x, 2); +//assert_checkequal(y, [[2 3 0 1];[4 6 0 2];[7 10 1 4];[9 13 1 5]]); +//assert_checkequal(ifftshift1(y, 2), x); diff --git a/macros/ifht.sci b/macros/ifht.sci index 7f865cb..b1a7000 100644 --- a/macros/ifht.sci +++ b/macros/ifht.sci @@ -1,34 +1,64 @@ -function m = ifht(d, varargin) -//Calculate the inverse Fast Hartley Transform of real input D -//Calling Sequence -//m= ifht (d) -//m= ifht (d,n) -//m= ifht (d,n,dim) -//Parameters -//d: real or complex valued scalar or vector -//n: Similar to the options of FFT function -//dim: Similar to the options of FFT function -//Description -//Calculate the inverse Fast Hartley Transform of real input d. If d is a matrix, the inverse Hartley transform is calculated along the columns by default. The options n and dim are similar to the options of FFT function. -// +function m = ifht(d, n, dim) +//Calculate the inverse Fast Hartley Transform of real input D. +//Calling Sequence: +//m: ifht(d) +//m: ifht(d,n) +//m: ifht(d,n,dim) +//Parameters: +//d: Real or complex scalar or vector. +//n: Integer. Specifies the number of elements of x to be used. +//dim: Integer. Specifies the dimention of the matrix along which the ifht is performed. +//Description: +//Calculate the inverse Fast Hartley Transform of real input d. If d is a matrix, the inverse Hartley transform is calculated along the columns by default. +//The options n and dim are similar to the options of FFT function. 'n' is an integer that determines the number of elements of 'd' to use. If 'n' is larger than the dimension along which the ifht is calculated, then 'd' is resized and padded with zeros to match the required size. If n < d, then 'd' is truncated to match the required size. +//'dim' is an integer that specifies the dimension of the matrix along which the ifht is to be performed. By default, the ifht is computed along the first non-singleton dimension of the array. //The forward and inverse Hartley transforms are the same (except for a scale factor of 1/N for the inverse hartley transform), but implemented using different functions. -// -//The definition of the forward hartley transform for vector d, m[K] = 1/N \sum_{i=0}^{N-1} d[i]*(cos[K*2*pi*i/N] + sin[K*2*pi*i/N]), for 0 <= K < N. m[K] = 1/N \sum_{i=0}^{N-1} d[i]*CAS[K*i], for 0 <= K < N. -//Examples +//The definition of the forward hartley transform for vector d, m[K] = 1/N \sum_{i=0}^{N-1} d[i]*(cos[K*2*pi*i/N] + sin[K*2*pi*i/N]), +//for 0 <= K < N. m[K] = 1/N \sum_{i=0}^{N-1} d[i]*CAS[K*i], for 0 <= K < N. +//Examples: //ifht(1 : 4) -//ifht(1:4, 2) -funcprot(0); -rhs= argn(2); -if(rhs<1 | rhs>3) -error("Wrong number of Inputs") -end +//ans = [2.5, -1, -0.5, 0] + + funcprot(0); + rhs = argn(2); + if (rhs < 1 | rhs > 3) + error("Wrong number of input arguments."); + end + dimension = size(d); + nd = find(dimension ~= 1, 1); + if (rhs == 3) + if isempty(n) + y = fft(d, 1, dim); + else + dimension(dim)=n; + y=fft(resize_matrix(d, dimension), 1, dim); + end + elseif (rhs == 2) + if isempty(n) + y = fft(d, 1, nd); + else + dimension(nd) = n; + y=fft(resize_matrix(d, dimension), 1, nd) + end + else + y = fft(d, 1, nd); + end + + m = real(y) + imag(y); -select(rhs) - case 1 then - m= callOctave("ifht", d); - case 2 then - m= callOctave("ifht", d , varargin(1)); - case 3 then - m= callOctave("ifht", d , varargin(1),varargin(2) ); -end endfunction + +//input validation: +//assert_checkerror("ifht()", "Wrong number of input arguments."); +//assert_checkerror("ifht(1, 2, 3, 4)", "Wrong number of input arguments."); + +////tests: +//assert_checkequal(ifht(1+2*%i), 3); +//assert_checkequal(ifht((1:4)), [2.5, -1, -0.5, 0]); +//assert_checkequal(ifht([1:4]', 2), [1.5; -0.5]); +//assert_checkequal(ifht([1:4]', 2, 2), [0.5 0.5; 1 1; 1.5 1.5; 2 2]); +//assert_checkequal(ifht([-1 2; 3 -5]), [1 -1.5; -2 3.5]); +//assert_checkalmostequal(ifht([1:3; -2:-5]), [2, -0.7887, -0.2113], 5*10^-4); +//assert_checkequal(ifht([1:3; -2:-5], 1, 1), [1:3]); +//assert_checkequal(ifht([1+2*%i, 3*%i; -4-3*%i, -5*%i]), [-2 -1; 5 4]); +//assert_checkequal(ifht([1+2*%i, 3*%i; -4-3*%i, -5*%i], 1, 2), [3; -7]); diff --git a/macros/iirlp2mb.sci b/macros/iirlp2mb.sci index 54f1a6b..09ec743 100644 --- a/macros/iirlp2mb.sci +++ b/macros/iirlp2mb.sci @@ -1,41 +1,345 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +// IIR Low Pass Filter to Multiband Filter Transformation +// +// [Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B,A,Wo,Wt) +// [Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B,A,Wo,Wt,Pass) +// +// Num,Den: numerator,denominator of the transformed filter +// AllpassNum,AllpassDen: numerator,denominator of allpass transform, +// B,A: numerator,denominator of prototype low pass filter +// Wo: normalized_angular_frequency/pi to be transformed +// Wt: [phi=normalized_angular_frequencies]/pi target vector +// Pass: This parameter may have values 'pass' or 'stop'. If +// not given, it defaults to the value of 'pass'. +// +// With normalized ang. freq. targets 0 < phi(1) < ... < phi(n) < pi radians +// +// for Pass == 'pass', the target multiband magnitude will be: +// -------- ---------- -----------... +// / \ / \ / . +// 0 phi(1) phi(2) phi(3) phi(4) phi(5) (phi(6)) pi +// +// for Pass == 'stop', the target multiband magnitude will be: +// ------- --------- ----------... +// \ / \ / . +// 0 phi(1) phi(2) phi(3) phi(4) (phi(5)) pi +// function [Num,Den,AllpassNum,AllpassDen] = iirlp2mb(varargin) -//This function does IIR Low Pass Filter to Multiband Filter Transformation. -//Calling Sequence -//[Num, Den, AllpassNum, AllpassDen] = iirlp2mb(B, A, Wo, Wt) -//[Num, Den, AllpassNum, AllpassDen] = iirlp2mb(B, A, Wo, Wt, Pass) -//Parameters -//B: real or complex value -//A: real or complex value -//Wo: scalar or vector -//Wt: scalar or vector, elements must be monotonically increasing and >= 0 and <= 1. -//Description -//This is an Octave function. -//This function does IIR Low Pass Filter to Multiband Filter Transformation. -//The first two parameters give the numerator and denominator of the prototype low pass filter. -//The third parameter is the normalized angular frequency/pi to be transformed. -//The fourth parameter is the normalized angular frequency/pi target vector. -//The first two output variables are the numerator and denominator of the transformed filter. -//The third and fourth output variables are the numerator and denominator of the allpass transform. -//The fifth parameter can have values pass or stop, default value is pass. -//Examples -//iirlp2mb(5,9,0.3,0.4) -//ans = 0.55556 - -B = varargin(1) -A = varargin(2) -Wo = varargin(3) -Wt = varargin(4) -rhs = argn(2) -lhs = argn(1) -if(rhs < 4 | rhs > 5) -error("Wrong number of input arguments.") -end -select(rhs) -case 4 then -[Num,Den,AllpassNum,AllpassDen] = callOctave("iirlp2mb",varargin(1),varargin(2),varargin(3),varargin(4)) -case 5 then -[Num,Den,AllpassNum,AllpassDen] = callOctave("iirlp2mb",varargin(1),varargin(2),varargin(3),varargin(4),varargin(5)) -end + + usage = sprintf("iirlp2mb Usage: [Num,Den,AllpassNum,AllpassDen]=iirlp2mb(B,A,Wo,Wt[,Pass])\n"); + B = varargin(1); // numerator polynomial of prototype low pass filter + A = varargin(2); // denominator polynomial of prototype low pass filter + Wo = varargin(3); // (normalized angular frequency)/pi to be transformed + Wt = varargin(4); // vector of (norm. angular frequency)/pi transform targets + // [phi(1) phi(2) ... ]/pi + if(nargin < 4 || nargin > 5) + error(usage) + end + + // Checking proper input arguments + if ~isvector(B) then + if ~isscalar(B) then // if numerator is having only one coeffcient then it can be passed directly + error(sprintf("iirlp2mb : Argument B must be a vector containing numerator polynomial of the prototype low pass filter\n %s",usage)); + end + end + if ~isvector(A) then + if ~isscalar(A)then // if Denominator is having only one coeffcient then it can be passed directly + error(sprintf("iirlp2mb : A must be a vector containing denominator polynomial of the prototype low pass filter\n %s",usage)); + end + end + if(nargin == 5) + Pass = varargin(5); + switch(Pass) + case 'pass' + pass_stop = -1; + case 'stop' + pass_stop = 1; + otherwise + error(sprintf("Pass must be pass or stop\n%s",usage)) + end + else + pass_stop = -1; // Pass == 'pass' is the default + end + if(abs(Wo) <= 0) + error(sprintf("Wo is %f <= 0\n%s",abs(Wo),usage)); + end + if(abs(Wo) >= 1) + error(sprintf("Wo is %f >= 1\n%s",abs(Wo),usage)); + end + oWt = 0; + for i = 1 : length(Wt) + if(abs(Wt(i)) <= 0) + error(sprintf("Wt(%d) is %f <= 0\n%s",i,abs(Wt(i)),usage)); + end + if(abs(Wt(i)) >= 1) + error(sprintf("Wt(%d) is %f >= 1\n%s",i,abs(Wt(i)),usage)); + end + if(abs(Wt(i)) <= oWt) + error(sprintf("Wt(%d) = %f, not monotonically increasing\n%s",i,abs(Wt(i)),usage)); + else + oWt = Wt(i); + end + end + + // B(z) + // Inputs B,A specify the low pass IIR prototype filter G(z) = ---- . + // A(z) + // This module transforms G(z) into a multiband filter using the iterative + // algorithm from: + // [FFM] G. Feyh, J. Franchitti, and C. Mullis, "All-Pass Filter + // Interpolation and Frequency Transformation Problem", Proceedings 20th + // Asilomar Conference on Signals, Systems and Computers, Nov. 1986, pp. + // 164-168, IEEE. + // [FFM] moves the prototype filter position at normalized angular frequency + // .5*pi to the places specified in the Wt vector times pi. In this module, + // a generalization allows the position to be moved on the prototype filter + // to be specified as Wo*pi instead of being fixed at .5*pi. This is + // implemented using two successive allpass transformations. + // KK(z) + // In the first stage, find allpass J(z) = ---- such that + // K(z) + // jWo*pi -j.5*pi + // J(e ) = e (low pass to low pass transformation) + // + // PP(z) + // In the second stage, find allpass H(z) = ---- such that + // P(z) + // jWt(k)*pi -j(2k - 1)*.5*pi + // H(e ) = e (low pass to multiband transformation) + // + // ^ + // The variable PP used here corresponds to P in [FFM]. + // len = length(P(z)) == length(PP(z)), the number of polynomial coefficients + // + // len 1-i len 1-i + // P(z) = SUM P(i)z ; PP(z) = SUM PP(i)z ; PP(i) == P(len + 1 - i) + // i=1 i=1 (allpass condition) + // Note: (len - 1) == n in [FFM] eq. 3 + // + // The first stage computes the denominator of an allpass for translating + // from a prototype with position .5 to one with a position of Wo. It has the + // form: + // -1 + // K(2) - z + // ----------- + // -1 + // 1 - K(2)z + // + // From the low pass to low pass transformation in Table 7.1 p. 529 of A. + // Oppenheim and R. Schafer, Discrete-Time Signal Processing 3rd edition, + // Prentice Hall 2010, one can see that the denominator of an allpass for + // going in the opposite direction can be obtained by a sign reversal of the + // second coefficient, K(2), of the vector K (the index 2 not to be confused + // with a value of z, which is implicit). + + // The first stage allpass denominator computation + K = apd([%pi * Wo]); + + // The second stage allpass computation + phi = %pi * Wt; // vector of normalized angular frequencies between 0 and pi + P = apd(phi); // calculate denominator of allpass for this target vector + PP = flipdim(P,2); // numerator of allpass has reversed coefficients of P + + // The total allpass filter from the two consecutive stages can be written as + // PP + // K(2) - --- + // P P + // ----------- * --- + // PP P + // 1 - K(2)--- + // P + AllpassDen = P - (K(2) * PP); + AllpassDen = AllpassDen / AllpassDen(1); // normalize + AllpassNum = pass_stop * flipdim(AllpassDen,2); + [Num,Den] = transform(B,A,AllpassNum,AllpassDen,pass_stop); + endfunction +function [Num,Den] = transform(B,A,PP,P,pass_stop) + + // Given G(Z) = B(Z)/A(Z) and allpass H(z) = PP(z)/P(z), compute G(H(z)) + // For Pass = 'pass', transformed filter is: + // 2 nb-1 + // B1 + B2(PP/P) + B3(PP/P)^ + ... + Bnb(PP/P)^ + // ------------------------------------------------- + // 2 na-1 + // A1 + A2(PP/P) + A3(PP/P)^ + ... + Ana(PP/P)^ + // For Pass = 'stop', use powers of (-PP/P) + // + na = length(A); // the number of coefficients in A + nb = length(B); // the number of coefficients in B + // common low pass iir filters have na == nb but in general might not + n = max(na,nb); // the greater of the number of coefficients + // n-1 + // Multiply top and bottom by P^ yields: + // + // n-1 n-2 2 n-3 nb-1 n-nb + // B1(P^ ) + B2(PP)(P^ ) + B3(PP^ )(P^ ) + ... + Bnb(PP^ )(P^ ) + // --------------------------------------------------------------------- + // n-1 n-2 2 n-3 na-1 n-na + // A1(P^ ) + A2(PP)(P^ ) + A3(PP^ )(P^ ) + ... + Ana(PP^ )(P^ ) + + // Compute and store powers of P as a matrix of coefficients because we will + // need to use them in descending power order + global Ppower; // to hold coefficients of powers of P, access inside ppower() + np = length(P); + powcols = np + (np-1)*(n-2); // number of coefficients in P^(n-1) + // initialize to "Not Available" with n-1 rows for powers 1 to (n-1) and + // the number of columns needed to hold coefficients for P^(n-1) + Ppower = %nan * ones(n-1,powcols); + Ptemp = P; // start with P to the 1st power + for i = 1 : n-1 // i is the power + for j = 1 : length(Ptemp) // j is the coefficient index for this power + Ppower(i,j) = Ptemp(j); + end + Ptemp = conv(Ptemp,P); // increase power of P by one + end + + // Compute numerator and denominator of transformed filter + Num = []; + Den = []; + for i = 1 : n + // n-i + // Regenerate P^ (p_pownmi) + if((n-i) == 0) + p_pownmi = [1]; + else + p_pownmi = ppower(n-i,powcols); + end + // i-1 + // Regenerate PP^ (pp_powim1) + if(i == 1) + pp_powim1 = [1]; + else + pp_powim1 = flipdim(ppower(i-1,powcols),2); + end + if(i <= nb) + Bterm = (pass_stop^(i-1))*B(i)*conv(pp_powim1,p_pownmi); + Num = polysum(Num,Bterm); + end + if(i <= na) + Aterm = (pass_stop^(i-1))*A(i)*conv(pp_powim1,p_pownmi); + Den = polysum(Den,Aterm); + end + end + // Scale both numerator and denominator to have Den(1) = 1 + temp = Den(1); + for i = 1 : length(Den) + Den(i) = Den(i) / temp; + end + for i = 1 : length(Num) + Num(i) = Num(i) / temp; + end + +endfunction + +function P = apd(phi) // all pass denominator + // Given phi, a vector of normalized angular frequency transformation targets, + // return P, the denominator of an allpass H(z) + lenphi = length(phi); + Pkm1 = 1; // P0 initial condition from [FFM] eq. 22 + for k = 1:lenphi + P = pk(Pkm1, k, phi(k)); // iterate + Pkm1 = P; + end + +endfunction + +function Pk = pk(Pkm1, k, phik) // kth iteration of P(z) + + // Given Pkminus1, k, and phi(k) in radians , return Pk + // + // From [FFM] eq. 19 : k + // Pk = (z+1 )sin(phi(k)/2)Pkm1 - (-1) (z-1 )cos(phi(k)/2)PPkm1 + // Factoring out z + // -1 k -1 + // = z((1+z )sin(phi(k)/2)Pkm1 - (-1) (1-z )cos(phi(k)/2)PPkm1) + // PPk can also have z factored out. In H=PP/P, z in PPk will cancel z in Pk, + // so just leave out. Use + // -1 k -1 + // PK = (1+z )sin(phi(k)/2)Pkm1 - (-1) (1-z )cos(phi(k)/2)PPkm1 + // (expand) k + // = sin(phi(k)/2)Pkm1 - (-1) cos(phi(k)/2)PPkm1 + // + // -1 k -1 + // + z sin(phi(k)/2)Pkm1 + (-1) z cos(phi(k)/2)PPkm1 + Pk = zeros(1,k+1); // there are k+1 coefficients in Pk + sin_k = sin(phik/2); + cos_k = cos(phik/2); + for i = 1 : k + Pk(i) = Pk(i)+ sin_k * Pkm1(i) - ((-1)^k * cos_k * Pkm1(k+1-i)); + // + // -1 + // Multiplication by z just shifts by one coefficient + Pk(i+1) = Pk(i+1)+ sin_k * Pkm1(i) + ((-1)^k * cos_k * Pkm1(k+1-i)); + end + // now normalize to Pk(1) = 1 (again will cancel with same factor in PPk) + Pk1 = Pk(1); + for i = 1 : k+1 + Pk(i) = Pk(i) / Pk1; + end + +endfunction +function p = ppower(i,powcols) // Regenerate ith power of P from stored PPower + + global Ppower + if(i == 0) + p = 1; + else + p = []; + for j = 1 : powcols + if(isnan(Ppower(i,j))) + break; + end + p = [p, Ppower(i,j)]; + end + end + +endfunction + +function poly = polysum(p1,p2) // add polynomials of possibly different length + + n1 = length(p1); + n2 = length(p2); + if(n1 > n2) + // pad p2 + p2 = [p2, zeros(1,n1-n2)]; + elseif(n2 > n1) + // pad p1 + p1 = [p1, zeros(1,n2-n1)]; + end + poly = p1 + p2; + +endfunction + +/* +test passed +// Butterworth filter of order 3 with cutoff frequency 0.5 +B = [0.1667 0.5000 0.5000 0.1667]; +A = [1.0000e+00 -3.0531e-16 3.3333e-01 -1.8504e-17 ] ; +[Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B, A, 0.5, [.2 .4 .6 .8]) // 5th argument default pass +[Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B, A,[.2 .4 .6 .8],0.2) // 5th argument default pass +[Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B, A, 0.5, [.2 .4 .6 .8],"stop") +[Num,Den,AllpassNum,AllpassDen] = iirlp2mb(B, A,[.2 .4 .6 .8],0.5,"stop") + +test passed +// scalar input for B and A +[Num,Den,AllpassNum,AllpassDen] = iirlp2mb(0, 0, 0.5, [.2 .4 .6 .8]) +[Num,Den,AllpassNum,AllpassDen] = iirlp2mb(1, 2, [.2 .4 .6 .8],0.2,"stop") + + +test passed +// complex B and A +[Num,Den,AllpassNum,AllpassDen] = iirlp2mb([%i,2+%i],[1 2*%i 3], [.2 .4 .6 .8],0.2,"stop") +*/
\ No newline at end of file diff --git a/macros/impinvar.sci b/macros/impinvar.sci index cc9aa6f..57fdb88 100644 --- a/macros/impinvar.sci +++ b/macros/impinvar.sci @@ -1,43 +1,146 @@ -function [b_out, a_out] = impinvar (b, a, fs, tol) -//This function converts analog filter with coefficients b and a to digital, conserving impulse response. -//Calling Sequence -//[b, a] = impinvar (b, a) -//[b, a] = impinvar (b, a, fs) -//[b, a] = impinvar (b, a, fs, tol) -//Parameters -//b: real or complex valued scalar or vector -//a: real or complex valued scalar or vector, order should be greater than b -//fs: real or complex value, default value 1Hz -//tol: real or complex value, default value 0.0001 -//Description -//This is an Octave function. -//This function converts analog filter with coefficients b and a to digital, conserving impulse response. -//This function does the inverse of impinvar. -//Examples -//b = 0.0081000 -//a = [2.0000000, 0.56435378, 0.4572792, 0.00705544, 0.091000] -//[ay,by] = impinvar(b,a,10) -//ay = -// 0.0000e+00 7.5293e-08 2.9902e-07 7.4238e-08 -//by = -// 1.00000 -3.96992 5.91203 -3.91428 0.97218 - -funcprot(0); -rhs = argn(2) -if(rhs<2) -error("Wrong number of input arguments.") -end - - - select(rhs) - case 2 then -// [b, a] = callOctave("impinvar",b,a) - [b_out, a_out] = callOctave("impinvar",b,a) - case 3 then -// [b, a] = callOctave("impinvar",b,a,fs) - [b_out, a_out] = callOctave("impinvar",b,a,fs) - case 4 then -// [b, a] = callOctave("impinvar",b,a,fs,tol) - [b_out, a_out] = callOctave("impinvar",b,a,fs,tol) - end +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh , SOE CUSAT +// Last Modified on : Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in + +/* +Calling Sequence +[b_out, a_out] = impinvar (b, a, fs, tol) +[b_out, a_out] = impinvar (b, a, fs) +[b_out, a_out] = impinvar (b, a) +Converts analog filter with coefficients b and a to digital, conserving impulse response. + +If fs is not specified, or is an empty vector, it defaults to 1Hz. + +If tol is not specified, it defaults to 0.0001 (0.1%) This function does the inverse of impinvar so that the following example should restore the original values of a and b. + +invimpinvar implements the reverse of this function. + +[b, a] = impinvar (b, a); +[b, a] = invimpinvar (b, a); +Reference: Thomas J. Cavicchi (1996) “Impulse invariance and multiple-order poles”. IEEE transactions on signal processing, Vol 44 (9): 2344–2347 +Dependencies + residue + + +*/ +function [b_out, a_out] = impinvar (b_in, a_in, fs , tol) + error("impinvar: Missing functionality .This function is not implemented yet. Will available in next release"); +endfunction +/* + if (nargin <2) + error ("impinvar: Insufficient input arguments"); + end + if nargin < 3 + fs = 1; + end + if nargin < 4 + tol = 0.0001; + end + // to be compatible with the matlab implementation where an empty vector can + // be used to get the default + if (isempty(fs)) + ts = 1; + else + ts = 1/fs; // we should be using sampling frequencies to be compatible with Matlab + end + + [r_in, p_in, k_in] = residue(b_in, a_in); // partial fraction expansion + + n = length(r_in); // Number of poles/residues + + if (length(k_in)>0) // Greater than zero means we cannot do impulse invariance + error("Order numerator >= order denominator"); + end + + r_out = zeros(1,n); // Residues of H(z) + p_out = zeros(1,n); // Poles of H(z) + k_out = 0; // Constant term of H(z) + + i=1; + while (i<=n) + m = 1; + first_pole = p_in(i); // Pole in the s-domain + while (i<n && abs(first_pole-p_in(i+1))<tol) // Multiple poles at p(i) + i=i+1; // Next residue + m=m+1; // Next multiplicity + end + [r, p, k] = z_res(r_in(i-m+1:i), first_pole, ts); // Find z-domain residues + k_out = k_out + k; // Add direct term to output + p_out(i-m+1:i) = p; // Copy z-domain pole(s) to output + r_out(i-m+1:i) = r; // Copy z-domain residue(s) to output + + i=i+1; // Next s-domain residue/pole + end + + [b_out, a_out] = inv_residue(r_out, p_out, k_out, tol); + a_out = to_real(a_out); // Get rid of spurious imaginary part + b_out = to_real(b_out); + + // Shift results right to account for calculating in z instead of z^-1 + b_out($)=[]; endfunction +*/ +// Convert residue vector for single and multiple poles in s-domain (located at sm) to +// residue vector in z-domain. The variable k is the direct term of the result. + +function [r_out, p_out, k_out] = z_res (r_in, sm, ts) + + p_out = exp(ts * sm); // z-domain pole + n = length(r_in); // Multiplicity of the pole + r_out = zeros(1,n); // Residue vector + + // First pole (no multiplicity) + k_out = r_in(1) * ts; // PFE of z/(z-p) = p/(z-p)+1; direct part + r_out(1) = r_in(1) * ts * p_out; // pole part of PFE + + for i=(2:n) // Go through s-domain residues for multiple pole + r_out(1:i) = r_out(1:i) + r_in(i) * polyrev(h1_z_deriv(i-1, p_out, ts)); // Add z-domain residues + end + +endfunction +function p_out = polyrev (p_in) + + p_out = p_in($:-1:1); + + +endfunction +function p_out = to_real(p_in) + + p_out = abs(p_in) .* sign(real(p_in)); + + endfunction +/* +//test passed +[b_out,a_out]=impinvar([1],[1 1],100); +assert_checkalmostequal(b_out,0.01,%eps,1e-4) +assert_checkalmostequal(a_out,[1 -0.99],%eps,1e-4) + +//test passed +[b_out,a_out]=impinvar([1],[1 2 1],100) +assert_checkalmostequal(b_out,[0 9.9005e-5],%eps,1e-4) +assert_checkalmostequal(a_out,[1 -1.9801 0.9802],%eps,1e-4) + +[b_out, a_out] = impinvar([1], [1 3 3 1], 100) // test passed + +[b_out, a_out] = impinvar([1 1], [1 3 3 1], 100) // test passed + +[b_out, a_out] = impinvar([1 1 1], [1 3 3 1], 100) // test passed + +// FIXME : builtin filter doesn't accepts complex parameters +// These test cases will through errors +// [b_out, a_out] = impinvar([1], [1 0 1], 100) +// [b_out, a_out] = impinvar([1 1], [1 0 1], 100) +// [b_out, a_out] = impinvar([1], [1 0 2 0 1], 100) +// [b_out, a_out] = impinvar([1 1], [1 0 2 0 1], 100) +// [b_out, a_out] = impinvar([1 1 1], [1 0 2 0 1], 100) +// [b_out, a_out] = impinvar([1 1 1 1], [1 0 2 0 1], 100) + +*/ diff --git a/macros/impz.sci b/macros/impz.sci index 1172b81..e4e1ba4 100644 --- a/macros/impz.sci +++ b/macros/impz.sci @@ -1,69 +1,125 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +/* +Calling Sequence + [x, t] = impz (b) ¶ + [x, t] = impz (b, a) ¶ + [x, t] = impz (b, a, n) ¶ + [x, t] = impz (b, a, n, fs) ¶ + impz (…) ¶ +Generate impulse-response characteristics of the filter. +The filter coefficients correspond to the the z-plane rational function with numerator b and denominator a. If a is not specified, it defaults to 1. +If n is not specified, or specified as [], it will be chosen such that the signal has a chance to die down to -120dB, or to not explode beyond 120dB, or to show five periods if there is no significant damping. +If no return arguments are requested, plot the results. +Dependencies + fftfilt +*/ function [x_r, t_r] = impz(b, a, n, fs) -// It gives Impulse response of digital filter -//Calling Sequence -//x_r = impz(b) -//x_r = impz(b, a) -//x_r = impz(b, a, n) -//x_r = impz(b, a, n, fs) -//[x_r, t_r] = impz(b, a, n, fs) + if nargin < 1 || nargin > 4 then + error(" impz : Incorrect number of input arguments ") + end + if nargin < 2 then a = [1]; end + if nargin < 3 then n = [] ; end + if nargin < 4 then fs = 1 ; end + + if (~isvector(b) && ~isscalar(b)) || (~isvector(a) && ~isscalar(a) ) then + error("impz: B and A must be vectors"); + end + if isempty(n) && length(a) > 1 then + precision = 1e-6; + r = roots(a); + maxpole = max(abs(r)); + if (maxpole > 1+precision) // unstable -- cutoff at 120 dB + n = floor(6/log10(maxpole)); + elseif (maxpole < 1-precision) // stable -- cutoff at -120 dB + n = floor(-6/log10(maxpole)); + else // periodic -- cutoff after 5 cycles + n = 30; -//Parameters -//x_r: impz chooses the number of samples and returns the response in the column vector, x_r. -//t_r : impz returns the sample times in the column vector, t_r -// b : numerator coefficients of the filter -// a : denominator coefficients of the filter -// n : samples of the impulse response t(by default ,n = length(t) and is computed automatically. -// fs : sampling frequency + // find longest period less than infinity + // cutoff after 5 cycles (w=10*pi) + rperiodic = r(find(abs(r)>=1-precision & abs(arg(r))>0)); + if ~isempty(rperiodic) + n_periodic = ceil(10*pi./min(abs(arg(rperiodic)))); + if (n_periodic > n) + n = n_periodic; + end + end -//Description -//[x_r,t_r] = impz(b,a) returns the impulse response of the filter with numerator coefficients, b, and denominator coefficients, a. impz chooses the number of samples and returns the response in the column vector, x_r, and the sample times in the column vector, t_r. t_r = [0:n-1]' and n = length(t) is computed automatically. + // find most damped pole + // cutoff at -60 dB + rdamped = r(find(abs(r)<1-precision)); + if ~isempty(rdamped) + n_damped = floor(-3/log10(max(abs(rdamped)))); + if (n_damped > n) + n = n_damped; + end + end + end + n = n + length(b); + elseif isempty(n) + n = length(b); + elseif ( ~isscalar(n)) + // TODO: missing option of having N as a vector of values to + // compute the impulse response. + error ("impz: N must be empty or a scalar"); + end -//Examples -//[x_r,t_r]=impz([0 1 1],[1 -3 3 -1],10) -//OUTPUT : -// t_r = 0. 1. 2. 3. 4. 5. 6. 7. 8. 9 -// x_r= 0. 1. 4. 9. 16. 25. 36. 49.....64......81 + if length(a) == 1 then + x = fftfilt(b/a, [1, zeros(1,n-1)]'); + else + x = filter(b, a, [1, zeros(1,n-1)]'); + end + t = [0:n-1]/fs; -//[x_r,t_r]=impz(1,[1 1],5) -//OUTPUT -// t_r = 0. 1. 2. 3. 4 -//x_r = 1. - 1. 1. - 1. 1. + if nargout >= 1 x_r = x; end + if nargout >= 2 t_r = t; end + //if nargout ~= 2 then //FIXME: fix nargout to detect 0 output arguments . till then plot it always + title("Impulse Response"); + if (fs > 1000) + t = t * 1000; + xlabel("Time (msec)"); + else + xlabel("Time (sec)"); + end + plot(t, x,); + //end -//This function is being called from Octave +endfunction +/* +test case 1 +assert_checkequal(size(impz (1, [1 -1 0.9], 100)), [100 1]) // passed -funcprot(0); -rhs = argn(2) -lhs = argn(1) -if(rhs<1 | rhs>4) -error("Wrong number of input arguments.") -end +test case 2 +// 7th order butterworth filter with fc = 0.5 //passed +B=[0.016565 0.115957 0.347871 0.579785 0.579785 0.347871 0.115957 0.016565]; +A=[1.0000e+00 -5.6205e-16 9.1997e-01 -3.6350e-16 1.9270e-01 -4.3812e-17 7.6835e-03 -4.2652e-19]; +impz(B, A) - select(rhs) - case 1 then - if(lhs==1) - [x_r] = callOctave("impz",b) - elseif(lhs==2) - [x_r,t_r] = callOctave("impz",b) - end - case 2 then - if(lhs==1) - [x_r] = callOctave("impz",b,a) - elseif(lhs==2) - [x_r,t_r] = callOctave("impz",b,a) - end - case 3 then - if(lhs==1) - [x_r] = callOctave("impz",b,a,n) - elseif(lhs==2) - [x_r,t_r] = callOctave("impz",b,a,n) - end - case 4 then - if(lhs==1) - [x_r] = callOctave("impz",b,a,n,fs) - elseif(lhs==2) - [x_r,t_r] = callOctave("impz",b,a,n,fs) - end - end -endfunction +test case 3 +// +[x_r,tr]=impz([0.4 0.2 8 2] ,1,10) +assert_checkalmostequal(x_r,[ 0.4000000 0.2000000 8. 2.0000000 1.943D-16 1.388D-17 0. 0 0. 0.]',%eps,1e-4); +assert_checkalmostequal(tr,0:9,%eps,1e-4); + +//test case 4 +[xr,tr]=impz([0.4 0.2],[4 5 6],3,10) + + +// test case 5 +B = [0.021895 0.109474 0.218948 0.218948 0.109474 0.021895]; +A = [1.0000 -1.2210 1.7567 -1.3348 0.7556 -0.2560]; +impz(B, A) + + */
\ No newline at end of file diff --git a/macros/inv_residue.sci b/macros/inv_residue.sci new file mode 100644 index 0000000..e7354a6 --- /dev/null +++ b/macros/inv_residue.sci @@ -0,0 +1,54 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +// Inverse of residue function +function [b_out, a_out] = inv_residue(r_in, p_in, k_in, tol) + + n = length(r_in); // Number of poles/residues + + k = 0; // Capture constant term + if (length(k_in)==1) // A single direct term (order N = order D) + k = k_in(1); // Capture constant term + elseif (length(k_in)>1) // Greater than one means non-physical system + error("Order numerator > order denominator"); + end + + a_out = octave_poly(p_in); + + b_out = zeros(1,n+1); + b_out = b_out + k*a_out; // Constant term: add k times denominator to numerator + i=1; + while (i<=n) + term = [1 -p_in(i)]; // Term to be factored out + p = r_in(i)*deconv(a_out,term); // Residue times resulting polynomial + p = prepad(p, n+1, 0, 2); // Pad for proper length + b_out = b_out + p; + + m = 1; + mterm = term; + first_pole = p_in(i); + while (i<n && abs(first_pole-p_in(i+1))<tol) // Multiple poles at p(i) + i=i+1; // Next residue + m=m+1; + mterm = conv(mterm, term); // Next multiplicity to be factored out + p = r_in(i) * deconv(a_out, mterm); // Resulting polynomial + p = prepad(p, n+1, 0, 2); // Pad for proper length + b_out = b_out + p; + end + i=i+1; + end + +endfunction +function ocpoly = octave_poly(A) + p = poly(A, 'x'); + c = coeff(p); + ocpoly = c($:-1:1); +endfunction
\ No newline at end of file diff --git a/macros/invfreq.sci b/macros/invfreq.sci index a720115..0fe4c81 100644 --- a/macros/invfreq.sci +++ b/macros/invfreq.sci @@ -1,43 +1,304 @@ -function [B,A] = invfreq(H,F,nB,nA,W,iter,tol, plane) -// Calculates inverse frequency vectors -// -// Calling Sequence -//[B,A] = invfreq(H,F,nB,nA) -//[B,A] = invfreq(H,F,nB,nA,W) -//[B,A] = invfreq(H,F,nB,nA,W,[],[],plane) -//[B,A] = invfreq(H,F,nB,nA,W,iter,tol,plane) -// -// Parameters -// H: desired complex frequency response,It is assumed that A and B are real polynomials, hence H is one-sided. -// F: vector of frequency samples in radians -// nA: order of denominator polynomial A -// nB: order of numerator polynomial B -// -// Description -//Fit filter B(z)/A(z) or B(s)/A(s) to complex frequency response at frequency points F. A and B are real polynomial coefficients of order nA and nB respectively. Optionally, the fit-errors can be weighted vs frequency according to the weights W. Also, the transform plane can be specified as either 's' for continuous time or 'z' for discrete time. 'z' is chosen by default. Eventually, Steiglitz-McBride iterations will be specified by iter and tol. -// -// Examples -// [B,A] = butter(12,1/4); -// [H,w] = freqz(B,A,128); -// [Bh,Ah] = invfreq(H,F,4,4); -// Hh = freqz(Bh,Ah); -// disp(sprintf('||frequency response error|| = %f',norm(H-Hh))); -// -funcprot(0); -lhs= argn(1); -rhs= argn(2); -if(rhs < 4 | rhs > 8 | rhs == 6 | rhs == 7 ) -error("Wrong number of input arguments"); -end +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +/* + : [B,A] = invfreq(H,F,nB,nA,W) + : [B,A] = invfreq(H,F,nB,nA,W,[],[],plane) + : [B,A] = invfreq(H,F,nB,nA,W,iter,tol,plane) + + Fit filter B(z)/A(z) or B(s)/A(s) to complex frequency response at frequency points F. + + A and B are real polynomial coefficients of order nA and nB respectively. Optionally, the fit-errors can be weighted vs frequency according to the weights W. Also, the transform plane can be specified as either ’s’ for continuous time or ’z’ for discrete time. ’z’ is chosen by default. Eventually, Steiglitz-McBride iterations will be specified by iter and tol. + + H: desired complex frequency response It is assumed that A and B are real polynomials, hence H is one-sided. + + F: vector of frequency samples in radians + + nA: order of denominator polynomial A + + nB: order of numerator polynomial B + + plane=’z’: F on unit circle (discrete-time spectra, z-plane design) + + plane=’s’: F on jw axis (continuous-time spectra, s-plane design) + + H(k) = spectral samples of filter frequency response at points zk, where zk=exp(sqrt(-1)*F(k)) when plane=’z’ (F(k) in [0,.5]) and zk=(sqrt(-1)*F(k)) when plane=’s’ (F(k) nonnegative) +*/ +// FIXME: implement Steiglitz-McBride iterations +// FIXME: improve numerical stability for high order filters (matlab is a bit better) +// FIXME: modify to accept more argument configurations +function [B, A, SigN] = invfreq(H, F, nB, nA, W, iter, tol, tr, plane,varargin) + + if nargin < 4 then + error("invfreq : Incorrect number of input arguments ") + end -select(rhs) - case 4 then - [B,A]= callOctave("invfreq", H,F,nB,nA); - case 5 then - [B,A]= callOctave("invfreq", H,F,nB,nA, W); - case 8 then - [B,A]= callOctave("invfreq", H,F,nB, nA,iter, tol, plane); + if ~isvector(H) && ~isscalar(H) then + error("invfreq : H is the desired frequency response , a vector expected") + end + + if ~isvector(F) && ~isscalar(F) then + error("invfreq : F is a vector of frequency samples in radians") + end + + if max(size(nB)) > 1 then zB = nB(2); nB = nB(1); else zB = 0; end + n = max(nA, nB); + m = n+1; mA = nA+1; mB = nB+1; + nF = max(size(F)); + if nargin < 5 || isempty(W) then W = ones(1, nF); end + if nargin < 6 then iter = []; end + if nargin < 7 then tol = []; end + if nargin < 8 || isempty(tr) then tr = ''; end + if nargin < 9 then plane = 'z'; end + if nargin < 10 then varargin = {}; end + if ( strcmp (plane, "s") && strcmp (plane, "z")) + error (sprintf("invfreq: invealid PLANE argument %s, expected s or z ", plane)) + end + + fname = ["invfreq", plane]; + + if (nF ~= max(size(H))) then + error ("%s: Length of H and F must be the same\n", fname) + end + + if (~ isempty (iter) || ~ isempty (tol)) then + warning (sprintf("%s: iterative algorithm not yet implemented, ", ... + "ITER and TOL arguments are ignored\n", fname)); + end + +////////////////////////////////////////////////////////////// +norm = %f ; // should we normalize freqs to avoid matrices with rank deficiency ? +method = 'LS'; // by default, use Ordinary Least Square to solve normal equations +prop = varargin; +if length(prop) > 0 then + indi = 1; + while indi < length(prop) + switch prop(indi) + case 'norm' + if indi < length(prop) && ~(type(prop(indi+1)) == 10) + norm = prop(indi+1); + indi = indi + 2; // Skip the processed element + else + norm = %t; // Default true + indi = indi + 1; + end + + case 'method' + if indi < length(prop) && type(prop(indi+1)) == 10 && strcmp(prop(indi+1), "norm") + method = prop(indi+1); + indi = indi + 2; // Skip the processed element + else + error("invfreq : incorrect/missing method argument"); + indi = indi + 1; + end + + otherwise + disp("Ignoring unknown or incomplete argument"); + indi = indi + 1; + end + end end + + +//////////////////////////////////////////////////////////////// + + + Ruu = zeros(mB, mB); Ryy = zeros(nA, nA); Ryu = zeros(nA, mB); + Pu = zeros(mB, 1); Py = zeros(nA,1); + if ~strcmp(tr,'trace') + disp(' ') + disp('Computing nonuniformly sampled, equation-error, rational filter.'); + disp(['plane = ',plane]); + disp(' ') + end + + s = sqrt(-1)*F; + switch plane + case 'z' + if max(F) > %pi || min(F) < 0 then + disp('hey, you frequency is outside the range 0 to %pi, making my own') + F = linspace(0, %pi, max(size(H))); + s = sqrt(-1)*F; + end + s = exp(-s); + case 's' + if max(F) > 1e6 && n > 5 then + if ~norm then + disp('Be careful, there are risks of generating singular matrices'); + disp('Call invfreqs as (..., norm, 1) to avoid it'); + else + Fmax = max(F); s = sqrt(-1)*F/Fmax; + end + end + end + + ////////////////////////////// + ///////////////////////////// + for k=1:nF, + Zk = (s(k).^[0:n]).'; + Hk = H(k); + aHks = Hk*conj(Hk); + Rk = (W(k)*Zk)*Zk'; + rRk = real(Rk); + Ruu = clean(Ruu + rRk(1:mB, 1:mB)); + Ryy = Ryy + aHks*rRk(2:mA, 2:mA); + Ryu = Ryu + real(Hk*Rk(2:mA, 1:mB)); + Pu = Pu + W(k)*real(conj(Hk)*Zk(1:mB)); + Py = Py + (W(k)*aHks)*real(Zk(2:mA)); + end + Rr = ones(max(size(s)), mB+nA); Zk = s; + for k = 1:min(nA, nB), + Rr(:, 1+k) = Zk; + Rr(:, mB+k) = -Zk.*H; + Zk = Zk.*s; + end + for k = 1+min(nA, nB):max(nA, nB)-1, + if k <= nB, Rr(:, 1+k) = Zk; end + if k <= nA, Rr(:, mB+k) = -Zk.*H; end + Zk = Zk.*s; + end + k = k+1; + if k <= nB then Rr(:, 1+k) = Zk; end + if k <= nA then Rr(:, mB+k) = -Zk.*H; end + + // complex to real equation system -- this ensures real solution + Rr = Rr(:, 1+zB:$); + Rr = [real(Rr); imag(Rr)]; Pr = [real(H(:)); imag(H(:))]; + // normal equations -- keep for ref + // Rn= [Ruu(1+zB:mB, 1+zB:mB), -Ryu(:, 1+zB:mB)'; -Ryu(:, 1+zB:mB), Ryy]; + // Pn= [Pu(1+zB:mB); -Py]; + //////////////////////////////////////////////// + switch method + case {'ls' 'LS'} + // avoid scaling errors with Theta = R\P; + // [Q, R] = qr([Rn Pn]); Theta = R(1:$, 1:$-1)\R(1:$, $); + [Q, R] = qr([Rr Pr]); Theta = pinv(R(1:$-1, 1:$-1)) * R(1:$-1, $); + ////////////////////////////////////////////////// + // SigN = R($, $-1); + SigN = R($, $); + case {'tls' 'TLS'} + // [U, S, V] = svd([Rn Pn]); + // SigN = S($, $-1); + // Theta = -V(1:$-1, $)/V($, $); + [U, S, V] = svd([Rr Pr], 0); + SigN = S($, $); + Theta = -V(1:$-1, $)/V($, $); + case {'mls' 'MLS' 'qr' 'QR'} + // [Q, R] = qr([Rn Pn], 0); + // solve the noised part -- DO NOT USE ECONOMY SIZE ~ + // [U, S, V] = svd(R(nA+1:$, nA+1:$)); + // SigN = S($, $-1); + // Theta = -V(1:$-1, $)/V($, $); + // unnoised part -- remove B contribution and back-substitute + // Theta = [R(1:nA, 1:nA)\(R(1:nA, $) - R(1:nA, nA+1:$-1)*Theta) + // Theta]; + // solve the noised part -- economy size OK as #rows > #columns + [Q, R] = qr([Rr Pr], 0); + eB = mB-zB; sA = eB+1; + [U, S, V] = svd(R(sA:$, sA:$)); + // noised (A) coefficients + Theta = -V(1:$-1, $)/V($, $); + // unnoised (B) part -- remove A contribution and back-substitute + Theta = [R(1:eB, 1:eB)\(R(1:eB, $) - R(1:eB, sA:$-1)*Theta) + Theta]; + SigN = S($, $); + otherwise + error(sprintf("invfreq : unknown method %s", method)); + end + + B = [zeros(zB, 1); Theta(1:mB-zB)].'; + A = [1; Theta(mB-zB+(1:nA))].'; + if ~strcmp(plane,'s') + B = B(mB:-1:1); + A = A(mA:-1:1); + if norm, // Frequencies were normalized -- unscale coefficients + Zk = Fmax.^[n:-1:0].'; + for k = nB:-1:1+zB, B(k) = B(k)/Zk(k); end + for k = nA:-1:1, A(k) = A(k)/Zk(k); end + end + end endfunction - +/* +// method - LS +test case 1 // passed + +[B,A,Sign] = invfreq(1,1,1,1,1,[],[],'','z','norm',1,'method','LS') +assert_checkequal(B,[0.6314 0.3411]) +assert_checkequal(A,[1 -0.3411]) +assert_checkequal(Sign,0) + +[B,A,Sign] = invfreq(1,1,1,1,1,[],[],'','s') +assert_checkequal(B,[0 1]) +assert_checkequal(A,[0 1]) +assert_checkequal(Sign,0) + + +test case 2 // passed +order = 6 +fc = 1/2 +n = 128 +B = [ 0.029588 0.177529 0.443823 0.591764 0.443823 0.177529 0.029588] ; +A = [ 1.0000e+00 -6.6613e-16 7.7770e-01 -2.8192e-16 1.1420e-01 -1.4472e-17 1.7509e-03]; +[H,w] = freqz(B,A,n) ; +[Bh , Ah] = invfreq(H,w,order,order); +[Hh,wh] = freqz(Bh,Ah,n); +plot(w,[abs(H), abs(Hh)]) +xlabel("Frequency (rad/sample)"); +ylabel("Magnitude"); +legend('Original','Measured'); +err = norm(H-Hh); +disp(sprintf('L2 norm of frequency response error = %f',err)); + +test case 3 // passed +// buttter worth filter of order 12 and fc=1/4 +B = [ 1.1318e-06 1.3582e-05 7.4702e-05 2.4901e-04 5.6026e-04 8.9642e-04 1.0458e-03 8.9642e-04 5.6026e-04 2.4901e-04 7.4702e-05 1.3582e-05 1.1318e-06]; +A = [ 1.0000e+00 -5.9891e+00 1.7337e+01 -3.1687e+01 4.0439e+01 -3.7776e+01 2.6390e+01 -1.3851e+01 5.4089e+00 -1.5296e+00 2.9688e-01 -3.5459e-02 1.9688e-03]; +[H,w] = freqz(B,A,128); +[Bh,Ah] = invfreq(H,w,4,4); +[Hh,wh] = freqz(Bh,Ah,128); +disp(sprintf('||frequency response error||= %f',norm(H-Hh))); + + +method TLS + +test case 1 // passed + +B = [ 1.1318e-06 1.3582e-05 7.4702e-05 2.4901e-04 5.6026e-04 8.9642e-04 1.0458e-03 8.9642e-04 5.6026e-04 2.4901e-04 7.4702e-05 1.3582e-05 1.1318e-06]; +A = [ 1.0000e+00 -5.9891e+00 1.7337e+01 -3.1687e+01 4.0439e+01 -3.7776e+01 2.6390e+01 -1.3851e+01 5.4089e+00 -1.5296e+00 2.9688e-01 -3.5459e-02 1.9688e-03]; +[H,w] = freqz(B,A,128); +[Bh,Ah] = invfreq(H,w,4,4,[],[],[],'','z','norm',1,'method','TLS'); +[Hh,wh] = freqz(Bh,Ah,128); +disp(sprintf('||frequency response error||= %f',norm(H-Hh))); + + + + +method MLS - passed + + +// elliptic filter with ellip (5, 1, 90, [.1 .2]) +n = 128 +B = [ 1.3214e-04 -6.6404e-04 1.4928e-03 -1.9628e-03 1.4428e-03 0 -1.4428e-03 1.9628e-03 -1.4928e-03 6.6404e-04 -1.3214e-04] ; +A = [ 1.0000 -8.6483 34.6032 -84.2155 137.9276 -158.7598 130.0425 -74.8636 29.0044 -6.8359 0.7456]; +[H,w] = freqz(B,A,n) ; + +[Bh,Ah] = invfreq(H,w,4,4,[],[],[],'','z','norm',1,'method','MLS'); +[Hh,wh] = freqz(Bh,Ah,n); +plot(w,[abs(H), abs(Hh)]) +xlabel("Frequency (rad/sample)"); +ylabel("Magnitude"); +legend('Original','Measured'); +err = norm(H-Hh); +disp(sprintf('L2 norm of frequency response error = %f',err)); + + +*/ diff --git a/macros/invfreqs.sci b/macros/invfreqs.sci index 32e732b..99c721b 100644 --- a/macros/invfreqs.sci +++ b/macros/invfreqs.sci @@ -1,96 +1,110 @@ -function [B,A,C] = invfreqs(H,F,nB,nA,W,iter,tol,trace) -//Fit filter B(s)/A(s)to the complex frequency response H at frequency points F. A and B are real polynomial coefficients of order nA and nB. -//Calling Sequence -//[B,A,C] = invfreqs(H,F,nB,nA,W,iter,tol,trace) -//[B,A,C] = invfreqs(H,F,nB,nA,W) -//[B,A,C] = invfreqs(H,F,nB,nA) -//Parameters -//H: desired complex frequency response. -//F: frequency (must be same length as H). -//nB: order of the numerator polynomial B. -//nA: order of the denominator polynomial A. -//W: vector of weights (must be same length as F). -//Description -//This is an Octave function. -//Fit filter B(s)/A(s)to the complex frequency response H at frequency points F. A and B are real polynomial coefficients of order nA and nB. -//Optionally, the fit-errors can be weighted vs frequency according to the weights W. -//Note: all the guts are in invfreq.m -//Examples -//B = [1/2 1]; -//A = [1 1]; -//w = linspace(0,4,128); -//H = freqs(B,A,w); -//[Bh,Ah, C] = invfreqs(H,w,1,1); -//Bh = -// -// 0.50000 1.00000 -// -//Ah = -// -// 1.0000 1.0000 -// -//C = -3.0964e-15 - -funcprot(0); -lhs = argn(1) -rhs = argn(2) -if (rhs < 4 | rhs > 8) -error("Wrong number of input arguments.") -end - -select(rhs) - - case 4 then - if(lhs==1) - B = callOctave("invfreqs",H,F,nB,nA) - elseif(lhs==2) - [B, A] = callOctave("invfreqs",H,F,nB,nA) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqs",H,F,nB,nA) - else - error("Wrong number of output argments.") - end - - case 5 then - if(lhs==1) - B = callOctave("invfreqs",H,F,nB,nA,W) - elseif(lhs==2) - [B, A] = callOctave("invfreqs",H,F,nB,nA,W) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqs",H,F,nB,nA,W) - else - error("Wrong number of output argments.") - end - case 6 then - if(lhs==1) - B = callOctave("invfreqs",H,F,nB,nA,W,iter) - elseif(lhs==2) - [B, A] = callOctave("invfreqs",H,F,nB,nA,W,iter) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqs",H,F,nB,nA,W,iter) - else - error("Wrong number of output argments.") - end - case 7 then - if(lhs==1) - B = callOctave("invfreqs",H,F,nB,nA,W,iter,tol) - elseif(lhs==2) - [B, A] = callOctave("invfreqs",H,F,nB,nA,W,iter,tol) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqs",H,F,nB,nA,W,iter,tol) - else - error("Wrong number of output argments.") - end - case 8 then - if(lhs==1) - B = callOctave("invfreqs",H,F,nB,nA,W,iter,tol,trace) - elseif(lhs==2) - [B, A] = callOctave("invfreqs",H,F,nB,nA,W,iter,tol,trace) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqs",H,F,nB,nA,W,iter,tol,trace) - else - error("Wrong number of output argments.") - end - end +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +// FIXME: check invfreq.sci for todo's + +/* + :[B,A] = invfreqs(H,F,nB,nA) + :[B,A] = invfreqs(H,F,nB,nA,W) + :[B,A] = invfreqs(H,F,nB,nA,W,iter,tol,'trace') + + Fit filter B(s)/A(s)to the complex frequency response H at frequency points F. + + A and B are real polynomial coefficients of order nA and nB. + + Optionally, the fit-errors can be weighted vs frequency according to the weights W. + + Note: all the guts are in invfreq.m + + H: desired complex frequency response + + F: frequency (must be same length as H) + + nA: order of the denominator polynomial A + + nB: order of the numerator polynomial B + + W: vector of weights (must be same length as F) + +*/ +// Dependencies +// invfreq +function [B, A, SigN] = invfreqs(H,F,nB,nA,W,iter,tol,tr, varargin) + + if nargin < 9 + varargin = {}; + if nargin < 8 + tr = ''; + if nargin < 7 + tol = []; + if nargin < 6 + iter = []; + if nargin < 5 + W = ones(1,length(F)); + end + end + end + end + end + + // now for the real work + [B, A, SigN] = invfreq(H, F,nB, nA, W, iter, tol, tr, 's', varargin); + endfunction +/* +demo + B = [1 0 0]; + A = [1 6 15 15]/15; + w = linspace(0, 8, 128); + [H0 ,_ ] = freqz(B, A, w); + Nn = (rand(size(w,1),size(w,2),'normal')+%i*rand(size(w,1),size(w,2),'normal'))/sqrt(2); + order = length(A) - 1; + [Bh, Ah, Sig0] = invfreqs(H0, w, [length(B)-1 2], length(A)-1); + [Hh ,_ ] = freqz(Bh,Ah,w); + [BLS, ALS, SigLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "LS"); + [HLS,_] = freqz(BLS, ALS, w); + [BTLS, ATLS, SigTLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "TLS"); + [HTLS,_] = freqz(BTLS, ATLS, w); + [BMLS, AMLS, SigMLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "QR"); + [HMLS,_] = freqz(BMLS, AMLS, w); + plot(w,[abs(H0); abs(Hh)]) + xlabel("Frequency (rad/sec)"); + ylabel("Magnitude"); + legend('Original','Measured'); + err = norm(H0-Hh); + disp(sprintf('L2 norm of frequency response error = %f',err)); +*/ +/* Octave version + B = [1 0 0]; + A = [1 6 15 15]/15; + w = linspace(0, 8, 128); + [H0 ,_ ] = freqz(B, A, w); + Nn = (randn(size(w,1),size(w,2))+i*randn(size(w,1),size(w,2)))/sqrt(2); + order = length(A) - 1; + [Bh, Ah, Sig0] = invfreqs(H0, w, [length(B)-1 2], length(A)-1); + [Hh ,_ ] = freqz(Bh,Ah,w); + [BLS, ALS, SigLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "LS"); + [HLS,_] = freqz(BLS, ALS, w); + [BTLS, ATLS, SigTLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "TLS"); + [HTLS,_] = freqz(BTLS, ATLS, w); + [BMLS, AMLS, SigMLS] = invfreqs(H0+1e-5*Nn, w, [2 2], order, [], [], [], [], "method", "QR"); + [HMLS,_] = freqz(BMLS, AMLS, w); + plot(w,[abs(H0); abs(Hh)]) + xlabel("Frequency (rad/sec)"); + ylabel("Magnitude"); + legend('Original','Measured'); + err = norm(H0-Hh); + disp(sprintf('L2 norm of frequency response error = %f',err)); +*/ + + + diff --git a/macros/invfreqz.sci b/macros/invfreqz.sci index d051499..433100b 100644 --- a/macros/invfreqz.sci +++ b/macros/invfreqz.sci @@ -1,94 +1,107 @@ -function [B,A,C] = invfreqz(H,F,nB,nA,W,iter,tol,trace) -//Fit filter B(z)/A(z)to the complex frequency response H at frequency points F. A and B are real polynomial coefficients of order nA and nB. -//Calling Sequence -//[B,A,C] = invfreqz(H,F,nB,nA,W,iter,tol,trace) -//[B,A,C] = invfreqz(H,F,nB,nA,W) -//[B,A,C] = invfreqz(H,F,nB,nA) -//Parameters -//H: desired complex frequency response. -//F: frequency (must be same length as H). -//nB: order of the numerator polynomial B. -//nA: order of the denominator polynomial A. -//W: vector of weights (must be same length as F). -//Description -//This is an Octave function. -//Fit filter B(z)/A(z)to the complex frequency response H at frequency points F. A and B are real polynomial coefficients of order nA and nB. -//Optionally, the fit-errors can be weighted vs frequency according to the weights W. -//Note: all the guts are in invfreq.m -//Examples -//[B,A] = butter(4,1/4); -//[H,F] = freqz(B,A); -//[Bh,Ah,C] = invfreq(H,F,4,4) -//Bh = -// -// 0.010209 0.040838 0.061257 0.040838 0.010209 -// -//Ah = -// -// 1.00000 -1.96843 1.73586 -0.72447 0.12039 -// -//C = -7.7065e-15 +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +// FIXME: check invfreq.sci for todo's +/* + : [B,A] = invfreqz(H,F,nB,nA) ¶ + : [B,A] = invfreqz(H,F,nB,nA,W) ¶ + : [B,A] = invfreqz(H,F,nB,nA,W,iter,tol,'trace') ¶ -funcprot(0); -lhs = argn(1) -rhs = argn(2) -if (rhs < 4 | rhs > 8) -error("Wrong number of input arguments.") -end + Fit filter B(z)/A(z)to the complex frequency response H at frequency points F. -select(rhs) - - case 4 then - if(lhs==1) - B = callOctave("invfreqz",H,F,nB,nA) - elseif(lhs==2) - [B, A] = callOctave("invfreqz",H,F,nB,nA) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqz",H,F,nB,nA) - else - error("Wrong number of output argments.") - end + A and B are real polynomial coefficients of order nA and nB. Optionally, the fit-errors can be weighted vs frequency according to the weights W. - case 5 then - if(lhs==1) - B = callOctave("invfreqz",H,F,nB,nA,W) - elseif(lhs==2) - [B, A] = callOctave("invfreqz",H,F,nB,nA,W) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqz",H,F,nB,nA,W) - else - error("Wrong number of output argments.") - end - case 6 then - if(lhs==1) - B = callOctave("invfreqz",H,F,nB,nA,W,iter) - elseif(lhs==2) - [B, A] = callOctave("invfreqz",H,F,nB,nA,W,iter) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqz",H,F,nB,nA,W,iter) - else - error("Wrong number of output argments.") - end - case 7 then - if(lhs==1) - B = callOctave("invfreqz",H,F,nB,nA,W,iter,tol) - elseif(lhs==2) - [B, A] = callOctave("invfreqz",H,F,nB,nA,W,iter,tol) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqz",H,F,nB,nA,W,iter,tol) - else - error("Wrong number of output argments.") - end - case 8 then - if(lhs==1) - B = callOctave("invfreqz",H,F,nB,nA,W,iter,tol,trace) - elseif(lhs==2) - [B, A] = callOctave("invfreqz",H,F,nB,nA,W,iter,tol,trace) - elseif(lhs==3) - [B, A, C] = callOctave("invfreqz",H,F,nB,nA,W,iter,tol,trace) - else - error("Wrong number of output argments.") - end - end -endfunction + Note: all the guts are in invfreq.m + + H: desired complex frequency response + + F: normalized frequency (0 to pi) (must be same length as H) + + nA: order of the denominator polynomial A + + nB: order of the numerator polynomial B + W: vector of weights (must be same length as F) + +*/ +// Dependencies +// invfreq +function [B, A, SigN] = invfreqz(H, F, nB, nA, W, iter, tol, tr, varargin) + + if nargin < 9 + varargin = {}; + if nargin < 8 + tr = ''; + if nargin < 7 + tol = []; + if nargin < 6 + iter = []; + if nargin < 5 + W = ones(1,length(F)); + end + end + end + end + end + // now for the real work + [B, A, SigN] = invfreq(H, F, nB, nA, W, iter, tol, tr, 'z', varargin); + +endfunction +/* +demo +order = 9; //order of test filter +//going to 10 or above leads to numerical instabilities and large errors +fc = 1/2; // sampling rate / 4 +n = 128; // frequency grid size +// butterworth filter of order 9 and fc=0.5 +B0 = [5.1819e-03 4.6637e-02 1.8655e-01 4.3528e-01 6.5292e-01 6.5292e-01 4.3528e-01 1.8655e-01 4.6637e-02 5.1819e-03]; +A0 = [ 1.0000e+00 -8.6736e-16 1.2010e+00 -7.7041e-16 4.0850e-01 -1.7013e-16 4.2661e-02 -9.0155e-18 9.6666e-04 -5.3661e-20]; +[H0, w] = freqz(B0, A0, n); +Nn = (rand(size(w,1),size(w,2),'normal')+%i*rand(size(w,1),size(w,2),'normal'))/sqrt(2); +[Bh, Ah, Sig0] = invfreqz(H0, w, order, order); +[Hh, wh] = freqz(Bh, Ah, n); +[BLS, ALS, SigLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "LS"); +[HLS _ ] = freqz(BLS, ALS, n); +[BTLS, ATLS, SigTLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "TLS"); +[HTLS _ ]= freqz(BTLS, ATLS, n); +[BMLS, AMLS, SigMLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "QR"); +[HMLS _ ] = freqz(BMLS, AMLS, n); +plot(w,[abs(H0) abs(Hh)]) +xlabel("Frequency (rad/sample)"); +ylabel("Magnitude"); +legend('Original','Measured'); +err = norm(H0-Hh); +disp(sprintf('L2 norm of frequency response error = %f',err)); + +*/ +/* +order = 9; +fc = 1/2; +n = 128; +B0 = [5.1819e-03 4.6637e-02 1.8655e-01 4.3528e-01 6.5292e-01 6.5292e-01 4.3528e-01 1.8655e-01 4.6637e-02 5.1819e-03]; +A0 = [ 1.0000e+00 -8.6736e-16 1.2010e+00 -7.7041e-16 4.0850e-01 -1.7013e-16 4.2661e-02 -9.0155e-18 9.6666e-04 -5.3661e-20]; +[H0, w] = freqz(B0, A0, n); +Nn = (randn(size(w,1),size(w,2))+i*randn(size(w,1),size(w,2)))/sqrt(2); +[Bh, Ah, Sig0] = invfreqz(H0, w, order, order); +[Hh, wh] = freqz(Bh, Ah, n); +[BLS, ALS, SigLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "LS"); +[HLS _ ] = freqz(BLS, ALS, n); +[BTLS, ATLS, SigTLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "TLS"); +[HTLS _ ]= freqz(BTLS, ATLS, n); +[BMLS, AMLS, SigMLS] = invfreqz(H0+1e-5*Nn, w, order, order, [], [], [], [], "method", "QR"); +[HMLS _ ] = freqz(BMLS, AMLS, n); +plot(w,[abs(H0) abs(Hh)]) +xlabel("Frequency (rad/sample)"); +ylabel("Magnitude"); +legend('Original','Measured'); +err = norm(H0-Hh); +disp(sprintf('L2 norm of frequency response error = %f',err)); +*/ diff --git a/macros/invimpinvar.sci b/macros/invimpinvar.sci index 4e8bd7b..c854324 100644 --- a/macros/invimpinvar.sci +++ b/macros/invimpinvar.sci @@ -1,42 +1,129 @@ -function [b_out, a_out] = invimpinvar (b, a, fs, tol) -//This function converts digital filter with coefficients b and a to analog, conserving impulse response. -//Calling Sequence -//[b, a] = impinvar (b, a) -//[b, a] = impinvar (b, a, fs) -//[b, a] = impinvar (b, a, fs, tol) -//Parameters -//b: real or complex valued scalar or vector -//a: real or complex valued scalar or vector, order should be greater than b -//fs: real or complex value, default value 1Hz -//tol: real or complex value, default value 0.0001 -//Description -//This is an Octave function. -//This function converts digital filter with coefficients b and a to analog, conserving impulse response. -//This function does the inverse of impinvar. -//Examples -//b = 0.0081000 -//a = [2.0000000, 0.56435378, 0.4572792, 0.00705544, 0.091000] -//[ay, by] = invimpinvar(b,a,10) -//ay = -// -1.6940e-16 4.6223e+00 -4.5210e+00 7.2880e+02 -//by = -// Columns 1 through 4: -// 1.0000e+00 3.0900e+01 9.6532e+02 1.2232e+04 -// Column 5: -// 1.1038e+05 -funcprot(0); -rhs = argn(2) -if(rhs<2) -error("Wrong number of input arguments.") -end - - - select(rhs) - case 2 then - [b_out,a_out] = callOctave("invimpinvar",b,a) - case 3 then - [b_out,a_out] = callOctave("invimpinvar",b,a,fs) - case 4 then - [b_out,a_out] = callOctave("invimpinvar",b,a,fs,tol) - end +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in + +// Impulse invariant conversion from s to z domain +/* + [b_out, a_out] = invimpinvar (b, a, fs, tol) + [b_out, a_out] = invimpinvar (b, a, fs) + [b_out, a_out] = invimpinvar (b, a) + + Converts digital filter with coefficients b and a to analog, conserving impulse response. + + This function does the inverse of impinvar so that the following example should restore the original values of a and b. + + [b, a] = impinvar (b, a); + [b, a] = invimpinvar (b, a); + + If fs is not specified, or is an empty vector, it defaults to 1Hz. + + If tol is not specified, it defaults to 0.0001 (0.1%) + Dependencies + residue + inv_residue + */ +function [b_out, a_out] = invimpinvar (b_in, a_in, fs, tol) + + error("invimpinvar: Missing functionality not implemented in this release .Will be Available soon "); endfunction +// FIXME : fix filter function first . till then drop this fun +/* + if (nargin <2) + error("invimpinvar: Insufficient input arguments"); + end + + if nargin < 3 then fs = 1; end + if nargin < 4 then tol = 0.0001; end + // to be compatible with the matlab implementation where an empty vector can + // be used to get the default + if (isempty(fs)) + ts = 1; + else + ts = 1/fs; // we should be using sampling frequencies to be compatible with Matlab + end + + b_in = [b_in 0]; // so we can calculate in z instead of z^-1 + + [r_in, p_in, k_in] = residue(b_in, a_in); // partial fraction expansion + + // clean r_in for zero values + n = length(r_in); // Number of poles/residues + + if (length(k_in) > 1) // Greater than one means we cannot do impulse invariance + error("Order numerator > order denominator"); + end + + r_out = zeros(1,n); // Residues of H(s) + sm_out = zeros(1,n); // Poles of H(s) + + i=1; + while (i<=n) + m=1; + first_pole = p_in(i); // Pole in the z-domain + while (i<n && abs(first_pole-p_in(i+1))<tol) // Multiple poles at p(i) + i=i+1; // Next residue + m=m+1; // Next multiplicity + end + [r, sm, k]= inv_z_res(r_in(i-m+1:i), first_pole, ts); // Find s-domain residues + k_in = k_in - k; // Just to check, should end up zero for physical system + sm_out(i-m+1:i) = sm; // Copy s-domain pole(s) to output + r_out(i-m+1:i) = r; // Copy s-domain residue(s) to output + + i=i+1; // Next z-domain residue/pole + end + [b_out, a_out] = inv_residue(r_out, sm_out , 0, tol); + a_out = to_real(a_out); // Get rid of spurious imaginary part + b_out = to_real(b_out); + + b_out = polyreduce(b_out); + +endfunction +*/ +// Inverse function of z_res (see impinvar source) + +function [r_out, sm_out, k_out] = inv_z_res (r_in,p_in,ts) + + n = length(r_in); // multiplicity of the pole + r_in = r_in.'; // From column vector to row vector + + j=n; + while (j>1) // Go through residues starting from highest order down + r_out(j) = r_in(j) / ((ts * p_in)^j); // Back to binomial coefficient for highest order (always 1) + r_in(1:j) = r_in(1:j) - r_out(j) * polyrev(h1_z_deriv(j-1,p_in,ts)); // Subtract highest order result, leaving r_in(j) zero + j=j-1; + end + + // Single pole (no multiplicity) + r_out(1) = r_in(1) / ((ts * p_in)); + k_out = r_in(1) / p_in; + sm_out = log(p_in) / ts; +endfunction + +/* +// tests passed +[b_out,a_out]=invimpinvar([1],[1 -0.5],0.01) +[b_out,a_out]=invimpinvar([1],[1 -1 0.25],0.01) +[b_out,a_out]=invimpinvar([1 1],[1 -1 0.25],0.01) +[b_out,a_out]=invimpinvar([1],[1 -1.5 0.75 -0.125],0.01) +[b_out,a_out]=invimpinvar([1 1],[1 -1.5 0.75 -0.125],0.01) + + + +// FIXME : built in filter doesn't support complex parameters +// Because of this thsese test cases are failing +//[b_out,a_out]=invimpinvar([1],[1 0 0.25],0.01) +// [b_out,a_out]=invimpinvar([1 1],[1 0 0.25],0.01) +// [b_out,a_out]=invimpinvar([1],[1 0 0.5 0 0.0625],0.01) +// [b_out,a_out]=invimpinvar([1 1],[1 0 0.5 0 0.0625],0.01) +// [b_out,a_out]=invimpinvar([1 1 1],[1 0 0.5 0 0.0625],0.01 +// [b_out,a_out]=invimpinvar([1 1 1 1],[1 0 0.5 0 0.0625],0.01) + +*/ diff --git a/macros/marcumq.sci b/macros/marcumq.sci index 630ec97..29f4416 100644 --- a/macros/marcumq.sci +++ b/macros/marcumq.sci @@ -1,38 +1,389 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +/* +Calling Sequence + q = marcumq (a, b) + q = marcumq (a, b, m) + q = marcumq (a, b, m, tol) + +Input and Output parameters +a — Noncentrality parameter --- nonnegative scalar | array of nonnegative numbers +b — Argument of Marcum Q-function --- nonnegative scalar | array of nonnegative numbers +m — Order of generalized Marcum Q-function --- positive integer | array of positive integers + +Compute the generalized Marcum Q function of order `m` with noncentrality parameter `a` and argument `b`. +If the order `m` is omitted, it defaults to 1. An optional relative tolerance `tol` may be included, +and the default value is `eps`. + +If the input arguments are commensurate vectors, this function will produce a table of values. + +This function computes Marcum’s Q function using the infinite Bessel series, +which is truncated when the relative error is less than the specified tolerance. +The accuracy is limited by that of the Bessel functions, so reducing the tolerance is probably not useful. + +References: +- Marcum, "Tables of Q Functions", Rand Corporation. +- R.T. Short, "Computation of Noncentral Chi-squared and Rice Random Variables", + www.phaselockedsystems.com/publications +*/ + function q = marcumq (a, b, m, tol) -//This function computes the generalized Marcum Q function of order m with noncentrality parameter a and argument b. -//Calling Sequence -//q = marcumq (a, b) -//q = marcumq (a, b, m) -//q = marcumq (a, b, m, tol) -//Parameters -//a: -//b: -//m: default value 1 -//tol: default value eps -//Description -//This is an Octave function. -//This function computes the generalized Marcum Q function of order m with noncentrality parameter a and argument b. -//The third argument m is the order, which by default is 1. -//The fourth argument tol is the tolerance, which by default is eps. -//If input arguments are vectors which correspond in size and degree, the output is a table of values. -//This function calculates Marcum’s Q function using the infinite Bessel series, which is truncated when the relative error is less than the specified tolerance. -//Examples -//marcumq([1,2,3],4) -//ans = -// 0.0028895 0.0341348 0.1965122 - -funcprot(0); -rhs = argn(2) -if(rhs<2 | rhs>4) -error("Wrong number of input arguments.") -end - select(rhs) - case 2 then - q = callOctave("marcumq",a,b) - case 3 then - q = callOctave("marcumq",a,b,m) - case 4 then - q = callOctave("marcumq",a,b,m,tol) - end + + if ((nargin < 2) || (nargin > 5)) + error(" marcumq : wrong numbers of input arguments "); + end + + if nargin < 3 then m = 1 end + if nargin < 4 then tol = %eps end + if nargin < 5 then max_iter = 100 end + + if (or (a < 0)) + error ("marcumq: A must be a non-negative value"); + end + if (or (b < 0)) + error ("marcumq: B must be a non-negative value"); + end + if (or (m < 1) || or (fix (m) ~= m)) + error ("marcumq: M must be a positive integer"); + end + + [a, b] = tablify (a, b); + q = [] + for i=1:size(a,1) + for j=1:size(a,2) + q(i,j) = mq(a(i,j),b(i,j),m,tol) + end + end + endfunction - + +// Subfunction to compute the actual Marcum Q function. +function q = mq (a, b, m, tol) + + // Special cases. + if (b == 0) + q = 1; + N = 0; + return; + end + if (a == 0) + k = 0:(m - 1); + q = exp (-b^2 / 2) * sum (b.^(2 * k) ./ (2.^k .* factorial (k))); + N = 0; + return; + end + + // The basic iteration. If a<b compute Q_M, otherwise + // compute 1-Q_M. + k = m; + z = a * b; + t = 1; + k = 0; + if (a < b) + s = 1; + c = 0; + x = a / b; + d = x; + S = besseli (0, z, 1); + if (m > 1) + for k = 1:m - 1 + t = (d + 1 / d) * besseli (k, z, 1); + S = S + t; + d = d * x; + end + end + N = k; + k = k + 1 + else + s = -1; + c = 1; + x = b / a; + k = m; + d = x^m; + S = 0; + N = 0; + end + + while (abs (t / S) > tol) + t = d * besseli (abs (k), z, 1); + S = S + t; + d = d * x; + N = k; + k = k + 1 ; + end + q = c + s * exp (-(a - b)^2 / 2) * S; + +endfunction + +// Internal helper function to create a table of like dimensions from arguments. +function [ta , tb] = tablify(a,b) + rows = size(a,1) + cols = size(b,2) + ta=[] + for i=1:cols + ta = [ta a ] + end + tb=[] + for i=1:rows + tb = [ tb ; b] + end +endfunction +/* +test + a = [0.00; 0.05; 1.00; 2.00; 3.00; 4.00; 5.00; 6.00; 7.00; 8.00; 9.00; 10.00; + 11.00; 12.00; 13.00; 14.00; 15.00; 16.00; 17.00; 18.00; 19.00; 20.00; + 21.00; 22.00; 23.00; 24.00]; + b = [0.000000, 0.100000, 1.100000, 2.100000, 3.100000, 4.100000]; + Q = [1.000000, 0.995012, 0.546074, 0.110251, 0.008189, 0.000224; + 1.000000, 0.995019, 0.546487, 0.110554, 0.008238, 0.000226; + 1.000000, 0.996971, 0.685377, 0.233113, 0.034727, 0.002092; + 1.000000, 0.999322, 0.898073, 0.561704, 0.185328, 0.027068; + 1.000000, 0.999944, 0.985457, 0.865241, 0.526735, 0.169515; + 1.000000, 0.999998, 0.999136, 0.980933, 0.851679, 0.509876; + 1.000000, 1.000000, 0.999979, 0.998864, 0.978683, 0.844038; + 1.000000, 1.000000, 1.000000, 0.999973, 0.998715, 0.977300; + 1.000000, 1.000000, 1.000000, 1.000000, 0.999969, 0.998618; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999966; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; +q = marcumq (a, b); +assert_checkalmostequal (q, Q, %eps,1e-4); + +test + a = [0.00; 0.05; 1.00; 2.00; 3.00; 4.00; 5.00; 6.00; 7.00; 8.00; 9.00; 10.00; + 11.00; 12.00; 13.00; 14.00; 15.00; 16.00; 17.00; 18.00; 19.00; 20.00; + 21.00; 22.00; 23.00; 24.00]; + b = [5.100000, 6.100000, 7.100000, 8.100000, 9.100000, 10.10000]; + Q = [0.000002, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000002, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000049, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.001606, 0.000037, 0.000000, 0.000000, 0.000000, 0.000000; + 0.024285, 0.001420, 0.000032, 0.000000, 0.000000, 0.000000; + 0.161412, 0.022812, 0.001319, 0.000030, 0.000000, 0.000000; + 0.499869, 0.156458, 0.021893, 0.001256, 0.000028, 0.000000; + 0.839108, 0.493229, 0.153110, 0.021264, 0.001212, 0.000027; + 0.976358, 0.835657, 0.488497, 0.150693, 0.020806, 0.001180; + 0.998549, 0.975673, 0.833104, 0.484953, 0.148867, 0.020458; + 0.999965, 0.998498, 0.975152, 0.831138, 0.482198, 0.147437; + 1.000000, 0.999963, 0.998458, 0.974742, 0.829576, 0.479995; + 1.000000, 1.000000, 0.999962, 0.998426, 0.974411, 0.828307; + 1.000000, 1.000000, 1.000000, 0.999961, 0.998400, 0.974138; + 1.000000, 1.000000, 1.000000, 1.000000, 0.999960, 0.998378; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999960; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; + q = marcumq (a, b); + assert_checkalmostequal(q, Q, %eps,1e-4); + + +test + a = [0.00; 0.05; 1.00; 2.00; 3.00; 4.00; 5.00; 6.00; 7.00; 8.00; 9.00; 10.00; + 11.00; 12.00; 13.00; 14.00; 15.00; 16.00; 17.00; 18.00; 19.00; 20.00; + 21.00; 22.00; 23.00; 24.00]; + b = [11.10000, 12.10000, 13.10000, 14.10000, 15.10000, 16.10000]; + Q = [0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.000026, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000; + 0.001155, 0.000026, 0.000000, 0.000000, 0.000000, 0.000000; + 0.020183, 0.001136, 0.000025, 0.000000, 0.000000, 0.000000; + 0.146287, 0.019961, 0.001120, 0.000025, 0.000000, 0.000000; + 0.478193, 0.145342, 0.019778, 0.001107, 0.000024, 0.000000; + 0.827253, 0.476692, 0.144551, 0.019625, 0.001096, 0.000024; + 0.973909, 0.826366, 0.475422, 0.143881, 0.019494, 0.001087; + 0.998359, 0.973714, 0.825607, 0.474333, 0.143304, 0.019381; + 0.999959, 0.998343, 0.973546, 0.824952, 0.473389, 0.142803; + 1.000000, 0.999959, 0.998330, 0.973400, 0.824380, 0.472564; + 1.000000, 1.000000, 0.999958, 0.998318, 0.973271, 0.823876; + 1.000000, 1.000000, 1.000000, 0.999958, 0.998307, 0.973158; + 1.000000, 1.000000, 1.000000, 1.000000, 0.999957, 0.998297; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999957; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; + q = marcumq (a, b); + assert_checkalmostequal (q, Q,%eps,1e-4); + + +test + a = [0.00; 0.05; 1.00; 2.00; 3.00; 4.00; 5.00; 6.00; 7.00; 8.00; 9.00; 10.00; + 11.00; 12.00; 13.00; 14.00; 15.00; 16.00; 17.00; 18.00; 19.00; 20.00; + 21.00; 22.00; 23.00; 24.00]; + b = [17.10000, 18.10000, 19.10000]; + Q = [0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000000, 0.000000, 0.000000; + 0.000024, 0.000000, 0.000000; + 0.001078, 0.000024, 0.000000; + 0.019283, 0.001071, 0.000023; + 0.142364, 0.019197, 0.001065; + 0.471835, 0.141976, 0.019121; + 0.823429, 0.471188, 0.141630; + 0.973056, 0.823030, 0.470608; + 0.998289, 0.972965, 0.822671; + 0.999957, 0.998281, 0.972883; + 1.000000, 0.999957, 0.998274; + 1.000000, 1.000000, 0.999956; + 1.000000, 1.000000, 1.000000]; + q = marcumq (a, b); + assert_checkalmostequal(q, Q, %eps,1e-4); + +// The tests for M>1 were generating from Marcum's tables by +// using the formula +// Q_M(a,b) = Q(a,b) + exp(-(a-b)^2/2)*sum_{k=1}^{M-1}(b/a)^k*exp(-ab)*I_k(ab) + +test + M = 2; + a = [0.00; 0.05; 1.00; 2.00; 3.00; 4.00; 5.00; 6.00; 7.00; 8.00; 9.00; 10.00; + 11.00; 12.00; 13.00; 14.00; 15.00; 16.00; 17.00; 18.00; 19.00; 20.00; + 21.00; 22.00; 23.00; 24.00]; + b = [ 0.00, 0.10, 2.10, 7.10, 12.10, 17.10]; + Q = [1.000000, 0.999987, 0.353353, 0.000000, 0.000000, 0.000000; + 1.000000, 0.999988, 0.353687, 0.000000, 0.000000, 0.000000; + 1.000000, 0.999992, 0.478229, 0.000000, 0.000000, 0.000000; + 1.000000, 0.999999, 0.745094, 0.000001, 0.000000, 0.000000; + 1.000000, 1.000000, 0.934771, 0.000077, 0.000000, 0.000000; + 1.000000, 1.000000, 0.992266, 0.002393, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999607, 0.032264, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999992, 0.192257, 0.000000, 0.000000; + 1.000000, 1.000000, 1.000000, 0.545174, 0.000000, 0.000000; + 1.000000, 1.000000, 1.000000, 0.864230, 0.000040, 0.000000; + 1.000000, 1.000000, 1.000000, 0.981589, 0.001555, 0.000000; + 1.000000, 1.000000, 1.000000, 0.998957, 0.024784, 0.000000; + 1.000000, 1.000000, 1.000000, 0.999976, 0.166055, 0.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 0.509823, 0.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 0.846066, 0.000032; + 1.000000, 1.000000, 1.000000, 1.000000, 0.978062, 0.001335; + 1.000000, 1.000000, 1.000000, 1.000000, 0.998699, 0.022409; + 1.000000, 1.000000, 1.000000, 1.000000, 0.999970, 0.156421; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.495223; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.837820; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.976328; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.998564; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999966; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; + q = marcumq (a, b, M); + assert_checkalmostequal (q, Q, %eps,1e-4); + +test + + M = 5; + a = [0.00; 0.05; 1.00; 2.00; 3.00; 4.00; 5.00; 6.00; 7.00; 8.00; 9.00; 10.00; + 11.00; 12.00; 13.00; 14.00; 15.00; 16.00; 17.00; 18.00; 19.00; 20.00; + 21.00; 22.00; 23.00; 24.00]; + b = [ 0.00, 0.10, 2.10, 7.10, 12.10, 17.10]; + Q = [1.000000, 1.000000, 0.926962, 0.000000, 0.000000, 0.000000; + 1.000000, 1.000000, 0.927021, 0.000000, 0.000000, 0.000000; + 1.000000, 1.000000, 0.947475, 0.000001, 0.000000, 0.000000; + 1.000000, 1.000000, 0.980857, 0.000033, 0.000000, 0.000000; + 1.000000, 1.000000, 0.996633, 0.000800, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999729, 0.011720, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999990, 0.088999, 0.000000, 0.000000; + 1.000000, 1.000000, 1.000000, 0.341096, 0.000000, 0.000000; + 1.000000, 1.000000, 1.000000, 0.705475, 0.000002, 0.000000; + 1.000000, 1.000000, 1.000000, 0.933009, 0.000134, 0.000000; + 1.000000, 1.000000, 1.000000, 0.993118, 0.003793, 0.000000; + 1.000000, 1.000000, 1.000000, 0.999702, 0.045408, 0.000000; + 1.000000, 1.000000, 1.000000, 0.999995, 0.238953, 0.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 0.607903, 0.000001; + 1.000000, 1.000000, 1.000000, 1.000000, 0.896007, 0.000073; + 1.000000, 1.000000, 1.000000, 1.000000, 0.987642, 0.002480; + 1.000000, 1.000000, 1.000000, 1.000000, 0.999389, 0.034450; + 1.000000, 1.000000, 1.000000, 1.000000, 0.999988, 0.203879; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.565165; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.876284; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.984209; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999165; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999983; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; + q = marcumq (a, b, M); + assert_checkalmostequal (q, Q, %eps,1e-4); + +test passed + M = 10; + a = [0.00; 0.05; 1.00; 2.00; 3.00; 4.00; 5.00; 6.00; 7.00; 8.00; 9.00; 10.00; + 11.00; 12.00; 13.00; 14.00; 15.00; 16.00; 17.00; 18.00; 19.00; 20.00; + 21.00; 22.00; 23.00; 24.00]; + b = [ 0.00, 0.10, 2.10, 7.10, 12.10, 17.10]; + Q = [1.000000, 1.000000, 0.999898, 0.000193, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999897, 0.000194, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999931, 0.000416, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999980, 0.002377, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999997, 0.016409, 0.000000, 0.000000; + 1.000000, 1.000000, 0.999999, 0.088005, 0.000000, 0.000000; + 1.000000, 1.000000, 1.000000, 0.302521, 0.000000, 0.000000; + 1.000000, 1.000000, 1.000000, 0.638401, 0.000000, 0.000000; + 1.000000, 1.000000, 1.000000, 0.894322, 0.000022, 0.000000; + 1.000000, 1.000000, 1.000000, 0.984732, 0.000840, 0.000000; + 1.000000, 1.000000, 1.000000, 0.998997, 0.014160, 0.000000; + 1.000000, 1.000000, 1.000000, 0.999972, 0.107999, 0.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 0.391181, 0.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 0.754631, 0.000004; + 1.000000, 1.000000, 1.000000, 1.000000, 0.951354, 0.000266; + 1.000000, 1.000000, 1.000000, 1.000000, 0.995732, 0.006444; + 1.000000, 1.000000, 1.000000, 1.000000, 0.999843, 0.065902; + 1.000000, 1.000000, 1.000000, 1.000000, 0.999998, 0.299616; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.676336; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.925312; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.992390; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999679; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 0.999995; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000; + 1.000000, 1.000000, 1.000000, 1.000000, 1.000000, 1.000000]; + q = marcumq (a, b, M); + assert_checkalmostequal (q, Q, %eps,1e-4); + +*/
\ No newline at end of file diff --git a/macros/morlet.sci b/macros/morlet.sci index 0a160f0..8bd25a1 100644 --- a/macros/morlet.sci +++ b/macros/morlet.sci @@ -1,27 +1,68 @@ -function [psi,x] = morlet (lb,ub,n) - -// Generates Morlet wavelets -// Calling Sequence -// [psi,x]= morlet(lb,ub,n) -// Parameters -// lb: Real or complex valued vector or matrix -// ub: Real or complex valued vector or matrix -// n: Real strictly positive scalar number -// Description -// This is an Octave function -// This function returns values of the Morlet wavelet in the specified interval for all the sample points. -// Examples -// 1. [a,b]=morlet(1,2,3) -// a = [0.17205 0.11254 -0.11356] -// b = [1.0000 1.5000 2.0000] -// 2. [a,b]=morlet([1 2 3],[1 2 3],1) -// a = [0.1720498; -0.1135560; -0.0084394] -// b = [1; 2; 3] - -funcprot(0); -rhs=argn(2); -if (rhs<3) then - error ("Wrong number of input arguments.") -else [psi,x] = callOctave("morlet",lb,ub,n) -end +function [psi,x] = morlet(lb, ub, n) +//Compute the Morlet wavelet. +//Calling sequence: +//[psi,x]= morlet(lb,ub,n) +//Parameters: +//lb: Real or complex valued vector/scalar +//ub: Real or complex valued vector/scalar +//n: Real positive scalar number +//Description: +//This function returns values of the Morlet wavelet in the specified interval for all the sample points. +//Example: +//[a,b] = morlet([1 2 3], [1 2 3], 1) +//a = [0.1720498; -0.1135560; -0.0084394] +//b = [1; 2; 3] + + funcprot(0); + rhs = argn(2); + + if (rhs ~= 3) then + error("morlet: wrong number of input arguments"); + end + + if (length(lb) ~= length(ub)) then + error("morlet: arg1 and arg2 msut have same dimension"); + end + + if (~isreal(n) | n <= 0) then + error("morlet: n must be a strictly positive real number"); + end + x = []; + for i=1:length(lb) + x(i, :) = linspace(lb(i), ub(i), n); + end + psi = cos(5.*x) .* exp(-x.^2/2); + endfunction + +//input validation: +//assert_checkerror("morlet()", "morlet: wrong number of input arguments"); +//assert_checkerror("morlet(1, 2)", "morlet: wrong number of input arguments"); +//assert_checkerror("morlet(1, 2, 3, 4)", "Wrong number of input arguments."); +//assert_checkerror("morlet(1, 2, -1)", "morlet: n must be a strictly positive real number"); +//assert_checkerror("morlet(1, 2, 2+3*%i)", "morlet: n must be a strictly positive real number"); +//assert_checkerror(" morlet([5, 2, 7], [1, 3], 3)", "morlet: arg1 and arg2 msut have same dimension"); + +//test basic input: +//[a, b] = morlet(1, 2, 3); +//assert_checkalmostequal(a, [0.17205, 0.11254, -0.11356], 5e-5); +//assert_checkalmostequal(b, [1, 1.5, 2], %eps); + +//test complex input: +//[a, b] = morlet(3+2*%i, 4+8*%i, 2); +//assert_checkalmostequal(a, [-495.15886-756.35443*%i, -5.08135E26-3.07588E27*%i], 5e-5); +//assert_checkalmostequal(b, [3+2*%i, 4+8*%i], %eps); + +//test real vector: +//[a, b] = morlet([1, 2], [3, 4], 2); +//A = [0.1720498, -0.0084394; -0.113556, 0.0001369]; +//B = [1, 3; 2, 4]; +//assert_checkalmostequal(A, a, 5e-5); +//assert_checkalmostequal(B, b, %eps); + +//test complex vector: +//[a, b] = morlet([1 + 2*%i, 3*%i], [2*%i, 2 + 3*%i], 1); +//A = [81377.39587; -19069291.16508 + 5732843.75676*%i]; +//B = [2*%i; 2+3*%i]; +//assert_checkalmostequal(a, A, 5e-5); +//assert_checkalmostequal(b, B, %eps); diff --git a/macros/mpoles.sci b/macros/mpoles.sci index bba9997..4556120 100644 --- a/macros/mpoles.sci +++ b/macros/mpoles.sci @@ -1,124 +1,128 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt -// Author:[insert name] +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in +function [multp, idxp] = mpoles (p, tol, reorder) + if (nargin < 1) + error("mpoles: Invalid number of input arguments"); + end -function [multp, indx] = mpoles (p, tol, reorder) - -//Calling sequence: -// [multp, idxp] = mpoles (p) -// [multp, idxp] = mpoles (p, tol) -// [multp, idxp] = mpoles (p, tol, reorder) -// Identify unique poles in p and their associated multiplicity. -// -// The output is ordered from largest pole to smallest pole. -// -// If the relative difference of two poles is less than tol then they are -// considered to be multiples. The default value for tol is 0.001. -// -// If the optional parameter reorder is zero, poles are not sorted. -// -// The output multp is a vector specifying the multiplicity of the poles. -// multp(n) refers to the multiplicity of the Nth pole -// p(idxp(n)). -// -// -// - -// test case: - -// p = [2 3 1 1 2]; -// [m, n] = mpoles (p) -// n = -// 2. -// 5. -// 1. -// 4. -// 3. -// m = -// 1. -// 1. -// 2. -// 1. -// 2. -// - - -[nargout,nargin]=argn(); - - if (nargin < 1 | nargin > 3) - error("wrong number of input arguments"); + if ~( type(p)== 1) + error ("mpoles: P must be a single or double floating point vector"); end - if (nargin < 2 | isempty (tol)) - tol = 0.001; - end + if (nargin < 2 || isempty (tol)) + tol = 0.001; + elseif (~(isscalar (tol) && isreal (tol) && tol > 0)) + error ("mpoles: TOL must be a real scalar greater than 0"); + end - if (nargin < 3 | isempty (reorder)) - reorder = %t; - end + if (nargin < 3 || isempty (reorder)) + reorder = %t; + elseif (~(isscalar (reorder) && isreal (reorder))) + error ("mpoles: REORDER must be a numeric or logical scalar"); + end Np = length (p); - - // Force the poles to be a column vector. - - p = p(:); - - // Sort the poles according to their magnitidues, largest first. + p = p(:); // force poles to be a column vector if (reorder) - // Sort with smallest magnitude first. - [p, ordr] = gsort (p,"r","i"); - // Reverse order, largest maginitude first. - n = Np:-1:1; - p = p(n); - ordr = ordr(n); + //// sort with largest magnitude first + [_, order] = gsort (abs(p)); + p = p(order); else - ordr = 1:Np; + order = (1:Np).'; end - // Find pole multiplicty by comparing the relative differnce in the - // poles. + //// Create vector of tolerances for use in algorithm. + vtol = zeros (Np, 1, typeof(p)); + p_nz = (p ~= 0); // non-zero poles + vtol(~p_nz) = tol; // use absolute tolerance for zero poles - multp = zeros (Np, 1); - indx = []; + //// Find pole multiplicity by comparing relative difference of poles. + multp = zeros (Np, 1, typeof(p)); + idxp = []; n = find (multp == 0, 1); - - - - - - while (n) - dp = abs (p-p(n)); - if (p(n) == 0.0) - if (or (abs (p) > 0 & (abs(p)<%inf))) - p0 = mean (abs (p(abs (p) > 0 & abs(p)<%inf))); - else - p0 = 1; - end - else - p0 = abs (p(n)); + dp = abs (p - p(n)); + vtol(p_nz) = tol * abs (p(n)); + k = find (dp < vtol); + //// Poles can only be members of one multiplicity group. + if (length (idxp)) + k = k(~ismember (k, idxp)); end - k = find (dp < tol * p0)'; - // Poles can only be members of one multiplicity group. -// if (length(indx)) -// mk=members(k,indx); -// k = (~ bool2s(mk~=0)); -// end m = 1:length (k); - multp(k) = m'; - indx = [indx; k]; + multp(k) = m; + // disp("k") + // disp(k) + // disp("idxp") + // disp(idxp) + idxp = [idxp; k(:)]; n = find (multp == 0, 1); end - multp = multp(indx); - indx = ordr(indx); + multp = multp(idxp); + idxp = order(idxp); +endfunction +function y = ismember(a, b) // FIXME : do this in a more efficient . + y = zeros(size(a,1),size(a,2)); + for i = 1:length(a) + for j = 1:length(b) + if a(i) == b(j) + y(i) = 1; + break; + end + end + end endfunction + + +/* + + // test + [mp, ip] = mpoles ([0 0], 0.01); + assert_checkequal (mp, [1; 2]); + + // test + [mp, ip] = mpoles ([-1e4, -0.1, 0]); + assert_checkequal (mp, [1; 1; 1]); + assert_checkequal (ip, [1; 2; 3]); + +// Test single inputs +// test + [mp, ip] = mpoles ([-1e4, -0.1, 0]); + assert_checkequal (mp,[1; 1; 1]); + assert_checkequal (ip, [1; 2; 3]); + +// Test relative tolerance criteria +// test + [mp, ip] = mpoles ([1, 1.1, 1.3], .1/1.1); + assert_checkequal (mp, [1; 1; 1]); + [mp, ip] = mpoles ([1, 1.1, 1.3], .1/1.1 + %eps); + assert_checkequal (mp, [1; 1; 2]); + +// Test absolute tolerance criteria with a zero pole +// test + [mp, ip] = mpoles ([0, -0.1, 0.3], .1); + assert_checkequal (mp, [1; 1; 1]); + [mp, ip] = mpoles ([0, -0.1, 0.3], .1 + %eps); + assert_checkequal (mp, [1; 1; 2]); + +//// Test input validation +error <Invalid call> mpoles () +error <P must be a single or double floating point vector> mpoles (uint8 (1)) +error <TOL must be a real scalar greater than 0> mpoles (1, [1, 2]) +error <TOL must be a real scalar greater than 0> mpoles (1, 1i) +error <TOL must be a real scalar greater than 0> mpoles (1, 0) +error <REORDER must be a numeric or logical scalar> mpoles (1, 1, [1, 2]) +error <REORDER must be a numeric or logical scalar> mpoles (1, 1, {1}) + +*/
\ No newline at end of file diff --git a/macros/ncauer.sci b/macros/ncauer.sci index d9a0684..dad3025 100644 --- a/macros/ncauer.sci +++ b/macros/ncauer.sci @@ -1,53 +1,85 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt -// Author:Sonu Sharma, RGIT Mumbai +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - function [Zz, Zp, Zg] = ncauer(Rp, Rs, n) -//Analog prototype for Cauer filter (Cauer filter and elliptic filters are same). - -//Calling Sequence -//[Zz, Zp, Zg] = ncauer(Rp, Rs, n) - -//Parameters -//n: Filter Order -//Rp: Peak-to-peak passband ripple in dB -//Rs: Stopband attenuation in dB - -//Description -//It gives an analog prototype for Cauer filter of nth order, with a Peak-to-peak passband ripple of Rp dB and a stopband attenuation of Rs dB. + //Analog prototype for Cauer filter (Cauer filter and elliptic filters are same). + + //Calling Sequence + //[Zz, Zp, Zg] = ncauer(Rp, Rs, n) + + //Parameters + //n: Filter Order + //Rp: Peak-to-peak passband ripple in dB + //Rs: Stopband attenuation in dB + + //Description + //It gives an analog prototype for Cauer filter of nth order, with a Peak-to-peak passband ripple of Rp dB and a stopband attenuation of Rs dB. + + + //Examples + //n = 5; + //Rp = 5; + //Rs = 5; + //[Zz, Zp, Zg] = ncauer(Rp, Rs, n) + + //Zz = + // + // 0.0000 + 2.5546i 0.0000 + 1.6835i -0.0000 - 2.5546i -0.0000 - 1.6835i + // + //Zp = + // + // -0.10199 + 0.64039i -0.03168 + 0.96777i -0.10199 - 0.64039i -0.03168 - 0.96777i -0.14368 + 0.00000i + // + //Zg = 0.0030628 + // Dependencies + // ellipap + + funcprot(0); + lhs = argn(1) + rhs = argn(2) + if (rhs < 3 | rhs > 3) + error("ncauer : Wrong number of input arguments.") + end + + [Zz, Zp, Zg] = ellipap(n, Rp, Rs) ; + // temp fix to permanently fix this change ellipap + Zz = Zz'; + Zp = Zp'; + endfunction -//Examples -//n = 5; -//Rp = 5; -//Rs = 5; -//[Zz, Zp, Zg] = ncauer(Rp, Rs, n) +/* -//Zz = -// -// 0.0000 + 2.5546i 0.0000 + 1.6835i -0.0000 - 2.5546i -0.0000 - 1.6835i -// -//Zp = -// -// -0.10199 + 0.64039i -0.03168 + 0.96777i -0.10199 - 0.64039i -0.03168 - 0.96777i -0.14368 + 0.00000i -// -//Zg = 0.0030628 +// Test Case 1 (ncauer 0.1, 60, 7) +[z, p, g] = ncauer(0.1, 60, 7); +assert_checkalmostequal(z, [2.5574 1.5522 1.3295 -2.5574 -1.5522 -1.3295]*%i, 1e-2); +assert_checkalmostequal(p, [-0.3664+0.5837*%i -0.1802+0.9088*%i -0.0499+1.0285*%i -0.3664-0.5837*%i -0.1802-0.9088*%i -0.0499-1.0285*%i -0.4796], 1e-2); +assert_checkalmostequal(g, 7.4425e-03, 1e-2); +// Test Case 2 (ncauer 1.0, 30, 3) +[z, p, g] = ncauer(1.0, 30, 3); +assert_checkalmostequal(z, [1.9536 -1.9536]*%i, 1e-2); +assert_checkalmostequal(p, [-0.2053+0.9870*%i -0.2053-0.9870*%i -0.5597], 1e-2); +assert_checkalmostequal(g, 0.1490, 1e-2); -funcprot(0); -lhs = argn(1) -rhs = argn(2) -if (rhs < 3 | rhs > 3) -error("ncauer : Wrong number of input arguments.") -end +// Test Case 3 (ncauer 0.25, 50, 6) +[z, p, g] = ncauer(0.25, 50, 6); +assert_checkalmostequal(z, [4.0596 1.6414 1.3142 -4.0596 -1.6414 -1.3142]*%i, 1e-2); +assert_checkalmostequal(p, [-0.4210+0.3665*%i -0.2117+0.8503*%i -0.0550+1.0198*%i -0.4210-0.3665*%i -0.2117-0.8503*%i -0.0550-1.0198*%i], 1e-2); +assert_checkalmostequal(g, 3.1618e-03, 1e-2); -[Zz, Zp, Zg] = ellipap(n, Rp, Rs) ; +// Test Case 4 (ncauer 0.8, 45, 4) +[z, p, g] = ncauer(0.8, 45, 4); +assert_checkalmostequal(z, [4.1768 1.8543 -4.1768 -1.8543]*%i, 1e-2); +assert_checkalmostequal(p, [-0.3861+0.4640*%i -0.1234+1.0000*%i -0.3861-0.4640*%i -0.1234-1.0000*%i], 1e-2); +assert_checkalmostequal(g, 5.6237e-03, 1e-2); -endfunction +*/
\ No newline at end of file diff --git a/macros/parser.sci b/macros/parser.sci new file mode 100644 index 0000000..9611161 --- /dev/null +++ b/macros/parser.sci @@ -0,0 +1,82 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +/// Author : Abinash Singh Under FOSSEE Internship +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in + +function [ dSided, minH, minD, minW, maxW ] = parser ( varargin ) + // Default values + // This is an helper function for findpeaks + // It parses the input arguments and returns the values of the options + dSided = %f ; + minH = %eps ; + minD = 1 ; + minW = %eps; + maxW = %inf ; + idx = 1 ; + while idx <= length(varargin) + select lower(varargin(idx)) + case 'doublesided' + dSided = %t ; + idx = idx + 1 ; + case 'minpeakheight' + if idx+1 > length(varargin) || ~( isscalar(varargin(idx+1)) && varargin(idx+1) >=0 ) then + error('findpeaks: MinPeakHeight must be a postive scalar') ; + end + minH = varargin(idx+1) ; + idx = idx + 2 ; + case 'minpeakdistance' + if idx+1 > length(varargin) || ~( isscalar(varargin(idx+1)) && varargin(idx+1) >=0 ) then + error('findpeaks: MinPeakDistance must be a postive scalar') ; + end + minD = varargin(idx+1) ; + idx = idx + 2 ; + case 'minpeakwidth' + if idx+1 > length(varargin) || ~( isscalar(varargin(idx+1)) && varargin(idx+1) >=0 ) then + error('findpeaks: MinPeakWidth must be a postive scalar') ; + end + minW = varargin(idx+1) ; + idx = idx + 2 ; + case 'maxpeakwidth' + if idx+1 > length(varargin) || ~( isscalar(varargin(idx+1)) && varargin(idx+1) >=0 ) then + error('findpeaks: MaxPeakWidth must be a postive scalar') ; + end + maxW = varargin(idx+1) ; + idx = idx + 2 ; + else + warning("findpeaks: Ignoring unknown option ") ; + idx = idx + 1 ; + end + + end +endfunction + +function y = lower (y) + // This function converts the input string to lower case + // Returns the input without modification if its not a string + if type(y) == 10 then + y = convstr(y, 'l') ; + else + y = y ; + end + +endfunction + +function out = bsminuseq(A) + // This function returns the difference between the elements of the input array + // This is only useful for the findpeaks function + A = A(:).' ; + atemp = []; + btemp=[] ; + for i=1:length(A) + atemp = [atemp ; A ] + btemp = [btemp A.' ] + end + out = atemp - btemp +endfunction diff --git a/macros/pburg.sci b/macros/pburg.sci index 78198ed..f677157 100644 --- a/macros/pburg.sci +++ b/macros/pburg.sci @@ -1,93 +1,138 @@ -function [psd,f_out] = pburg(x,poles,freq,Fs,range,method,plot_type,criterion) +function [psd,f_out] = pburg(x, poles, varargin) //Calculate Burg maximum-entropy power spectral density. -//Calling Sequence -//[psd,f_out] = pburg(x,poles,freq,Fs,range,method,plot_type,criterion) -//All but the first two arguments are optional and may be empty. -//Parameters -// x: [vector] sampled data -// poles: [integer scalar] required number of poles of the AR model -// freq: [real vector] frequencies at which power spectral density is calculated [integer scalar] number of uniformly distributed frequency values at which spectral density is calculated. [default=256] -// Fs: [real scalar] sampling frequency (Hertz) [default=1] -// range: 'half', 'onesided' : frequency range of the spectrum is from zero up to but not including sample_f/2. Power from negative frequencies is added to the positive side of the spectrum. 'whole', 'twosided' : frequency range of the spectrum is -sample_f/2 to sample_f/2, with negative frequencies stored in "wrap around" order after the positive frequencies; e.g. frequencies for a 10-point 'twosided' spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 'shift', 'centerdc' : same as 'whole' but with the first half of the spectrum swapped with second half to put the zero-frequency value in the middle. (See "help fftshift". If "freq" is vector, 'shift' is ignored. If model coefficients "ar_coeffs" are real, the default range is 'half', otherwise default range is 'whole'. -// method: 'fft': use FFT to calculate power spectral density. 'poly': calculate spectral density as a polynomial of 1/z N.B. this argument is ignored if the "freq" argument is a vector. The default is 'poly' unless the "freq" argument is an integer power of 2. -// plot_type: 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db' specifies the type of plot. The default is 'plot', which means linear-linear axes. 'squared' is the same as 'plot'. 'dB' plots "10*log10(psd)". This argument is ignored and a spectrum is not plotted if the caller requires a returned value. -// criterion: [optional string arg] model-selection criterion. Limits the number of poles so that spurious poles are not added when the whitened data has no more information in it (see Kay & Marple, 1981). Recognized values are 'AKICc' -- approximate corrected Kullback information criterion (recommended), 'KIC' -- Kullback information criterion 'AICc' -- corrected Akaike information criterion 'AIC' -- Akaike information criterion 'FPE' -- final prediction error" criterion The default is to NOT use a model-selection criterion. -//Description -//This function is being called from Octave + +//Calling Sequence: +//[psd,f_out] = pburg(x, poles, freq, Fs, range, method, plot_type, criterion) + +//Parameters: +//All but the first two parameters are optional and may be empty. +// +//x- [vector] sampled data +//poles- [integer scalar] required number of poles of the AR model +//freq- [real vector] frequencies at which power spectral density is calculated. +//[integer scalar] number of uniformly distributed frequency values at which spectral density is calculated. [default=256] +//Fs:[real scalar] sampling frequency (Hertz) [default=1] +// +//CONTROL-STRING ARGUMENTS -- each of these arguments is a character string. +//Control-string arguments can be in any order after the other arguments. +// +//range: +//'half', 'onesided'- frequency range of the spectrum is from zero up to but not including sample_f/2. Power +//from negative frequencies is added to the positive side of the spectrum. +//'whole', 'twosided'- frequency range of the spectrum is -sample_f/2 to sample_f/2, with negative frequencies +//stored in "wrap around" order after the positive frequencies; e.g. frequencies for a 10-point 'twosided' +//spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 +//'shift', 'centerdc'- same as 'whole' but with the first half of the spectrum swapped with second half to put the +//zero-frequency value in the middle. If "freq" is vector, 'shift' is ignored. If model coefficients "ar_coeffs" are real, the default +//range is 'half', otherwise default range is 'whole'. +// +//method: +//'fft'- use FFT to calculate power spectral density. +//'poly'- calculate spectral density as a polynomial of 1/z N.B. this argument is ignored if the "freq" argument is a +//vector. The default is 'poly' unless the "freq" argument is an integer power of 2. +// +//plot_type: 'plot', 'semilogx', 'semilogy', 'loglog', 'squared' or 'db'- specifies the type of plot. The default is 'plot', which +//means linear-linear axes. 'squared' is the same as 'plot'. 'dB' plots "10*log10(psd)". This argument is ignored and a +//spectrum is not plotted if the caller requires a returned value. +// +//criterion: [optional string arg] model-selection criterion. Limits the number of poles so that spurious poles are not +//added when the whitened data has no more information in it (see Kay & Marple, 1981). Recognized values are- +//'AKICc' -- approximate corrected Kullback information criterion (recommended), +//'KIC' -- Kullback information criterion +//'AICc' -- corrected Akaike information criterion +//'AIC' -- Akaike information criterion +//'FPE' -- final prediction error" criterion +// +//The default is to NOT use a model-selection criterion +// +// RETURNED VALUES: +//If return values are not required by the caller, the spectrum is plotted and nothing is returned. +//psd: [real vector] power-spectral density estimate. +//f_out: [real vector] frequency values. + +//Description: //This function is a wrapper for arburg and ar_psd. -//The functions "arburg" and "ar_psd" do all the work. -//See "help arburg" and "help ar_psd" for further details. -//Examples -//a = [1.0 -1.6216505 1.1102795 -0.4621741 0.2075552 -0.018756746]; -//[psd,f_out] = pburg(a,2); -funcprot(0); -lhs = argn(1) -rhs = argn(2) -if (rhs < 2 | rhs > 8) -error("Wrong number of input arguments.") -end +//Examples: +//a = [1.0 -1.6216505 1.1102795 -0.4621741 0.2075552 -0.018756746]; +//[psd, f_out] = pburg(a, 2); -select(rhs) - - case 2 then - if(lhs==1) - psd = callOctave("pburg",x,poless) - elseif(lhs==2) - [psd,f_out] = callOctave("pburg",x,poles) - else - error("Wrong number of output argments.") - end + funcprot(0); + if (nargin < 2) + error('pburg: need at least 2 args.'); + end + nvarargin = length(varargin); + criterion = []; + for iarg = 1:nvarargin + arrgh = varargin(iarg); + if (type(arrgh) == 10 && ( ~strcmp(arrgh,'AKICc') ||... + ~strcmp(arrgh,'KIC') || ~strcmp(arrgh,'AICc') ||... + ~strcmp(arrgh,'AIC') || ~strcmp(arrgh,'FPE') ) ) + criterion = arrgh; + if (nvarargin > 1) + varargin(iarg) = []; + else + varargin = list(); + end + end + end + [ar_coeffs,residual] = arburg(x,poles,criterion); + if (nargout == 0) + ar_psd(ar_coeffs,residual,varargin(:)); + elseif (nargout == 1) + psd = ar_psd(ar_coeffs,residual,varargin(:)); + elseif (nargout >= 2) + [psd,f_out] = ar_psd(ar_coeffs,residual,varargin(:)); + end - case 3 then - if(lhs==1) - psd = callOctave("pburg",x,poles,freq) - elseif(lhs==2) - [psd,f_out] = callOctave("pburg",x,poles,freq) - else - error("Wrong number of output argments.") - end - case 4 then - if(lhs==1) - psd = callOctave("pburg",x,poles,freq,Fs) - elseif(lhs==2) - [psd,f_out] = callOctave("pburg",x,poles,freq,Fs) - else - error("Wrong number of output argments.") - end - case 5 then - if(lhs==1) - psd = callOctave("pburg",x,poles,freq,Fs,range) - elseif(lhs==2) - [psd,f_out] = callOctave("pburg",x,poles,freq,Fs,range) - else - error("Wrong number of output argments.") - end - case 6 then - if(lhs==1) - psd = callOctave("pburg",x,poles,freq,Fs,range,method) - elseif(lhs==2) - [psd,f_out] = callOctave("pburg",x,poles,freq,Fs,range,method) - else - error("Wrong number of output argments.") - end - case 7 then - if(lhs==1) - psd = callOctave("pburg",x,poles,freq,Fs,range,method,plot_type) - elseif(lhs==2) - [psd,f_out] = callOctave("pburg",x,poles,freq,Fs,range,method,plot_type) - else - error("Wrong number of output argments.") - end - case 8 then - if(lhs==1) - psd = callOctave("pburg",x,poles,freq,Fs,range,method,plot_type,criterion) - elseif(lhs==2) - [psd,f_out] = callOctave("pburg",x,poles,freq,Fs,range,method,plot_type,criterion) - else - error("Wrong number of output argments.") - end - end endfunction +//tests: + +//fs = 1000; +//t = 0:1/fs:1-1/fs; +//x = cos(2*%pi*100*t); +//order = 4; +//[pxx, f] = pburg(x, order, [], fs); +//figure; +//plot(f, 10*log10(pxx)); +//title('PSD Estimate using Burg Method - Sinusoidal Signal'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency (dB/Hz)'); + +//fs = 1000; +//t = 0:1/fs:1-1/fs; +//x = cos(2*%pi*100*t); +//orders = [2, 4, 8, 16]; +//figure; +//for i = 1:length(orders) +// order = orders(i); +// [pxx, f] = pburg(x, order, [], fs); +// subplot(length(orders), 1, i); +// plot(f, 10*log10(pxx)); +// title(['PSD Estimate using Burg Method - Order ' string(order)]); +// xlabel('Frequency (Hz)'); +// ylabel('Power/Frequency (dB/Hz)'); +//end + +//fs = 1000; +//t = 0:1/fs:0.1-1/fs; +//x = cos(2*%pi*100*t); +//order = 4; +//[pxx, f] = pburg(x, order, [], fs); +//figure; +//plot(f, 10*log10(pxx)); +//title('PSD Estimate using Burg Method - Short Data Segment'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency (dB/Hz)'); +//fs = 1000; +//t = 0:1/fs:1-1/fs; +//x = cos(2*%pi*100*t) + cos(2*%pi*200*t); +//order = 4; +//[pxx, f] = pburg(x, order, [], fs); +//figure; +//plot(f, 10*log10(pxx)); +//title('PSD Estimate using Burg Method - Multicomponent Signal'); +//xlabel('Frequency (Hz)'); +//ylabel('Power/Frequency (dB/Hz)'); diff --git a/macros/pei_tseng_notch.sci b/macros/pei_tseng_notch.sci index 1de0fcd..fcb6b9c 100644 --- a/macros/pei_tseng_notch.sci +++ b/macros/pei_tseng_notch.sci @@ -1,44 +1,73 @@ -function [b, a] = pei_tseng_notch (frequencies, bandwidths) - +function [ b, a ] = pei_tseng_notch ( frequencies, bandwidths ) //Return coefficients for an IIR notch-filter. -//Calling Sequence -//[b, a] = pei_tseng_notch (frequencies, bandwidths) -//b = pei_tseng_notch (frequencies, bandwidths) -//Parameters -//frequencies: filter frequencies -//bandwidths: bandwidths to be used with filter -//Description -//This is an Octave function. -//It return coefficients for an IIR notch-filter with one or more filter frequencies and according bandwidths. The filter is based on a all pass filter that performs phasereversal at filter frequencies. -//This leads to removal of those frequencies of the original and phase-distorted signal. -//Examples +//Calling Sequence: +//[b, a] = pei_tseng_notch(frequencies, bandwidths) +//Parameters: +//frequencies: Real scalar/vector representing filter frequencies. +//bandwidths: Real scalar scalar/vector representing bandwidths to be used with filter. +//Description: +//THis function returns coefficients for an IIR notch-filter with one or more filter frequencies and according bandwidths. +//The filter is based on a all pass filter that performs phasereversal at filter frequencies. This leads to removal of those frequencies of the original and phase-distorted signal. +//Examples: //sf = 800; sf2 = sf/2; -//data=[[1;zeros(sf-1,1)],sinetone(49,sf,1,1),sinetone(50,sf,1,1),sinetone(51,sf,1,1)]; -//[b,a]=pei_tseng_notch ( 50 / sf2, 2/sf2 ) -//b = -// -// 0.99213 -1.83322 0.99213 -// -//a = -// -// 1.00000 -1.83322 0.98426 - -funcprot(0); -lhs = argn(1) -rhs = argn(2) -if (rhs < 2 | rhs > 2) -error("Wrong number of input arguments.") -end - -select(rhs) - - case 2 then - if(lhs==1) - b = callOctave("pei_tseng_notch", frequencies, bandwidths) - elseif(lhs==2) - [b, a] = callOctave("pei_tseng_notch", frequencies, bandwidths) - else - error("Wrong number of output argments.") - end - end +//data = [[1;zeros(sf-1,1)],sinetone(49,sf,1,1),sinetone(50,sf,1,1),sinetone(51,sf,1,1)]; +//[b,a] = pei_tseng_notch ( 50 / sf2, 2/sf2 ) +//b = 0.99213 -1.83322 0.99213 +//a = 1.00000 -1.83322 0.98426 + + if (nargin() ~= 2) + error("Wrong number of input arguments."); + elseif ( ~isvector(frequencies) | ~isvector(bandwidths) ) + if ( ~isscalar(frequencies) | ~isscalar(bandwidths) ) + error("All arguments must be vectors or scalars."); + end + elseif ( length(frequencies) ~= length (bandwidths) ) + error("All arguments must be of equal length."); + elseif (~and( frequencies > 0 & frequencies < 1 )) + error("All frequencies must be in (0, 1)."); + elseif (~and( bandwidths > 0 & bandwidths < 1 )) + error("All bandwidths must be in (0, 1)."); + end + + frequencies = frequencies (:)'; + bandwidths = bandwidths (:)'; + + frequencies = frequencies*%pi; + bandwidths = bandwidths*%pi; + M2 = 2 * length(frequencies); + + a = [ frequencies - bandwidths / 2; frequencies ]; + omega = a(:); + factors = ( 1 : 2 : M2 ); + b = [ -%pi * factors + %pi / 2; -%pi * factors ]; + phi = b(:); + t_beta = tan ( ( phi + M2 * omega ) / 2 ); + + Q = zeros (M2, M2); + + for k = 1 : M2 + Q ( :, k ) = sin ( k .* omega ) - t_beta .* cos ( k .* omega ); + end + + h_a = ( Q \ t_beta )'; + denom = [ 1, h_a ]; + num = [ flipdim(h_a, 2), 1 ]; + + a = denom; + b = ( num + denom ) / 2; + endfunction + +//input validation: +//assert_checkerror("pei_tseng_notch()", "Wrong number of input arguments."); +//assert_checkerror("pei_tseng_notch([1, 2, 3])", "Wrong number of input arguments."); +//assert_checkerror("pei_tseng_notch([1, 2; 3, 4], [4; 5; 6])", "All arguments must be vectors or scalars."); +//assert_checkerror("pei_tseng_notch([1, 2, 3, 4], [5, 6])", "All arguments must be of equal length."); +//assert_checkerror("pei_tseng_notch([1, 2, 3], [4, 5, 6])", "All frequencies must be in (0, 1)."); +//assert_checkerror("pei_tseng_notch([0.1, 0.2, 0.3], [4, 5, 6])", "All bandwidths must be in (0, 1)."); + +//tests: +//assert_checkequal(pei_tseng_notch(0.2, 0.4), [0 0 0]); +//assert_checkalmostequal(pei_tseng_notch([0.2, 0.5, 0.9], [0.1, 0.3, 0.5]), [0.41549, 0.11803, -0.03227, 0.23606, -0.03227, 0.11803, 0.41549], 5*10^-4); +//assert_checkequal(pei_tseng_notch([0.2; 0.5; 0.9], [0.1, 0.3, 0.5]), pei_tseng_notch([0.2, 0.5, 0.9], [0.1; 0.3; 0.5])); +//assert_checkalmostequal(pei_tseng_notch([0.2, 0.7], [0.1, 0.3]), [0.60331, -0.26694, 0.05905, -0.26694, 0.60331], 5*10^-4); diff --git a/macros/periodgram.sci b/macros/periodgram.sci new file mode 100644 index 0000000..0d406ec --- /dev/null +++ b/macros/periodgram.sci @@ -0,0 +1,232 @@ +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : Feb 2024 +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in + +function [pxx, f] = periodogram (x, varargin) + //Calling Sequence: + //[PXX, F] = periodogram (X, WIN, NFFT, FS) + //[PXX, F] = periodogram (..., "RANGE") + + // The possible inputs are: + // + // X + // + // data vector. If X is real-valued a one-sided spectrum is + // estimated. If X is complex-valued, or "RANGE" specifies + // "twosided", the full spectrum is estimated. + // + // WIN + // window weight data. If window is empty or unspecified a + // default rectangular window is used. Otherwise, the window is + // applied to the signal ('X .* WIN') before computing the + // periodogram. The window data must be a vector of the same + // length as X. + // + // NFFT + // number of frequency bins. The default is 256 or the next + // higher power of 2 greater than the length of X ('max (256, + // 2.^nextpow2 (length (x)))'). If NFFT is greater than the + // length of the input then X will be zero-padded to the length + // of NFFT. + // + // FS + // sampling rate. The default is 1. + // + // RANGE + // range of spectrum. "onesided" computes spectrum from + // [0..nfft/2+1]. "twosided" computes spectrum from [0..nfft-1]. + // + // + // Dependencies + // hamming fft1 + [nargout,nargin]=argn(); + // check input arguments + if (nargin < 1 | nargin > 5) + error("wrong no. of input arguments") + end + + nfft = []; + fs = []; + ran = ""; + win = []; + j = 2; + for k = 1:length (varargin) + if (type (varargin(k))==10) + ran = varargin(k); + else + select (j) + case 2 + win = varargin(k); + case 3 + nfft = varargin(k); + case 4 + fs = varargin(k); + end + j=j+1; + end + end + + if (~ isvector (x)) + error ("periodogram: X must be a real or complex vector"); + end + x = x(:); // Use column vectors from now on + + n = size(x,1); + + if (~isempty (win)) + if (~ isvector (win) | length (win) ~= n) + error ("periodogram: WIN must be a vector of the same length as X"); + end + win = win(:); + x =x.* win; + else + win=window("re",length(x)); + win=win(:); + x=x.*win; + + end + + if (isempty (nfft)) + nfft = max (256, 2.^nextpow2 (n)); + elseif (~ isscalar (nfft)) + error ("periodogram: NFFT must be a scalar"); + end + + use_w_freq = isempty (fs); + if (~use_w_freq & ~ isscalar (fs)) + error ("periodogram: FS must be a scalar"); + end + + if (~strcmp (ran, "onesided")) + ran = 1; + elseif (~strcmp (ran, "twosided")) + ran = 2; + elseif (~strcmp (ran, "centered")) + error ('periodogram: centered ran type is not implemented'); + else + ran = 2 - double(isreal (x)); + end + + // compute periodogram + + if (n > nfft) + Pxx = 0; + rr = modulo(length(x), nfft); + if (rr) + x = [x(:); zeros(nfft-rr, 1)]; + end + x = sum (matrix (x, nfft,-1), 2); + end + + if (~ isempty (win)) + n = sum(win.*conj(win)); + end; + + Pxx = (abs (fft1 (x,nfft))) .^ 2 / n; + + if (use_w_freq) + Pxx =Pxx/(2*%pi); + else + Pxx =Pxx/fs; + end + + // generate output arguments + + if (ran == 1) // onesided + if (modulo(nfft,2)==0) // nfft is even + psd_len = (nfft/2)+1; + Pxx = Pxx(1:psd_len) + [0; Pxx(nfft:-1:psd_len+1); 0]; + else // nfft is odd + psd_len = (nfft+1)/2; + Pxx = Pxx(1:psd_len) + [0; Pxx(nfft:-1:psd_len+1)]; + end + end + + //if (nargout() ~= 1) FIXME: fix nargout + if (ran == 1) + f = (0:nfft/2)' / nfft; + elseif (ran == 2) + f = (0:nfft-1)' / nfft; + end + if (use_w_freq) + f =f* 2*%pi; // generate w=2*pi*f + else + f =f* fs; + end + //end + if (nargout() ~= 2) + if (use_w_freq) + plot (f/(2*%pi), 10*log10 (Pxx)); + xlabel ("normalized frequency [x pi rad]"); + ylabel ("Power density [dB/rad/sample]"); + else + plot (f, 10*log10 (Pxx)); + xlabel ("frequency [Hz]"); + ylabel ("Power density [dB/Hz]"); + end + title ("Periodogram Power Spectral Density Estimate"); + end + pxx = Pxx; +endfunction + +/* +pi = %pi; // ezecute on scilab only + +t = 0:0.01:1; +x = sin(2*pi*10*t); +periodogram(x); + +x = complex(0:0.01:1, 0:0.01:1); +periodogram(x); + +x = cos(0:0.01:1); +win = hamming(101); +periodogram(x, win); + + + +x = tan(0:0.01:1); +nfft = 512; +periodogram(x, [], nfft); + + +t = 0:0.01:1; +x = sin(2*pi*10*t); +Fs = 100; +periodogram(x, [], [], Fs) + + + +x = sin(0:0.01:1); +periodogram(x, [], [], [], 'onesided'); + +x = sin(0:0.01:1); +periodogram(x, [], [], [], 'twosided') + + +Fs = 1000; +t = 0:1/Fs:1-1/Fs; +f0 = 100; +x = sin(2*pi*f0*t); +[Pxx, f] = periodogram(x, [], [], Fs); +[_, idx] = max(Pxx); +detected_freq = f(idx); + + +// Test error : invalid window length +x = randn(100,1); +win = hamming(50); +periodogram(x, win) + +// Test invalid nfft (negative) +periodogram(x, [], -256) + +*/ diff --git a/macros/polystab.sci b/macros/polystab.sci index 84e42d4..c9da6f0 100644 --- a/macros/polystab.sci +++ b/macros/polystab.sci @@ -1,21 +1,38 @@ -function b = polystab(a) -//This function stabilizes the polynomial transfer function. -//Calling Sequence -//b = polystab(a) -//Parameters -//a: -//Description -//This is an Octave function. -//This function stabilizes the polynomial transfer function by replacing all roots outside the unit circle with their reflection inside the unit circle. -//Examples +function y = polystab(x) +//Stabilize the polynomial transfer function. +//Calling Sequence: +//y = polystab(x) +//Parameters: +//x: real or complex valued vector +//Description: +//This function stabilizes the polynomial transfer function by replacing all +//roots outside the unit circle with their reflection inside the unit circle. +//Example: //polystab([1,3,5]) -//ans = -// 1. 0.6 0.2 +//ans= +//[1, 0.6, 0.2] + + funcprot(0); + if (argn(2) ~= 1) + error("polystab: wrong number of input arguments"); + end + root = roots(x); + vals = find(abs(root) > 1); + root(vals) = 1 ./ conj(root(vals)); + b = x(1) * poly(root, 'x'); + y = flipdim(coeff(b), 2); + if (isreal(x)) + y = real(y); + end -funcprot(0); -rhs = argn(2) -if(rhs~=1) -error("Wrong number of input arguments.") -end -b = callOctave("polystab",a) endfunction + +//input validation: +//assert_checkerror("polystab()", "polystab: wrong number of input arguments"); +//assert_checkerror("polystab(1, 2)", "Wrong number of input arguments.") + +//tests: +//assert_checkalmostequal(polystab([1, 3, 5]), [1, 0.6, 0.2], %eps); +//assert_checkequal(polystab([1; 3; 5]), polystab([1, 3, 5])); +//assert_checkalmostequal(polystab([1+3*%i, 4+2*%i, 2+2*%i]), [1 + 3*%i, 1.35664 + 1.84888*%i, 0.88566 + 0.88566*%i], 5*10^-5); +//assert_checkalmostequal(polystab([-1; 3+%i; -2-6*%i]), [-1, 0.3 + 0.4*%i, -0.05-0.15*%i], 5*10^-5); diff --git a/macros/postpad.sci b/macros/postpad.sci index f8042be..3797e08 100644 --- a/macros/postpad.sci +++ b/macros/postpad.sci @@ -1,49 +1,57 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt -// Author:Sonu Sharma, RGIT Mumbai +// Author: Abinash Singh Under FOSSEE Internship +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - -// This is a supporting function - -function y = postpad(x, n, varargin) - - //Calling Sequences - // Y = postpad (X, L) - // Y = postpad (X, L, C) - - // Description : - // Append the scalar value C to the vector X until it is of length L. - // If C is not given, a value of 0 is used. - // - // If 'length (X) > L', elements from the end of X are removed until a - // vector of length L is obtained. - - //Example : - //x = [1 2 3]; - //L = 6; - //y = postpad(x, L) - //Output : - // y = - // - // 1. 2. 3. 0. 0. 0. - - funcprot(0); - if argn(2) > 3 | argn(2) < 2 then - error("postpad : wrong number of input argument ") - elseif argn(2) == 2 +/* +Calling Sequence : + postpad (x, l) + postpad (x, l, c) + postpad (x, l, c, dim) +Append the scalar value c to the vector x until it is of length l. If c is not given, a value of 0 is used. +If length (x) > l, elements from the end of x are removed until a vector of length l is obtained. +If x is a matrix, elements are appended or removed from each row. +If the optional argument dim is given, operate along this dimension. +If dim is larger than the dimensions of x, the result will have dim dimensions. +*/ +function res = postpad(x,l,c,dim) + if nargin < 2 then + error("Usage : postpad(x,l,c(optional),dim(optional))") + end + if nargin < 3 then c = 0 ; - else - c = varargin(1); end - - y = x; - for i = 1:(n-length(x)) - y = [y c]; + if nargin <= 4 then + if size(x,1) == 1 then + dim = 1 ; + elseif size(x,2) == 1 then + dim = 2 ; + else + dim = 2 ; // FIXME dim functionality not implemented + end + end + if l < size(x,dim) then + error("l must be greater then dimension of x") + end + + select dim + case 1 then + res = [x c*ones(size(x,1),l-size(x,2))]; + case 2 then + res = [x;c*ones(l-size(x,1),size(x,2))]; end endfunction + +/* +#test for row vectors +postpad([1 2 3 4],6) //passed +postpad([1 ;2 ;3 ;4],6) // passed +postpad([1 2 3 4;5 6 7 8;9 10 11 12],6) // passed +postpad([1 2 ;3 4;5 6],6,-1) //passed +*/
\ No newline at end of file diff --git a/macros/prepad.sci b/macros/prepad.sci index 4e517f8..d3595bf 100644 --- a/macros/prepad.sci +++ b/macros/prepad.sci @@ -1,83 +1,65 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt -// Author:[insert name] +// Author: Abinash Singh Under FOSSEE Internship +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in +/* +Calling Sequence : + prepad (x, l) + prepad (x, l, c) + prepad (x, l, c, dim) - -function y = prepad (x, l, c, dim) -// Calling sequence: -// y= prepad (x, l) -// y= prepad (x, l, c) -// y= prepad (x, l, c, dim) -// Prepend the scalar value c to the vector x until it is of length -// l. If c is not given, a value of 0 is used. -// -// If length (x) > l, elements from the beginning of x -// are removed until a vector of length l is obtained. -// -// If x is a matrix, elements are prepended or removed from each row. -// -// If the optional argument dim is given, operate along this dimension. -// -// If dim is larger than the dimensions of x, the result will have -// dim dimensions. - -//Test cases: -//prepad ([1,2], 4,0,2) -//Output: [0,0,1,2] - - -[nargout,nargin]=argn(); - if (nargin < 2 | nargin > 4) - error("wrong number of input arguments"); - end - - if (nargin < 3 | isempty (c)) - c = 0; - else - if (~ isscalar (c)) - error ("prepad: pad value C must be empty or a scalar"); +Prepend the scalar value c to the vector x until it is of length l. If c is not given, a value of 0 is used. +If length (x) > l, elements from the beginning of x are removed until a vector of length l is obtained. +If x is a matrix, elements are prepended or removed from each row. +If the optional argument dim is given, operate along this dimension. +If dim is larger than the dimensions of x, the result will have dim dimensions. +*/ +function res = prepad(x,l,c,dim) + if nargin < 2 then + error("Usage : postpad(x,l,c(optional),dim(optional))") end - end -//dim=1; - nd = ndims (x); - sz = size (x); - if (argn(2) < 4) - // Find the first non-singleton dimension. - dim = find (sz > 1, 1) - if (dim == []) - dim = 1 + if nargin < 3 then + c = 0 ; end - else - if (~(isscalar (dim) & dim == fix (dim) & dim >= 1)) - error ("prepad: DIM must be an integer and a valid dimension"); + if nargin < 4 then + dim = find(size(x)>1) + if isempty(dim) then dim = 2 end + if isvector(dim) then dim = dim(1) end end - end - - if (~ isscalar (l) | l < 0) - error ("prepad: length L must be a positive scalar"); - end - if (dim > nd) - sz(nd+1:dim) = 1; - end - - d = sz(dim); + if l < size(x,dim) then + if isvector(x) then + start = length(x) - l+1; + res=x(start:$) + return; + else + error("prepad : l must be greter than dim size for matrices") + end + + end + + if dim == 1 then + res = [ c* ones( l - size(x,1) , size(x,2)) ; x] + elseif dim == 2 then + res = [ c* ones( size(x,1) , l - size(x,2)) x] + else + error("prepad : Invalid value for arg dim 1 or 2 expected") + end +endfunction - if (d >= l) -// idx = repmat ({':'}, nd, 1); -// idx(dim) = (d-l+1) : d; -// y = x(idx(:)); - y=x; - else - sz(dim) = l - d; - y = cat (dim, c(ones (sz(1),sz(2))), x); - end +/* +#test for row vectors +prepad([1 2 3 4],6) +prepad([1 ;2 ;3 ;4],6) +prepad([1 2 3 4;5 6 7 8;9 10 11 12],6) +prepad([1 2 ;3 4;5 6],6,-1) -endfunction +// FIXME : Tests for 2d and high dimesnsional matrices +*/ diff --git a/macros/residue.sci b/macros/residue.sci index 70dc91f..58303d8 100644 --- a/macros/residue.sci +++ b/macros/residue.sci @@ -1,286 +1,318 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt -// Author:[insert name] +// Original Source : https://octave.sourceforge.io/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Last Modified on : 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - - +// Dependencies +// prepad deconv mpoles function [r, p, k, e] = residue (b, a, varargin) - -// [r, p, k, e] = residue (b, a) -// [b, a] = residue (r, p, k) -// [b, a] = residue (r, p, k, e) -// The first calling form computes the partial fraction expansion for the -// quotient of the polynomials, b and a. -// -// The quotient is defined as - -// B(s) M r(m) N -// ---- = SUM ------------- + SUM k(i)*s^(N-i) -// A(s) m=1 (s-p(m))^e(m) i=1 - -// where M is the number of poles (the length of the r, p, -// and e), the k vector is a polynomial of order N-1 -// representing the direct contribution, and the e vector specifies the -// multiplicity of the m-th residue's pole. -// -//NOTE that the polynomials 'b' and 'a' should have real coefficients(because of the function 'filter' used in polyval) -// -//Test case -//1. -// b = [1, 1, 1]; -// a = [1, -5, 8, -4]; -// [r, p, k, e] = residue (b, a) -// result r = [-2; 7; 3] -// result p = [2; 2; 1] -// result k = [](0x0) -// result e = [1; 2; 1] -// - -//2. -//[r,p,k,e]=residue([1 2 1],[1 -5 8 -4]) -//OUTPUT -//r = -// -3.0000 -// 9.0000 -// 4.0000 -// -//p = -// 2.0000 -// 2.0000 -// 1.0000 -// -//f = [](0x0) -//e = -// 1 -// 2 -// 1 -// - - - [nargout,nargin]=argn(); - - if (nargin < 2 | nargin > 4) - error ("wrong umber of input arguments"); - end - - toler = .001; - - if (nargin >= 3) - if (nargin >= 4) - e = varargin(2); - else - e = []; + if (nargin < 2 || nargin > 4) + error("residue: Invalid number of arguments"); end - // The inputs are the residue, pole, and direct part. Solve for the - // corresponding numerator and denominator polynomials - [r, p] = rresidue (b, a, varargin(1), toler, e); - return; - end - - // Make sure both polynomials are in reduced form. - - a = polyreduce (a); - b = polyreduce (b); - - b = b / a(1); - a = a / a(1); - - la = length (a); - lb = length (b); - - // Handle special cases here. - - if (la == 0 | lb == 0) - k =[]; - r = []; - p = []; - e = []; - return; - elseif (la == 1) - k = b / a; - r = []; - p = []; - e = []; - return; - end - - // Find the poles. - - p = roots (a); - lp = length (p); - - // Sort poles so that multiplicity loop will work. - - [e, indx] = mpoles (p, toler, 0); - p = p(indx); - - // For each group of pole multiplicity, set the value of each - // pole to the average of the group. This reduces the error in - // the resulting poles. - - p_group = cumsum (e == 1); - for ng = 1:p_group($) - m = find (p_group == ng); - p(m) = mean (p(m)); - end - - // Find the direct term if there is one. - - if (lb >= la) - // Also return the reduced numerator. - [k, b] = deconv (b, a); + + tol = .001; + + if (nargin >= 3) + if (nargin >= 4) + e = varargin(2); + else + e = []; + end + // The inputs are the residue2, pole, and direct part. + // Solve for the corresponding numerator and denominator polynomials. + [r, p] = rresidue (b, a, varargin(1), tol, e); + return; + end + + // Make sure both polynomials are in reduced form, and scaled. + a = polyreduce (a); + b = polyreduce (b); + + b = b / a(1); + a = a/ a(1); + + la = length (a); lb = length (b); - else - k = []; - end - - // Determine if the poles are (effectively) zero. - - small = max (abs (p)); - if (type(a)==1 | type(b)==1) - small = max ([small, 1]) * 1.1921e-07 * 1e4 * (1 + length (p))^2; - else - small = max ([small, 1]) * %eps * 1e4 * (1 + length (p))^2; - end - p(abs (p) < small) = 0; - - // Determine if the poles are (effectively) real, or imaginary. - - index = (abs (imag (p)) < small); - p(index) = real (p(index)); - index = (abs (real (p)) < small); - p(index) = 1*%i * imag (p(index)); - - // The remainder determines the residues. The case of one pole - // is trivial. - - if (lp == 1) - r = polyval (b, p); - return; - end - - // Determine the order of the denominator and remaining numerator. - // With the direct term removed the potential order of the numerator - // is one less than the order of the denominator. - - aorder = length (a) - 1; - border = aorder - 1; - - // Construct a system of equations relating the individual - // contributions from each residue to the complete numerator. - - A = zeros (border+1, border+1); - B = prepad (matrix (b, [length(b), 1]), border+1, 0,2); - for ip = 1:length (p) - ri = zeros (size (p,1),size(p,2)); - ri(ip) = 1; - A(:,ip) = prepad (rresidue (ri, p, [], toler), border+1, 0,2).'; - end - - // Solve for the residues. -if(size(A,1)~=size(B,1)) - if(size(A,1)<size(B,1)) - A=[A;zeros((size(B,1)-size(A,1)),(size(A,2)))]; + + // Handle special cases here. + if (la == 0 || lb == 0) + k = []; + r = []; + p = []; + e = []; + return; + elseif (la == 1) + k = b / a; + r = [] + p = [] + e = []; + return; + end + + // Find the poles. + p = roots (a); + lp = length (p); + + // Sort poles so that multiplicity loop will work. + [e, idx] = mpoles (p, tol, 1); + p = p(idx); + + // For each group of pole multiplicity, set the value of each + // pole to the average of the group. This reduces the error in + // the resulting poles. + p_group = cumsum (e == 1); + for ng = 1:p_group($) + m = find (p_group == ng); + p(m) = mean (p(m)); + end + + // Find the direct term if there is one. + if (lb >= la) + // Also return the reduced numerator. + [k, b] = deconv (b, a); + lb = length (b); else - B=[zeros((size(A,1)-size(B,1)),(size(B,2)));B]; + k = []; end - + + // Determine if the poles are (effectively) zero. + small = max (abs (p)); + if ( (type(a)==1) || (type(b)==1)) + small = max ([small, 1]) * %eps * 1e4 * (1 + length (p))^2; + else + small = max ([small, 1]) * %eps * 1e4 * (1 + length (p))^2; end - r = A \ B; - r=r(:,$); - -endfunction - -function [pnum, pden, e] = rresidue (rm, p, k, toler, e) - - // Reconstitute the numerator and denominator polynomials from the - // residues, poles, and direct term. -[nargout,nargin]=argn(); - if (nargin < 2 | nargin > 5) - error ("wrong number of input arguments"); - end - - if (nargin < 5) - e = []; - end - - if (nargin < 4) - toler = []; - end - - if (nargin < 3) - k = []; - end - - if (length (e)) - indx = 1:length (p); - else - [e, indx] = mpoles (p, toler, 0); - p = p(indx); - rm = rm(indx); - end - - indx = 1:length (p); - - for n = indx - pn = [1, -p(n)]; - if (n == 1) - pden = pn; + p(abs (p) < small) = 0; + + // Determine if the poles are (effectively) real, or imaginary. + idx = (abs (imag (p)) < small); + p(idx) = real (p(idx)); + idx = (abs (real (p)) < small); + p(idx) = 1*%i * imag (p(idx)); + + // The remainder determines the residue2s. The case of one pole is trivial. + if (lp == 1) + r = polyval (b, p); + return; + end + + // Determine the order of the denominator and remaining numerator. + // With the direct term removed, the potential order of the numerator + // is one less than the order of the denominator. + aorder = length (a) - 1; + border = aorder - 1; + + // Construct a system of equations relating the individual + // contributions from each residue2 to the complete numerator. + A = zeros (border+1, border+1); + + B = prepad (matrix (b, [length(b), 1]), border+1, 0); + B = B(:); // incase b have only 1 element + for ip = 1:length (p) + ri = zeros (size (p,1),size(p,2)); + ri(ip) = 1; + // A(:,ip) = prepad (rresidue (ri, p, [], tol), border+1, 0).';// invalid index error + temprr=rresidue (ri, p, [], tol) + ppr=prepad(temprr,border+1,0) + A(:,ip) = ppr + end + + // Solve for the residue2s. + // FIXME: Use a pre-conditioner d to make A \ B work better (bug #53869). + // It would be better to construct A and B so they are not close to + // singular in the first place. + d = max (abs (A),'c'); + + r = (diag (d) \ A) \ (B ./ d); + + endfunction + + // Reconstitute the numerator and denominator polynomials + // from the residue2s, poles, and direct term. + function [pnum, pden, e] = rresidue (r, p, k, tol, e ) + + if nargin < 3 then k = [] ; end + if nargin < 4 then tol = [] ; end + if nargin < 5 then e = [] ; end + if (~isempty (e)) + idx = 1:length (p); else - pden = conv (pden, pn); + [e, idx] = mpoles (p, tol, 0); + p = p(idx); + r = r(idx); end - end - - // D is the order of the denominator - // K is the order of the direct polynomial - // N is the order of the resulting numerator - // pnum(1:(N+1)) is the numerator's polynomial - // pden(1:(D+1)) is the denominator's polynomial - // pm is the multible pole for the nth residue - // pn is the numerator contribution for the nth residue - - D = length (pden) - 1; - K = length (k) - 1; - N = K + D; - pnum = zeros (1, N+1); - for n = indx(abs (rm) > 0) - p1 = [1, -p(n)]; - for m = 1:e(n) - if (m == 1) - pm = p1; + + idx = 1:length (p); + for n = idx + pn = [1, -p(n)]; + if (n == 1) + pden = pn; else - pm = conv (pm, p1); + pden = conv (pden, pn); end end - pn = deconv (real(pden),real(pm)); - pn = rm(n) * pn; - pnum = pnum + prepad (real(pn), N+1, 0, 2); - end - - // Add the direct term. - - if (length (k)) - pnum = pnum + conv (pden, k); - end - - // Check for leading zeros and trim the polynomial coefficients. - if (type(rm)==1 | type(p)==1 | type(k)==1) - small = max ([max(abs(pden)), max(abs(pnum)), 1]) * 1.1921e-07; - else - small = max ([max(abs(pden)), max(abs(pnum)), 1]) *%eps; - end - - pnum(abs (pnum) < small) = 0; - pden(abs (pden) < small) = 0; - - pnum = polyreduce (pnum); - pden = polyreduce (pden); - + + // D is the order of the denominator + // K is the order of the direct polynomial + // N is the order of the resulting numerator + // pnum(1:(N+1)) is the numerator's polynomial + // pden(1:(D+1)) is the denominator's polynomial + // pm is the multiple pole for the nth residue2 + // pn is the numerator contribution for the nth residue2 + + D = length (pden) - 1; + K = length (k) - 1; + N = K + D; + pnum = zeros (1, N+1); + for n = idx(abs (r) > 0) + p1 = [1, -p(n)]; + pn = 1; + for j = 1:n - 1 + pn = conv (pn, [1, -p(j)]); + end + for j = n + 1:length (p) + pn = conv (pn, [1, -p(j)]); + end + for j = 1:e(n) - 1 + pn = deconv (pn, p1); + end + pn = r(n) * pn; + pnum = pnum + prepad (pn, N+1, 0, 2); + end + + // Add the direct term. + if (length (k)) + pnum = pnum + conv (pden, k); + end + + pnum = polyreduce (pnum); + pden = polyreduce (pden); + + endfunction + +function y = polyreduce(p) + // Remove leading zeros from the polynomial + idx = find(p, 1) + if isempty(idx) then + y = 0; + else + y = p(idx(1):$); + end endfunction +/* +//test passed + b = [1, 1, 1]; + a = [1, -5, 8, -4]; + [r, p, k, e] = residue (b, a); + assert_checkalmostequal (r, [-2; 7; 3], 1e-12); + assert_checkalmostequal (p, [2; 2; 1], 1e-12); + assert_checkalmostequal (k,[]); + assert_checkalmostequal (e, [1; 2; 1]); + k = [1 0]; + b = conv (k, a) + prepad (b, length (k) + length (a) - 1, 0); + a = a; + [br, ar] = residue (r, p, k); + assert_checkalmostequal (br, b,1e-12); + assert_checkalmostequal (ar, a,1e-12); + [br, ar] = residue (r, p, k, e); + assert_checkalmostequal (br, b,1e-12); + assert_checkalmostequal (ar, a,1e-12); + +//test passed + b = [1, 0, 1]; + a = [1, 0, 18, 0, 81]; + [r, p, k, e] = residue (b, a); // error filter: Wrong type for input argument #1: Real matrix or polynomial expect + FIXME : builtin filter doesn't support complex paramters + r1 = [-5*%i; 12; +5*%i; 12]/54; + p1 = [+3*%i; +3*%i; -3*%i; -3*%i]; + assert_checkalmostequal (r, r1, 1e-12); + assert_checkalmostequal (p, p1, 1e-12); + assert_checkalmostequal (k,[]); + assert_checkalmostequal (e, [1; 2; 1; 2]); + [br, ar] = residue (r, p, k); + assert_checkalmostequal (br, b, 1e-12); + assert_checkalmostequal (ar, a, 1e-12); + +//test passed + r = [7; 3; -2]; + p = [2; 1; 2]; + k = [1 0]; + e = [2; 1; 1]; + [b, a] = residue (r, p, k, e); + assert_checkalmostequal (b, [1, -5, 9, -3, 1], 1e-12); + assert_checkalmostequal (a, [1, -5, 8, -4], 1e-12); + + + [rr, pr, kr, er] = residue (b, a); + [_, m] = mpoles (rr); + [_, n] = mpoles (r); + assert_checkalmostequal (rr(m), r(n), 1e-12); + assert_checkalmostequal (pr(m), p(n), 1e-12); + assert_checkalmostequal (kr, k, 1e-12); + assert_checkalmostequal (er(m), e(n), 1e-12); + +//test passed + b = [1]; + a = [1, 10, 25]; + [r, p, k, e] = residue (b, a); + r1 = [0; 1]; + p1 = [-5; -5]; + assert_checkalmostequal (r, r1, 1e-12); + assert_checkalmostequal (p, p1, 1e-12); + assert_checkalmostequal (k,[]); + assert_checkalmostequal (e, [1; 2]); + [br, ar] = residue (r, p, k); + assert_checkalmostequal (br, b, 1e-12); + assert_checkalmostequal (ar, a, 1e-12); + +// The following //test is due to Bernard Grung +//test <*34266> passed + z1 = 7.0372976777e6; + p1 = -3.1415926536e9; + p2 = -4.9964813512e8; + r1 = -(1 + z1/p1)/(1 - p1/p2)/p2/p1; + r2 = -(1 + z1/p2)/(1 - p2/p1)/p2/p1; + r3 = (1 + (p2 + p1)/p2/p1*z1)/p2/p1; + r4 = z1/p2/p1; + r = [r1; r2; r3; r4]; + p = [p1; p2; 0; 0]; + k = []; + e = [1; 1; 1; 2]; + b = [1, z1]; + a = [1, -(p1 + p2), p1*p2, 0, 0]; + [br, ar] = residue (r, p, k, e); + assert_checkalmostequal (br, [0,0,b],%eps,1e-8); + assert_checkalmostequal (ar, a, %eps,1e-8); + +//test <*49291> passed + rf = [1e3, 2e3, 1e3, 2e3]; + cf = [316.2e-9, 50e-9, 31.6e-9, 5e-9]; + [num, den] = residue (1./cf,-1./(rf.*cf),0); + assert_checkalmostequal (length (num), 4); + assert_checkalmostequal (length (den), 5); + assert_checkalmostequal (den(1), 1); + +//test <*51148> passed + r = [1.0000e+18, 3.5714e+12, 2.2222e+11, 2.1739e+10]; + pin = [-1.9231e+15, -1.6234e+09, -4.1152e+07, -1.8116e+06]; + k = 0; + [p, q] = residue (r, pin, k); + assert_checkalmostequal (p(4), 4.6828e+42, 1e-5); + +//test <*60384> passed + B = [1315.789473684211]; + A = [1, 1.100000536842105e+04, 1.703789473684211e+03, 0]; + poles1 = roots (A); + [r, p, k, e] = residue (B, A); + [B1, A1] = residue (r, p, k, e); + assert_checkalmostequal (B, B1); + assert_checkalmostequal (A, A1); + +%/ diff --git a/macros/schtrig.sci b/macros/schtrig.sci index 90286e2..f50adca 100644 --- a/macros/schtrig.sci +++ b/macros/schtrig.sci @@ -1,30 +1,127 @@ -function v = schtrig (x, lev, rs) -//This function implements a multisignal Schmitt triggers with lev levels supplied as input. -//Calling Sequence -//v = schtrig (x, lev) -//v = schtrig (x, lev, rs) -//Parameters -//x: vector or matrix of real numbers -//lev: real number -//rs: default value 1 -//Description -//This is an Octave function. -//This function implements a multisignal Schmitt triggers with lev levels supplied as input. -//The argument 1 is a matrix (or a vector) and this trigger works along its first dimension. -//Examples -//schtrig([0.2,-3,5],-4) -//ans = -// 0. 0. 1. - -funcprot(0); -rhs = argn(2) -if(rhs<2 | rhs>3) -error("Wrong number of input arguments.") -end -if(rhs==2) -v = callOctave("schtrig", x, lev) -elseif(rhs==3) -v = callOctave("schtrig",x, lev, rs) -end +function [v, rg] = schtrig (x, lvl, rst) +//This function implements a multisignal Schmitt triggers with 'lvl' levels supplied as input. +//Calling Sequence: +//x = schtrig(x, lvl) +//lvl = schtrig(x, lvl, rst) +//Parameters: +//x: Vector or matrix of real numbers +//lvl: Real number +//rst: Boolean, default value is 'true' +//Description: +//This function implements a multisignal Schmitt triggers with 'lvl' levels supplied as input. +//The argument 1 is a matrix (or a vector) and this trigger works along its first dimension. +//Examples: +//schtrig([0.2,-3,5], -4) +//ans = [0, 0, 1] + + funcprot(0); + warning('off'); + if (argn(2) < 2 | argn(2) > 3) + error("Wrong number of input arguments."); + elseif (argn(2) == 2) + rst = %T; + end + if (length (ndims (x)) > 2) + error ('The input should be two dimensional.'); + end + if (length (ndims (lvl)) > 2) + error ('Only a maximum of two threshold levels accepted.'); + end + + [nT nc] = size (x); + + global st0; + if (rst || isempty (st0)) + st0 = zeros (1,nc); + end + + if (length(lvl) == 1) + lvl = abs (lvl) .* [1 -1]; + else + lvl = gsort(lvl, 'g', 'd'); + end + + v = repmat(%nan, nT, nc); + v(1,:) = st0; + + up = x > lvl(1); + v(up) = 1; + + dw = x < lvl(2); + v(dw) = 0; + + idx = bool2s(isnan(v)); + xhi = idx'; + bool_discon = diff (xhi, 1, 2); + [Np Na] = size (xhi); + ranges = cell (1, Np); + + for i = 1:Np + idxUp = find (bool_discon(i,:) > 0) + 1; + idxDwn = find (bool_discon(i,:) < 0); + tLen = length (idxUp) + length (idxDwn); + + if (xhi(i,1) == 1) + ranges{i}(1) = 1; + ranges{i}(2:2:tLen+1) = idxDwn; + ranges{i}(3:2:tLen+1) = idxUp; + else + ranges{i}(1:2:tLen) = idxUp; + ranges{i}(2:2:tLen) = idxDwn; + end + + if (xhi(i, $) == 1) + ranges{i}($+1) = Na; + end + + tLen = length(ranges{i}); + if (tLen ~= 0) + ranges{i} = matrix(ranges{i}, 2, tLen / 2); + end + + end + + if (Np == 1) + ranges = cell2mat(ranges); + end + if (nc == 1) + ranges = {ranges}; + end + + for i=1:nc + if (~isempty(ranges{i})) + prev = ranges{i}(1,:)-1; + prev(prev<1) = 1; + st0 = v(prev, i); + ini_idx = ranges{i}(1,:); + end_idx = ranges{i}(2,:); + for j =1:length(ini_idx) + v(ini_idx(j):end_idx(j),i) = st0(j); + end + end + end + + st0 = v($, :); endfunction + +//input validation: +//assert_checkerror("schtrig(1)", "Wrong number of input arguments."); +//assert_checkerror("schtrig(1, 2, 3, 4)", "Wrong number of input arguments."); + +//tests: +//assert_checkequal(schtrig(ones(128, 1), -1), zeros(128, 1)); +//assert_checkequal(schtrig(ones(128, 1), -1), schtrig(ones(128, 1), -1, %F)); +// +//assert_checkequal(schtrig([1 5 1], 3), schtrig([1 5 1], 3, %T)); +//assert_checkequal(schtrig([1 5 1], 3), [0 1 0]); +//assert_checkequal(schtrig([1 5 1], 3, %F), schtrig([1 5 1], 3)); +// +//assert_checkequal(schtrig([-3; 4; -1], -2), [0; 1; 1]); +//assert_checkequal(schtrig([-3; 4; -1], -2, %F), schtrig([-3; 4; -1], -2)); +// +//assert_checkequal(schtrig([1 -3; 2 4; 5 -1], -2), [0 0; 0 1; 1 1]); +//assert_checkequal(schtrig([1 -3; 2 4; 5 -1], -2, %F), [1 0; 1 1; 1 1]); +// +//assert_checkequal(schtrig([1.1 1.5 0; 0.53 1.21 3.57; 5.34 -1.24 0], 0.424), [1 1 0;1 1 1;1 0 1]); +//assert_checkequal(schtrig([1.1 1.5 0; 0.53 -1.21 3.57; 5.34 -1.24 0], 0.424, %F), [1 1 1;1 0 1;1 0 1]); diff --git a/macros/sftrans.sci b/macros/sftrans.sci index 2dfd2bb..f0c092e 100644 --- a/macros/sftrans.sci +++ b/macros/sftrans.sci @@ -1,15 +1,14 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt // Original Source : https://octave.sourceforge.io/signal/ -// Modifieded by:Sonu Sharma, RGIT Mumbai +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - function [Sz, Sp, Sg] = sftrans (Sz, Sp, Sg, W, stop) //Transform band edges of a prototype filter (cutoff at W=1) represented in s-plane zero-pole-gain form (Frequency Transformation in Analog domain). @@ -71,7 +70,8 @@ function [Sz, Sp, Sg] = sftrans (Sz, Sp, Sg, W, stop) // Sz = // // 20. 10. 6.6666667 - + // dependencies + // funcprot(0); [nargout nargin]= argn(); @@ -115,12 +115,12 @@ function [Sz, Sp, Sg] = sftrans (Sz, Sp, Sg, W, stop) Sp = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)]; extend = [sqrt(-Fh*Fl), -sqrt(-Fh*Fl)]; if isempty(Sz) - Sz = [extend(1+rem([1:2*p],2))]; + Sz = [extend(1+modulo([1:2*p],2))]; else b = (C*(Fh-Fl)/2)./Sz; Sz = [b+sqrt(b.^2-Fh*Fl), b-sqrt(b.^2-Fh*Fl)]; if (p > z) - Sz = [Sz, extend(1+rem([1:2*(p-z)],2))]; + Sz = [Sz, extend(1+modulo([1:2*(p-z)],2))]; end end else @@ -178,3 +178,13 @@ function [Sz, Sp, Sg] = sftrans (Sz, Sp, Sg, W, stop) end end endfunction +/** +Note : This function is tested with Octave's outputs as a reference. + +[Sz_new , Sp_new , Sg_new ] = sftrans([0.5;-0.5],[0.3 ; -0.3],2,0.5,0) // passed +[Sz_new , Sp_new , Sg_new ] = sftrans([0.5;-0.5],[0.3 ; -0.3],2,0.5,1) // passed +[Sz_new, Sp_new, Sg_new] = sftrans([0.5], [0.3], 1, [1.0, 2.0], 0) //passed +[Sz_new, Sp_new, Sg_new] = sftrans([0.5], [0.3], 1, [1.0, 2.0], 1) //passed +[Sz_new, Sp_new, Sg_new] = sftrans([], [], 1, 1.0, 0) //error passed +[Sz_new, Sp_new, Sg_new] = sftrans([0], [], 1, 1.0, 0)//error passed +*/
\ No newline at end of file diff --git a/macros/sinetone.sci b/macros/sinetone.sci index 407fa45..f174869 100644 --- a/macros/sinetone.sci +++ b/macros/sinetone.sci @@ -1,32 +1,66 @@ -function y= sinetone(x, varargin) +function y = sinetone(freq, rate, sec, ampl) //Return a sinetone of the input -//Calling Sequence -//y= sinetone(FREQ) -//y= sinetone(FREQ, RATE) -//y= sinetone(FREQ, RATE, SEC) -//y= sinetone(FREQ, RATE, SEC, AMPL) -//Parameters -//FREQ: frequency of sinetone -//RATE: Sampling rate -//SEC: Length in seconds -//AMPL: Amplitude -//Description -//Return a sinetone of frequency FREQ with a length of SEC seconds atsampling rate RATE and with amplitude AMPL.The arguments FREQ and AMPL may be vectors of common size.The defaults are RATE = 8000, SEC = 1, and AMPL = 64. -funcprot(0); -rhs= argn(2); -if(rhs<1 | rhs>4) -error("Wrong number of input arguments") -end - -select(rhs) - case 1 then - y= callOctave("sinetone", x); - case 2 then - y= callOctave("sinetone", x , varargin(1)); - case 3 then - y= callOctave("sinetone", x , varargin(1), varargin(2)); - case 4 then - y= callOctave("sinetone", x , varargin(1), varargin(2), varargin(3)); - -end +//Calling Sequence: +//y= sinetone(freq) +//y= sinetone(freq, rate) +//y= sinetone(freq, rate, sec) +//y= sinetone(freq, rate, sec, ampl) +//Parameters: +//freq: frequency of sinetone +//rate: sampling rate +//sec: length in seconds +//ampl: amplitude +//Description: +//Return a sinetone of frequency 'freq' with a length of 'sec' seconds at sampling rate 'rate' and with amplitude 'ampl'. +//The arguments freq and ampl may be vectors of common size. The defaults are rate = 8000, sec = 1, and ampl = 64. +//Examples: +//sinetone(5, 2, 1, 8) +//ans = [4.89E-15; -9.79E-15] + + funcprot(0); + rhs= argn(2); + + select rhs + case 1 then + rate = 8000; + sec = 1; + ampl = 64; + case 2 then + sec = 1; + ampl = 64; + case 3 then + ampl = 64; + case 4 then + break; + else + error("sinetone: wrong number of input arguments"); + end + + if ( isvector(freq) & isvector(ampl) & ~isequal(size(freq), size(ampl)) ) then + error("sinetone: freq and ampl must be vectors of equal size"); + end + + if ( ~(isscalar(rate) && isscalar(sec)) ) then + error("sinetone: rate and sec must be scalars"); + end + + n = length (freq); + ns = round (rate * sec); + y = zeros (ns, n); + + for k = 1:n + y(:, k) = ampl(k) * sin (2 * %pi * (1:ns) / rate * freq(k))'; + end + endfunction + +//input validation: +//assert_checkerror("sinetone()", "sinetone: wrong number of input arguments"); +//assert_checkerror("sinetone([6, 9, 4, 2], 2, 3, [6, 2, 0])", "sinetone: freq and ampl must be vectors of equal size"); +//assert_checkerror("sinetone(1, [1, 2])", "sinetone: rate and sec must be scalars"); +//assert_checkerror("sinetone(1, 2, [4, 3])", "sinetone: rate and sec must be scalars"); + +//tests: +//assert_checkequal(size(sinetone(18e6, 150e6, 19550/150e6, 1)), [19550, 1]); +//assert_checkequal(sinetone(5), sinetone(5, 8000, 1, 64)); +//assert_checkequal(size(sinetone([1, 2, 3], 4000, 1, [8, 9, 6])), [4000, 3]); diff --git a/macros/sinewave.sci b/macros/sinewave.sci index 5263f35..31ee6b0 100644 --- a/macros/sinewave.sci +++ b/macros/sinewave.sci @@ -1,29 +1,57 @@ -function y= sinewave(x, varargin) -//Return an M-element vector with I-th element given by 'sin(2* pi *(I+D-1)/N).' -//Calling Sequence -//y= sinewave(M) -//y= sinewave(M,N) -//y= sinewave(M,N,D) -//Parameters -//M: Input vector -//N: The default value for N is M -//D: The default value for D is 0 -//AMPL: Amplitude -//Description -//Return an M-element vector with I-th element given by 'sin(2* pi *(I+D-1)/N).' -funcprot(0); -rhs= argn(2); -if(rhs<1 | rhs>3) -error("Wrong number of input arguments") -end - -select(rhs) - case 1 then - y= callOctave("sinewave", x); - case 2 then - y= callOctave("sinewave", x , varargin(1)); - case 3 then - y= callOctave("sinewave", x , varargin(1), varargin(2)); - -end +function y = sinewave (m, n, d) +//Return a m-element vector with the i-th element given by {sin (2 * pi * (i+d-1) / n}. +//Calling Sequence: +//y= sinewave(m) +//y= sinewave(m,n) +//y= sinewave(m,n,d) +//Parameters: +//m: Real positive scalar +//n: The value of n in the formula {sin (2 * pi * (i+d-1) / n}. The default value for n is m. +//d: The value of d in the formula {sin (2 * pi * (i+d-1) / n}. The default value for d is 0. +//Examples: +//sinewave(1, 4, 1) +//ans = 1 + + funcprot(0); + rhs = argn(2); + if (rhs < 1 | rhs > 3) then + error("sinewave: wrong number of input arguments"); + end + + if (m < 0) then + error("sinewave: arg1 (m) must be non-negative"); + end + + if (rhs < 2) then + n = m; + end + if (n == 0) then + error("sinewave: arg2 (n) must be non-zero"); + end + + if (~isscalar(m)) then + error("sinewave: arg1 (m) must be a real scalar"); + end + + if (rhs < 3) then + d = 0; + end + + y = sin(((1 : m) + d - 1) * 2 * %pi / n); + endfunction + +//input validation: +//assert_checkerror("sinewave()", "sinewave: wrong number of input arguments"); +//assert_checkerror("sinewave(-1, 2)", "sinewave: arg1 (m) must be non-negative"); +//assert_checkerror("sinewave([-2, 5, -3], 2)", "sinewave: arg1 (m) must be a real scalar"); +//assert_checkerror("sinewave(0, 0, 5)", "sinewave: arg2 (n) must be non-zero"); + +//tests: +//assert_checkequal(sinewave(1), 0); +//assert_checkequal(sinewave(1), sinewave(1, 1, 0)); +//assert_checkequal(sinewave(3, 4), sinewave(3, 4, 0)); +//assert_checkalmostequal(sinewave(1, 12, 1), 1/2, %eps); +//assert_checkalmostequal(sinewave(1, 20, 1), (sqrt(5)-1)/4, %eps); +//assert_checkequal(sinewave(3, 4, 1), [1, sin(%pi), -1]); +//assert_checkalmostequal(sinewave(4, 12, 1), [1/2, sqrt(3)/2, 1, sqrt(3)/2], %eps); diff --git a/macros/sos2cell.sci b/macros/sos2cell.sci index be40667..0434c6e 100644 --- a/macros/sos2cell.sci +++ b/macros/sos2cell.sci @@ -1,93 +1,69 @@ -function c = sos2cell(s,g) -//Converts a second order section matrix to a cell array -//Calling Sequences -//c=sos2cell(s) -//c=sos2cell(s,g) -//Parameters -//s -//An L-by-6 matrix where L is the number of sections -//g -//The scalar gain -//Description -//c=sos2cell(s) converts an L-by-6 second-order-section matrix s given by: -// s = [B1 A1 -// B2 A2 -// ... -// BL AL] -//to a cell array c = { {B1},{A1}, {B2},{A2}, ... {BL},{AL}} where each -//numerator vector Bi and denominator vector Ai contains the coefficients of a -//linear or quadratic polynomial. If the polynomial is linear, the coefficients -//zero-padded on the right -//c=sos2cell(s,g) adds a leading gain term to the start of the cell array as: -//c={ {[g,1]},{B1},{A1}, {B2},{A2}, ... {BL},{AL}} -//Example -//s=rand(2,6) -// s = -// -// -// column 1 to 5 -// -// 0.0437334 0.2639556 0.2806498 0.7783129 0.1121355 -// 0.4818509 0.4148104 0.1280058 0.2119030 0.6856896 -// -// column 6 -// -// 0.1531217 -// 0.6970851 -// -//sos2cell(s,2) -// ans = -// -// -// -// column 1 to 3 -// -//![2,1] [0.0437334,0.2639556,0.2806498] [0.7783129,0.1121355,0.1531217] ! -// -// column 4 to 5 -// -//![0.4818509,0.4148104,0.1280058] [0.2119030,0.6856896,0.6970851] ! -//Author -//Ankur Mallick - if(argn(2)<2) - g=[]; +// Copyright (C) 2018 - IIT Bombay - FOSSEE +// This file must be used under the terms of the CeCILL. +// This source file is licensed as described in the file COPYING, which +// you should have received as part of this distribution. The terms +// are also available at +// http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt +// Author: Abinash Singh Under FOSSEE Internship +// Organization: FOSSEE, IIT Bombay +// Email: toolbox@scilab.in +/* +Calling Sequence : + cll = sos2cell(s) + cll = sos2cell(s, g) +Description + sos2cell converts a second-order section matrix to a cell array representation. + The function can handle both unity-gain and non-unity gain filter systems. For non-unity gain systems, the gain factor is stored in the first cell of the output array. +Input Arguments + s - Second-order section matrix (L-by-6 matrix) + Each row represents one second-order section + Must have exactly 6 columns in format: [b0 b1 b2 a0 a1 a2] + Number of rows (L) represents the number of sections + g - Gain factor (optional) + Scalar value representing the system gain + Default value is 1 if not specified +Output Arguments + cll - Cell array containing second-order sections + For unity-gain systems (no gain specified): + Cell array with L elements + Each element contains coefficients: {[b0 b1 b2] [a0 a1 a2]} + For non-unity gain systems: + Cell array with L+1 elements + First element contains gain: {g 1} + Remaining elements contain section coefficients +*/ +function cll = sos2cell(s, g) + if (argn(2) > 2) then + error("sos2cell: Wrong number of input arguments"); + end + gain_inc = 1 ; + if nargin < 2 then + g = 1 ; + gain_inc = 0; + end + [L, n] = size(s); + if n ~= 6 then + error("sos2cell: Input matrix must have 6 columns"); end - if g==1 - g=[]; + if gain_inc then + L = L + 1 ; end - if(~or(type(s)==[1 5 8])|ndims(s)~=2|size(s,2)~=6) - error('Invalid Entry'); + cll = cell(1,L); + start_index=1 + if gain_inc then + cll{1} = { g 1}; + start_index = 2 ; end - L=size(s,1); - if ((L==1)&(~isempty(g))&(s==[1, 0, 0, 1, 0, 0])) - s=g*s; - g=[]; - end - c=cell(1,2*L); - k=0; - if(~isempty(g)) - c=cell(1,2*L+1); - c(1,1).entries=[g, 1]; - k=1; - end - for i=1:2:2*L - j=ceil(i/2); - sa=s(j,1:3); - ma=max(find(sa~=0)); - sb=s(j,4:6); - mb=max(find(sb~=0)); - cs=cell(1,2); - if(~isempty(ma)) - cs(1,1).entries=sa(1:ma); - else - cs(1,1).entries=[]; - end - if(~isempty(mb)) - cs(1,2).entries=sb(1:mb); - else - cs(1,2).entries=[]; - end - c(k+i)=cs(1,1); - c(k+i+1)=cs(1,2); + for i=start_index:L + cll{i}={s(i+1-start_index,1:3) s(i+1-start_index,4:6)} end endfunction +/* +sos = [3. 6. 7. 1. 1. 2. ; 1. 4. 5. 1. 9. 3. ; 2. 7. 1. 1. 7. 8.]; +cll = sos2cell(sos); // passed + +sos = [3. 6. 7. 1. 1. 2. ; 1. 4. 5. 1. 9. 3. ; 2. 7. 1. 1. 7. 8.]; +g = 0.5 ; +cll = sos2cell(sos,g); // passed + +*/
\ No newline at end of file diff --git a/macros/spencer.sci b/macros/spencer.sci index 63a1b83..1b0f377 100644 --- a/macros/spencer.sci +++ b/macros/spencer.sci @@ -1,21 +1,37 @@ -function y= spencer(x) -//Return Spencer's 15 point moving average of each column of X. -//Calling Sequence -//spencer(X) -//Parameters -//X: Real scalar or vector -//Description -//Return Spencer's 15 point moving average of each column of X. -funcprot(0); +function savg = spencer (x) +//Returns Spencer's 15 point moving average of each column of x. +//Calling Sequence: +//spencer(x) +//Parameters: +//X: Real vector or matrix +//Description: +//Returns Spencer's 15 point moving average of each column of x. -rhs= argn(2); + funcprot(0); + if (nargin() ~= 1) + error("Wrong number of input arguments."); + end + [xr, xc] = size (x); -if(rhs <1 | rhs >1) -error("Wrong number of input arguments"); -end + n = xr; + c = xc; + + if (isvector (x)) + n = length (x); + c = 1; + x = matrix(x, n, 1); + end + + end + w = [-3, -6, -5, 3, 21, 46, 67, 74, 67, 46, 21, 3, -5, -6, -3] / 320; + savg = filter (w, 1, x); + savg = [zeros(7,c); savg(15:n,:); zeros(7,c);]; + savg = matrix(savg, xr, xc); -select(rhs) - case 1 then - y = callOctave("spencer",x); -end endfunction + +//tests: +//assert_checkerror("spencer()", "Wrong number of input arguments."); +//assert_checkerror("spencer(1, 2)", "Wrong number of input arguments."); +//assert_checkequal(spencer(linspace(1, 14, 14)'), zeros(14, 1)); +//assert_checkequal(spencer(linspace(-1, -10, 14)), zeros(1, 14)); diff --git a/macros/stft.sci b/macros/stft.sci index 7c30360..1d4b462 100644 --- a/macros/stft.sci +++ b/macros/stft.sci @@ -1,89 +1,139 @@ -function [y,c]= stft(x, varargin) -//Compute the short-time Fourier transform of the vector X -//Calling Sequence -//Y = stft (X) -//Y = stft (X, WIN_SIZE) -//Y = stft (X, WIN_SIZE, INC) -//Y = stft (X, WIN_SIZE, INC, NUM_COEF) -//Y = stft (X, WIN_SIZE, INC, NUM_COEF, WIN_TYPE) -//[Y,C] = stft (X) -//[Y,C] = stft (X, WIN_SIZE) -//[Y,C] = stft (X, WIN_SIZE, INC) -//[Y,C] = stft (X, WIN_SIZE, INC, NUM_COEF) -//[Y,C] = stft (X, WIN_SIZE, INC, NUM_COEF, WIN_TYPE) -//Parameters -//X: Real scalar or vector -//WIN_SIZE: Size of the window used -//INC: Increment -//WIN_TYPE: Type of window -//Description -//Compute the short-time Fourier transform of the vector X with NUM_COEF coefficients by applying a window of WIN_SIZE data points and an increment of INC points. -// +function [y, c] = stft(x, win_size, inc, num_coef, win_type) +//Compute the short-time Fourier transform of the vector X. +//Calling Sequence: +//y = stft(x) +//y = stft(x, win_size) +//y = stft(x, win_size, inc) +//y = stft(x, win_size, inc, num_coef) +//y = stft(x, win_size, inc, num_coef, win_type) +//[y, c] = stft(x) +//[y, c] = stft(x, win_size) +//[y, c] = stft(x, win_size, inc) +//[y, c] = stft(x, win_size, inc, num_coef) +//[y, c] = stft(x, win_size, inc, num_coef, win_type) +//Parameters: +//x: Real scalar or vector +//win_size: Size of the window used +//inc: Increment +//num_coef: Coefficients of Fourier transform +//win_type: Type of window +//Description: +//Compute the short-time Fourier transform of the vector X with num_coef coefficients by applying a window of win_size data points and an increment of inc points. //Before computing the Fourier transform, one of the following windows is applied: -// //"hanning" -> win_type = 1 -// //"hamming" -> win_type = 2 -// //"rectangle" -> win_type = 3 -// -//The window names can be passed as strings or by the WIN_TYPE number. -// -//The following defaults are used for unspecified arguments:WIN_SIZE= 80, INC = 24, NUM_COEF = 64, and WIN_TYPE = 1. -// -//Y = stft (X, ...)' returns the absolute values of the Fourier coefficients according to the NUM_COEF positive frequencies. -// -//'[Y, C] = stft (x, ...)' returns the entire STFT-matrix Y and a 3-element vector C containing the window size, increment, and window type, which is needed by the 'synthesis' function. +//The window names can be passed as strings or by the win_type number. +//The following defaults are used for unspecified arguments: win_sizse = 80, inc = 24, num_coef = 64, and win_type = 1. +//y = stft(x, ...)' returns the absolute values of the Fourier coefficients according to the NUM_COEF positive frequencies. +//'[y, c] = stft (x, ...)' returns the entire stft-matrix y and a 3-element vector c containing the window size, increment, and window type, +//which is needed by the 'synthesis' function. +//Examples: +//[y, c] = stft([1; -2; -5]) +//y = [] +//c = [80, 24, 1] + + funcprot(0); + rhs = argn(2); + if (rhs < 1 | rhs > 5) + error("Wrong number of input arguments."); + end + if (~isvector (x)) + error ("stft: X must be a vector"); + end + + if (rhs == 1) + win_size = 80; + inc = 24; + num_coef = 64; + win_type = 1; + elseif (rhs == 2) + inc = 24; + num_coef = 64; + win_type = 1; + elseif (rhs == 3) + num_coef = 64; + win_type = 1; + elseif (rhs == 4) + win_type = 1; + end + + if (type(win_type) == 10) + switch (convstr(win_type, 'l')) + case "hanning" , win_type = 1; + case "hamming" , win_type = 2; + case "rectangle" , win_type = 3; + otherwise + error ("stft: unknown window type"); + end + end -funcprot(0); -lhs= argn(1); -rhs= argn(2); + x = x(:); -if(rhs <1 | rhs>5) - error("Wrong number of input arguments"); -end + ncoef = 2 * num_coef; + if (win_size > ncoef) + win_size = ncoef; + printf ("stft: window size adjusted to %f\n", win_size); + end + num_win = fix ((size(x, 'r') - win_size) / inc); -if(lhs<1 | lhs>2) - error("Wrong number of output arguments"); -end + switch (win_type) + case 1 , win_coef = (window('hn', win_size))'; + case 2 , win_coef = (window('hm', win_size))'; + case 3 , win_coef = ones (win_size, 1); + end + + z = zeros (ncoef, num_win + 1); + start = 1; + for i = 0:num_win + z(1:win_size, i+1) = x(start:start+win_size-1) .* win_coef; + start = start + inc; + end + + y = fft(z, -1, find(size(z) ~= 1, 1)); + + if (nargout() == 1) + y = abs(y(1:num_coef, :)); + else + c = [win_size, inc, win_type]; + end -select(rhs) - case 1 then - select(lhs) - case 1 then - y= callOctave("stft", x); - case 2 then - [y,c]= callOctave("stft", x); - end - case 2 then - select(lhs) - case 1 then - y= callOctave("stft", x,varargin(1)); - case 2 then - [y,c]= callOctave("stft", x, varargin(1)); - end - case 3 then - select(lhs) - case 1 then - y= callOctave("stft", x,varargin(1), varargin(2)); - case 2 then - [y,c]= callOctave("stft", x,varargin(1), varargin(2)); - end - case 4 then - select(lhs) - case 1 then - y= callOctave("stft", x,varargin(1), varargin(2), varargin(3)); - case 2 then - [y,c]= callOctave("stft", x,varargin(1), varargin(2), varargin(3)); - end - case 5 then - select(lhs) - case 1 then - y= callOctave("stft", x,varargin(1), varargin(2), varargin(3), varargin(4)); - case 2 then - [y,c]= callOctave("stft", x,varargin(1), varargin(2), varargin(3), varargin(4)); - end -end endfunction +//input validation: +//assert_checkerror("stft()", "Wrong number of input arguments."); +//assert_checkerror("stft(1, 2, 3, 4, 5, 6)", "Wrong number of input arguments."); +//assert_checkerror("stft([1 2; 3 4])", "stft: X must be a vector"); +//s = "square"; +//assert_checkerror("stft([1 2 3], 8, 4, 6, s)", "stft: unknown window type"); + +//tests: +//assert_checkequal(stft([1 2 3]), stft([1 21 3], 80, 24, 64, 1)); +//assert_checkequal(stft([1 2 3], 80), stft([1 21 3], 80, 24, 64, 1)); +//assert_checkequal(stft([1 2 3], 80, 24), stft([1 21 3], 80, 24, 64, 1)); +//assert_checkequal(stft([1 2 3], 80, 24, 64), stft([1 21 3], 80, 24, 64, 1)); + +//[y, c] = stft([1; -2; -5]); +//assert_checkequal(y, []); +//assert_checkequal(c, [80, 24, 1]); + +//y = stft([1 21 3], 3, 2, 2); +//assert_checkequal(y, [21; 21]); + +//[y, c] = stft([1 21 3], 3, 2, 2); +//assert_checkequal(y, [21; -21*%i; -21; 21*%i]); +//assert_checkequal(c, [3 2 1]); + +//y = stft([1, 3-2*%i, -6-7*%i], 3, 2, 3); +//assert_checkalmostequal(y, [3.60555; 3.60555; 3.60555], 0.5*10^-5); + +//[y c] = stft([1; 3-2*%i; -6-7*%i], 3, 2, 3); +//assert_checkalmostequal(y, [3-2*%i; -0.2321-3.5981*%i; -3.2321-1.5981*%i; -3+2*%i; 0.2321+3.5981*%i; 3.2321+1.5981*%i], 5*10^-4); +//assert_checkequal(c, [3 2 1]); + +//[y c] = stft([1; 3-2*%i; -1-2*%i], 3, 2, 3, 3); +//assert_checkalmostequal(y, [3-4*%i; -0.4641-1.7321*%i; 0-1.4641*%i; -3; 5.4641*%i; 6.4641+1.7321*%i], 5*10^-4); +//assert_checkequal(c, [3 2 3]); +//y = stft([3*%i; 4*%i; -5*%i], 3, 2, 3, 1); +//assert_checkequal(y, [4; 4; 4]); diff --git a/macros/synthesis.sci b/macros/synthesis.sci index 7224686..ede8601 100644 --- a/macros/synthesis.sci +++ b/macros/synthesis.sci @@ -1,25 +1,67 @@ -function x= synthesis(Y,C) -//Compute a signal from its short-time Fourier transform -//Calling Sequence -//X= synthesis(Y,C) -//Parameters -//Y: Shirt-time fourier transform -//C: 3-element vector C specifying window size, increment, window type. -//Description -//Compute a signal from its short-time Fourier transform Y and a 3-element vector C specifying window size, increment, and window type. -//The values Y and C can be derived by -//[Y, C] = stft (X , ...) -funcprot(0); -lhs= argn(1); -rhs= argn(2); - -if(rhs<2 | rhs >2) - error("Wrong number of input arguments"); -end - -select(rhs) - case 2 then - x= callOctave("synthesis", Y,C); - -end +function x = synthesis (y, c) +//Compute a signal from its short-time Fourier transform. +//Calling Sequence: +//synthesis(y, c) +//Parameters: +//y: Real or complex matrix representing a signal's short-time fourier transform. +//c: 3-element vector C specifying window size, increment and window type. +//Description: +//Compute a signal from its short-time Fourier transform 'y' and a 3-element vector 'c' specifying window size, increment, and window type. +//A window type of 1 represents a hanning window, 2 represents a hamming window and 3 represents a rectangular window. +//The values 'y' and 'c' can be derived by [y, c] = stft (x, ...) + + funcprot(0); + rhs = argn(2); + if (rhs ~= 2) + error("synthesis: wrong number of input arguments"); + end + + if (length(c) ~= 3) + error ("synthesis: C must contain exactly 3 elements"); + end + + w_size = c(1); + inc = c(2); + w_type = c(3); + + if (w_type == 1) + w_coeff = window('hn', w_size); + elseif (w_type == 2) + w_coeff = window('hm', w_size); + elseif (w_type == 3) + w_coeff = ones (w_size, 1); + else + error ("synthesis: window_type must be 1, 2, or 3"); + end + + if (isnan(w_coeff)) + w_coeff = 1; + end + z = real(fft(y, 1, find(size(y) ~= 1, 1))); + st = fix((w_size-inc) / 2); + z = z(st+1:st+inc, :); + w_coeff = w_coeff(st+1:st+inc); + + nc = size(z, 'c'); + for i = 1:nc + z(:, i) = z(:, i) ./ w_coeff; + end + + x = matrix(z, inc * nc, 1); + endfunction + +//input validation: +//assert_checkerror("synthesis(1)", "synthesis: wrong number of input arguments"); +//assert_checkerror("synthesis(1, [1 2])", "synthesis: C must contain exactly 3 elements"); +//assert_checkerror("synthesis(1, [1 2 3 4])", "synthesis: C must contain exactly 3 elements"); +//assert_checkerror("synthesis(1, [1 2 4])", "synthesis: window_type must be 1, 2, or 3"); + +//tests: +//assert_checkequal(synthesis(1, [1 1 1]), 1); +//assert_checkequal(synthesis(4, [2 1 3]), 4); +//assert_checkalmostequal(synthesis(-6, [2 1 2]), -75, %eps); +//assert_checkalmostequal(synthesis(-9, [2; 1; 2]), -112.50, 10*%eps); +//assert_checkequal(synthesis(5*%i, [2; 1; 3]), 0); +//assert_checkequal(synthesis([1 2; -3, -6], [1; 1; 2]), [-1; -2]); +//assert_checkalmostequal(synthesis([1 1+2*%i; -3-4*%i, -5], [2; 1; 2]), [-12.5; -25], %eps); diff --git a/macros/tf2sos.sci b/macros/tf2sos.sci index 7570707..ad7f10d 100644 --- a/macros/tf2sos.sci +++ b/macros/tf2sos.sci @@ -1,35 +1,70 @@ -function [sos,varargout] = tf2sos (b, a) +function [sos,g] = tf2sos (B, A) //This function converts direct-form filter coefficients to series second-order sections. -//Calling Sequence +//Calling Sequence: //[sos] = tf2sos (b, a) //[sos, g] = tf2sos (b, a) -//Parameters +//Parameters: //b: matrix of real numbers //a: matrix of real numbers -//Description -//This is an Octave function. +//Description: //This function converts direct-form filter coefficients to series second-order sections. //The input parameters b and a are vectors specifying the digital filter H(z) = B(z)/A(z). //The output is the sos matrix and the overall gain. //If there is only one output argument, the overall filter gain is applied to the first second-order section in the sos matrix. -//Examples +//Examples: //tf2sos([1,2,3,4,5,6],2) //ans = -// 0.50000 0.80579 1.07239 1.00000 0.00000 0.00000 -// 1.00000 -1.10337 1.87524 1.00000 0.00000 0.00000 -// 1.00000 1.49180 -0.00000 1.00000 0.00000 0.00000 - -funcprot(0); -rhs = argn(2) -lhs = argn(1) - -if(rhs~=2) -error("Wrong number of input arguments.") -end - select(lhs) - case 1 then - sos = callOctave("tf2sos",b,a) - case 2 then - [sos,g] = callOctave("tf2sos",b,a) - end -endfunction +// 0.50000 0.80579 1.07239 0.00000 0.00000 1.00000 +// 1.00000 -1.10337 1.87524 0.00000 0.00000 1.00000 +// 1.00000 1.49180 -0.00000 0.00000 1.00000 0.00000 + + funcprot(0); + if (nargin() ~= 2) then + error("Wrong number of input arguments."); + end + S = syslin([], inv_coeff(flipdim(B(:)', 2)), inv_coeff(flipdim(A(:)', 2))); + [z,p,k] = tf2zp(S); + if (nargout() < 2) + sos = clean(zp2sos(z,p,k)); + else + [sos,g] = clean(zp2sos(z,p,k)); + end + +endfunction + +//tests: +//assert_checkerror("tf2sos(1)", "Wrong number of input arguments."); +//assert_checkerror("tf2sos(1, 2, 3)", "Wrong number of input arguments."); + +//A = [-7 -12]; +//B = [-1 -7]; +//assert_checkequal(tf2sos(A, B), [7 12 0 1 7 0]); + +//A = [1 2; 3 4]; +//B = [3 2; 1 4]; +//assert_checkalmostequal(tf2sos(A, B), [0.3333 0.0679 0.4768 1 -0.6667 1.3333; 1 2.7963 0 1 1 0], 5*10^-4); + +//A = [1 1 1 1]; +//B = [-1 -1; -1 -1]; +//assert_checkalmostequal(tf2sos(A, B), [-1 0 -1 1 0 1; 1 1 0 1 1 0], 100*%eps); + +//b = [1, 1]; +//a = [1, 2]; +//expected_sos = [1, 1, 0, 1, 2, 0]; +//sos = tf2sos(b, a); +//assert_checkalmostequal(sos, expected_sos, %eps); + +//b = [1, 2, 2]; +//a = [1, -1, 1]; +//expected_sos = [1, 2, 2, 1, -1, 1]; +//sos = tf2sos(b, a); +//assert_checkalmostequal(sos, expected_sos, 100*%eps); + +//b = [1, 1, 1, 1]; +//a = [1, 1, 1, 1]; +//expected_sos = [ +// 1, 0, 1, 1, 0, 1; +// 1, 1, 0, 1, 1, 0 +//]; +//sos = tf2sos(b, a); +//assert_checkalmostequal(sos, expected_sos, 100*%eps); diff --git a/macros/tf2zp.sci b/macros/tf2zp.sci index ca10fd4..f607ba0 100644 --- a/macros/tf2zp.sci +++ b/macros/tf2zp.sci @@ -1,13 +1,14 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt -//Original contribution: FOSSEE, IIT Bombay +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 3 Feb 2024 +// Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - function [z,p,k]=tf2zp(num,den) // Transfer function to zero pole conversion @@ -60,8 +61,9 @@ function [z,p,k]=tf2zp(num,den) if(rd>1) then error("Denominator must be row vector"); - elseif np>cod then - error("Improper transfer function"); + + // elseif np>cod then + // error("Improper transfer function"); it is a bug it should be removed end if (~isempty(den)) then coef=den(1); @@ -98,3 +100,9 @@ function [z,p,k]=tf2zp(num,den) end z=roots(num); endfunction +/* +Note : This function is tested with Octave's outputs as a reference. +[z p k] = tf2zp([9.6500e+02 -1.1773e+05 3.8648e+06 -4.5127e+071.5581e+08],[ 1 -3 2]) //pass +[z p k] = tf2zp([1 2 3 4],[ 1 -3 2]) //pass +[z p k] = tf2zp([4 5 6],[1]) // pass +*/
\ No newline at end of file diff --git a/macros/tfestimate.sci b/macros/tfestimate.sci index e52faf5..f437f52 100644 --- a/macros/tfestimate.sci +++ b/macros/tfestimate.sci @@ -1,93 +1,73 @@ -function [Pxx, freq] = tfestimate(x, y, window, overlap, Nfft, Fs, range) - +function varargout = tfestimate(varargin) //Estimate transfer function of system with input x and output y. Use the Welch (1967) periodogram/FFT method. -//Calling Sequence +//This function depends on pwelch (and hence, fft1). +//Calling Sequence: +//tfestimate (x, y) +//tfestimate (x, y, window) +//tfestimate (x, y, window, overlap) +//tfestimate (x, y, window, overlap, Nfft) +//tfestimate (x, y, window, overlap, Nfft, Fs) //tfestimate (x, y, window, overlap, Nfft, Fs, range) -//[Pxx, freq] = tfestimate (…) -//Parameters -//x: Input. -//y: Output. -//window: [real vector] of window-function values between 0 and 1; the data segment has the same length as the window. Default window shape is Hamming. [integer scalar] length of each data segment. The default value is window=sqrt(length(x)) rounded up to the nearest integer power of 2; see 'sloppy' argument. -// overlap: [real scalar] segment overlap expressed as a multiple of window or segment length. 0 <= overlap < 1, The default is overlap=0.5 . -// Nfft: [integer scalar] Length of FFT. The default is the length of the "window" vector or has the same value as the scalar "window" argument. If Nfft is larger than the segment length, "seg_len", the data segment is padded with "Nfft-seg_len" zeros. The default is no padding. Nfft values smaller than the length of the data segment (or window) are ignored silently. -// Fs: [real scalar] sampling frequency (Hertz); default=1.0 -// range: 'half', 'onesided' : frequency range of the spectrum is zero up to but not including Fs/2. Power from negative frequencies is added to the positive side of the spectrum, but not at zero or Nyquist (Fs/2) frequencies. This keeps power equal in time and spectral domains. See reference [2]. 'whole', 'twosided' : frequency range of the spectrum is -Fs/2 to Fs/2, with negative frequencies stored in "wrap around" order after the positive frequencies; e.g. frequencies for a 10-point 'twosided' spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 'shift', 'centerdc' : same as 'whole' but with the first half of the spectrum swapped with second half to put the zero-frequency value in the middle. (See "help fftshift". If data (x and y) are real, the default range is 'half', otherwise default range is 'whole'. -//Description -//This function is being called from Octave. +//Parameters: +//x: system-input time-series data. Real pr complex vector. +//y: system-output time-series data. Real or complex vector, same dimension as x. +//window: [real vector] of window-function values between 0 and 1; the data segment has the same length as the window. Default window shape is Hamming. +//[integer scalar] length of each data segment. The default value is window=sqrt(length(x)) rounded up to the nearest integer power of 2. +// overlap: [real scalar] segment overlap expressed as a multiple of window or segment length. 0 <= overlap < 1, The default is overlap = 0.5. +// Nfft: [integer scalar] Length of FFT. The default is the length of the "window" vector or has the same value as the scalar "window" argument. +//If Nfft is larger than the segment length, "seg_len", the data segment is padded with "Nfft-seg_len" zeros. The default is no padding. Nfft values smaller than the length of the data segment (or window) are ignored silently. +// Fs: [real scalar] sampling frequency (Hertz); default = 1.0 +// range: 'half', 'onesided' : frequency range of the spectrum is zero up to but not including Fs/2. Power from negative frequencies is added to the positive side of the spectrum, +//but not at zero or Nyquist (Fs/2) frequencies. This keeps power equal in time and spectral domains. 'whole', 'twosided': frequency range of the spectrum is -Fs/2 to Fs/2, with negative frequencies stored in "wrap around" order after the positive frequencies; e.g. frequencies for a 10-point 'twosided' spectrum are 0 0.1 0.2 0.3 0.4 0.5 -0.4 -0.3 -0.2 -0.1 'shift', 'centerdc' : same as 'whole' but with the first half of the spectrum swapped with second half to put the zero-frequency value in the middle. If data (x and y) are real, the default range is 'half', otherwise default range is 'whole'. +//Description: //Estimate transfer function of system with input x and output y. Use the Welch (1967) periodogram/FFT method. -//Examples -//[Pxx, freq]=tfestimate ([1 2 3], [4 5 6]) +//Examples: +//[Pxx, freq] = tfestimate([1 2 3], [4 5 6]) //Pxx = -// // 1.7500 + 0.0000i // 1.5947 + 0.3826i // 1.2824 + 0.0000i // //freq = -// // 0.00000 // 0.25000 // 0.50000 -funcprot(0); -lhs = argn(1) -rhs = argn(2) -if (rhs < 2 | rhs > 7) -error("Wrong number of input arguments.") -end + funcprot(0); + if (nargin() < 2 || nargin() > 7) + error("Wrong number of input arguments."); + end + nvarargin = length(varargin); + for iarg = 1:nvarargin + arg = varargin(iarg); + if ( ~isempty(arg) && (type(arg) == 10) && ( ~strcmp(arg,'power') || ~strcmp(arg,'cross') || ~strcmp(arg,'trans') || ~strcmp(arg,'coher') || ~strcmp(arg,'ypower') )) + varargin(iarg) = []; + end + end + varargin(nvarargin + 1) = 'trans'; -select(rhs) - - case 2 then - if(lhs==1) - Pxx = callOctave("tfestimate",x,y) - elseif(lhs==2) - [Pxx, freq] = callOctave("tfestimate",x,y) - else - error("Wrong number of output argments.") - end + if (nargout() == 0) + pwelch(varargin(:)); + elseif (nargout() == 1) + Pxx = pwelch(varargin(:)); + varargout(1) = Pxx; + elseif (nargout() >= 2) + [Pxx,f] = pwelch(varargin(:)); + varargout(1) = Pxx; + varargout(2) = f; + end - case 3 then - if(lhs==1) - Pxx = callOctave("tfestimate",x, y, window) - elseif(lhs==2) - [Pxx, freq] = callOctave("tfestimate",x, y, window) - else - error("Wrong number of output argments.") - end - case 4 then - if(lhs==1) - Pxx = callOctave("tfestimate",x, y, window, overlap) - elseif(lhs==2) - [Pxx, freq] = callOctave("tfestimate",x, y, window, overlap) - else - error("Wrong number of output argments.") - end - case 5 then - if(lhs==1) - Pxx = callOctave("tfestimate",x, y, window, overlap, Nfft) - elseif(lhs==2) - [Pxx, freq] = callOctave("tfestimate",x, y, window, overlap, Nfft) - else - error("Wrong number of output argments.") - end - case 6 then - if(lhs==1) - Pxx = callOctave("tfestimate",x, y, window, overlap, Nfft, Fs) - elseif(lhs==2) - [Pxx, freq] = callOctave("tfestimate",x, y, window, overlap, Nfft, Fs) - else - error("Wrong number of output argments.") - end - case 7 then - if(lhs==1) - Pxx = callOctave("tfestimate",x, y, window, overlap, Nfft, Fs, range) - elseif(lhs==2) - [Pxx, freq] = callOctave("tfestimate",x, y, window, overlap, Nfft, Fs, range) - else - error("Wrong number of output argments.") - end - end endfunction - +//tests: +//assert_checkerror("tfestimate(1)", "Wrong number of input arguments."); +//assert_checkerror("tfestimate(1, 2, 3, 4, 5, 6, 7, 8)", "Wrong number of input arguments."); +//tfestimate([1 2 3], [4 5 6]); +//tfestimate([-1 -2 -3], [4 5 6], 'power'); +//tfestimate([-1; -2; -3], [-4 -5 -6], 'power', 'cross'); +//y = tfestimate([1; 2; 3], [4; 5; 6], 'coher', 'trans'); +//assert_checkalmostequal(y, [1.75; 1.59472+0.38256*%i; 1.28235], 5*10^-5); +//[a b] = tfestimate([1 -2 -3], [4; 5; 6], 'ypower', 'trans'); +//assert_checkalmostequal(a, [-1.1667; -1.1029-0.1912*%i; -1.5797], 5*10^-4); +//assert_checkalmostequal(b, [0; 0.25; 0.5], %eps); +//tfestimate([5-1 4+2*%i 4 -1-3*%i], [1+%i -5*%i 6 -6]); diff --git a/macros/triang.sci b/macros/triang.sci index f450d97..596bfab 100644 --- a/macros/triang.sci +++ b/macros/triang.sci @@ -6,7 +6,6 @@ function w = triang (m) //m: positive integer value //w: output variable, vector of real numbers //Description -//This is an Octave function. //This function returns the filter coefficients of a triangular window of length m supplied as input, to the output vector y. //Examples //triang(5) @@ -29,3 +28,16 @@ rhs = argn(2) w = 1 - abs ([-(m-1):2:(m-1)]' / (m+modulo(m,2))); endfunction + +//test input validation: +//assert_checkerror("triang()", "Wrong number of input arguments."); +//assert_checkerror("triang(1, 2)", "Wrong number of input arguments."); +//assert_checkerror("triang(0.5)", "parzenwin: M must be a positive integer"); +//assert_checkerror("triang(-1)", "parzenwin: M must be a positive integer"); +//assert_checkerror("triang(zeros (2, 5))", "parzenwin: M must be a positive integer"); + +//tests: +//assert_checkequal(triang(1), 1); +//assert_checkequal(triang(2), [1; 1]/2); +//assert_checkequal(triang(3), [1; 2; 1]/2); +//assert_checkequal(triang(4), [1; 3; 3; 1]/4); diff --git a/macros/tripuls.sci b/macros/tripuls.sci index 498160b..b4fc2fb 100644 --- a/macros/tripuls.sci +++ b/macros/tripuls.sci @@ -1,44 +1,69 @@ -function [y] = tripuls(t,w,skew) - -//This function generates a triangular pulse over the interval [-w/2,w/2] sampled at times t -//Calling Sequence -//[y] = tripuls(t) -//[y] = tripuls(t,w) -//[y] = tripuls(t,w,skew) -//Parameters -//t: vector of real or complex numbers -//w: real or complex number -//skew: real number, -1 <= s <= 1 -//Description -//This function generates a triangular pulse which is sampled at times t over the interval [-w/2,w/2]. The value of skew lies between -1 -//and 1. -//The value of skew represents the relative placement of the peak in the given width. -//Examples +function y = tripuls(t, w, skew) +//This function generates a triangular pulse over the interval [-w/2, w/2] sampled at times t. +//Calling Sequence: +//y = tripuls(t) +//y = tripuls(t, w) +//y = tripuls(t, w, skew) +//Parameters: +//t: Vector of real numbers +//w: Real number. The default value is 1. +//skew: Real number in the interval [-1, 1], The default value is 0. +//Description: +//This function generates a triangular pulse which is sampled at times t over the interval [-w/2,w/2]. +//The value of skew lies between -1 and 1. The value of skew represents the relative placement of the peak in the given width. +//Examples: //tripuls([0, .5, .6, 1], 0.9) //ans = // 1 0 0 0 -//This function is being called from Octave - -funcprot(0); - -rhs = argn(2) - -if(rhs<1 | rhs>3) -error("Wrong number of input arguments.") -end - select(rhs) - case 1 then - y = callOctave("tripuls",t) - case 2 then - y = callOctave("tripuls",t,w) - case 3 then - //tip = type(skew) - //if(tip==1) - y = callOctave("tripuls",t,w,skew) - //else - //error("Wrong arguments.") - //end - end + + funcprot(0); + rhs= argn(2); + if (rhs < 1 | rhs > 3) + error("tripuls: wrong number of input arguments"); + end + + if (rhs == 1) + w = 1; + skew = 0; + else if (rhs == 2) + skew = 0; + end + end + + if (~isreal(w) | ~isscalar(w)) + error ("tripuls: arg2 (W) must be a real scalar"); + end + + if (~isreal(skew) | ~isscalar(skew) | skew < -1 | skew > 1) + error ("tripuls: arg3 (SKEW) must be a real scalar in the range [-1, 1]"); + end + + y = zeros(size(t, 'r'), size(t, 'c')); + peak = skew * w/2; + + idx = find((t >= -w/2) & (t <= peak)); + if (idx) + y(idx) = (t(idx) + w/2) / (peak + w/2); + end + + idx = find((t > peak) & (t < w/2)); + if (idx) + y(idx) = (t(idx) - w/2) / (peak - w/2); + end + endfunction +//input validation: +//assert_checkerror("tripuls()", "tripuls: wrong number of input arguments"); +//assert_checkerror("tripuls(1, 2, 3, 4)", "Wrong number of input arguments."); +//assert_checkerror("tripuls(1, 2*%i)", "tripuls: arg2 (W) must be a real scalar"); +//assert_checkerror("tripuls(1, 2, 2)", "tripuls: arg3 (SKEW) must be a real scalar in the range [-1, 1]"); +//assert_checkerror("tripuls(1, 2, -2)", "tripuls: arg3 (SKEW) must be a real scalar in the range [-1, 1]"); +//tests: +//assert_checkequal(tripuls([]), []); +//assert_checkequal(tripuls([], 0.1), []); +//assert_checkequal(tripuls(zeros (10, 1)), ones (10, 1)); +//assert_checkequal(tripuls(-1:1), [0, 1, 0]); +//assert_checkequal(tripuls(-5:5, 9), [0, 1, 3, 5, 7, 9, 7, 5, 3, 1, 0] / 9); +//assert_checkequal(tripuls(0:1/100:0.3, 0.1), tripuls([0:1/100:0.3]', 0.1)'); diff --git a/macros/zp2sos.sci b/macros/zp2sos.sci index 6bb9426..f299099 100644 --- a/macros/zp2sos.sci +++ b/macros/zp2sos.sci @@ -1,4 +1,135 @@ -function [sos,g] = zp2sos(z,p,k) +function B = ipermute(A, perm) + funcprot(0); + // ipermute : Inverse permute the dimensions of a matrix A. + // B = ipermute(A, perm) returns the array A with dimensions inverted + // according to the permutation vector `perm`. + // Validate the permutation vector + if max(size(perm)) ~= ndims(A) || or(gsort(perm, "g", "i") ~= 1:ndims(A)) + error('Permutation vector must contain unique integers from 1 to ndims(A).'); + end + // Compute the inverse permutation vector + invPerm = zeros(size(perm,1),size(perm , 2)); + for i = 1:max(size(perm)) + invPerm(perm(i)) = i; + end + // Use the permute function with the inverse permutation + B = permute(A, invPerm); +endfunction + +function zsort = cplxpair (z, tol, dim) + funcprot(0); + if (nargin < 1) + error("Invalid inputs"); + end + // default double + realmin = 2.2251e-308 + if (isempty (z)) + zsort = zeros (size (z,1) , size (z,2)); + return; + end + if (nargin < 2 || isempty (tol)) + tol = 100* %eps; + elseif (~ isscalar (tol) || tol < 0 || tol >= 1) + error ("cplxpair: TOL must be a scalar number in the range 0 <= TOL < 1"); + end + nd = ndims (z); + if (nargin < 3) + // Find the first singleton dimension. + sz = size (z); + dim = find (sz > 1, 1); + if isempty(dim) + dim = 1; + end + else + dim = floor (dim); + if (dim < 1 || dim > nd) + error ("cplxpair: invalid dimension DIM"); + end + end + // Move dimension to analyze to first position, and convert to a 2-D matrix. + perm = [dim:nd, 1:dim-1]; + z = permute (z, perm); + sz = size (z); + n = sz(1); + m = prod (sz) / n; + z = matrix (z, n, m); + // Sort the sequence in terms of increasing real values. + [temp, idx] = gsort (real (z), 1 , "i"); + z = z(idx + n * ones (n, 1) * [0:m-1]); + // Put the purely real values at the end of the returned list. + [idxi, idxj] = find (abs (imag (z)) ./ (abs (z) + realmin) <= tol); + // Force values detected to be real within tolerance to actually be real. + z(idxi + n*(idxj-1)) = real (z(idxi + n*(idxj-1))); + //if idxi and idxj are not scalers + if ~isscalar(idxi) then + v = ones(size(idxi,1),size(idxi,2)); + else + v = 1 ; + end + q = sparse ([idxi' idxj'], v, [n m]); + nr = sum (q, 1); + [temp, idx] = gsort (q, 'r','i'); + midx = idx + size (idx,1) * ones (size (idx,1), 1) * [0:size(idx,2)-1]; + z = z(midx); + zsort = z; + // For each remaining z, place the value and its conjugate at the start of + // the returned list, and remove them from further consideration. + for j = 1:m + p = n - nr(j); + for i = 1:2:p + if (i+1 > p) + error ("cplxpair: could not pair all complex numbers"); + end + [v, idx] = min (abs (z(i+1:p,j) - conj (z(i,j)))); + if (v >= tol * abs (z(i,j))) + error ("cplxpair: could not pair all complex numbers"); + end + // For pairs, select the one with positive imaginary part and use it and + // it's conjugate, but list the negative imaginary pair first. + if (imag (z(i,j)) > 0) + zsort([i, i+1],j) = [conj(z(i,j)), z(i,j)]; + else + zsort([i, i+1],j) = [conj(z(idx+i,j)), z(idx+i,j)]; + end + z(idx+i,j) = z(i+1,j); + end + end + // Reshape the output matrix. + zsort = ipermute (matrix (zsort, sz), perm); +endfunction + +function [zc, zr] = cplxreal (z, tol, dim) + funcprot(0); + if (nargin < 1 || nargin > 3) + error("invalid inputs"); + end + if (isempty (z)) + zc = zeros (size (z,1),size(z,2)); + zr = zeros (size (z,1),size(z,2)); + return; + end + if (nargin < 2 || isempty (tol)) + tol = 100 * %eps ; + end + if (nargin >= 3) + zcp = cplxpair(z,tol,dim); + else + zcp = cplxpair (z , tol); + end + nz = max(size (z) ); + idx = nz; + while ((idx > 0) && (zcp(idx) == 0 || (abs (imag (zcp(idx))) ./ abs (zcp(idx))) <= tol)) + zcp(idx) = real (zcp(idx)); + idx = idx - 1; + end + if (pmodulo (idx, 2) ~= 0) + error ("cplxreal: odd number of complex values was returned from cplxpair"); + end + zc = zcp(2:2:idx); + zr = zcp(idx+1:nz); +endfunction + +function [SOS, G] = zp2sos(z, p, k, DoNotCombineReal) //This function converts filter poles and zeros to second-order sections. //Calling Sequence //[sos] = zp2sos(z) @@ -10,7 +141,6 @@ function [sos,g] = zp2sos(z,p,k) //p: column vector //k: real or complex value, default value is 1 //Description -//This is an Octave function. //This function converts filter poles and zeros to second-order sections. //The first and second parameters are column vectors containing zeros and poles. The third parameter is the overall filter gain, the default value of which is 1. //The output is the sos matrix and the overall gain. @@ -20,32 +150,133 @@ function [sos,g] = zp2sos(z,p,k) //ans = // 6 -18 12 1 -2 0 // 1 -3 0 1 0 0 + + if argn(2) < 3 then + k = 1; + end + if argn(2) < 2 then + p = []; + end + + DoNotCombineReal = 0; + + [zc, zr] = cplxreal(z(:)); + [pc, pr] = cplxreal(p(:)); + + nzc = length(zc); + npc = length(pc); + + nzr = length(zr); + npr = length(pr); + + if DoNotCombineReal then + + // Handling complex conjugate poles + for count = 1:npc + SOS(count, 4:6) = [1, -2 * real(pc(count)), abs(pc(count))^2]; + end + + // Handling real poles + for count = 1:npr + SOS(count + npc, 4:6) = [0, 1, -pr(count)]; + end + // Handling complex conjugate zeros + for count = 1:nzc + SOS(count, 1:3) = [1, -2 * real(zc(count)), abs(zc(count))^2]; + end -funcprot(0); -rhs = argn(2) -lhs = argn(1) -if(rhs<1 | rhs>3) -error("Wrong number of input arguments.") -end - select(rhs) - case 1 then - if (lhs<2) - sos=callOctave("zp2sos",z) - else - [sos,g]=callOctave("zp2sos",z) - end - case 2 then - if(lhs<2) - [sos]=callOctave("zp2sos",z,p) - else - [sos,g]=callOctave("zp2sos",z,p) - end - case 3 then - if(lhs<2) - sos=callOctave("zp2sos",z,p,k) - else - [sos,g]=callOctave("zp2sos",z,p,k) - end - end + // Handling real zeros + for count = 1:nzr + SOS(count + nzc, 1:3) = [0, 1, -zr(count)]; + end + + // Completing SOS if needed (sections without pole or zero) + if npc + npr > nzc + nzr then + for count = nzc + nzr + 1 : npc + npr // sections without zero + SOS(count, 1:3) = [0, 0, 1]; + end + else + for count = npc + npr + 1 : nzc + nzr // sections without pole + SOS(count, 4:6) = [0, 0, 1]; + end + end + + else + + // Handling complex conjugate poles + for count = 1:npc + SOS(count, 4:6) = [1, -2 * real(pc(count)), abs(pc(count))^2]; + end + + // Handling pair of real poles + for count = 1:floor(npr / 2) + SOS(count + npc, 4:6) = [1, -pr(2 * count - 1) - pr(2 * count), pr(2 * count - 1) * pr(2 * count)]; + end + + // Handling last real pole (if any) + if pmodulo(npr, 2) == 1 then + SOS(npc + floor(npr / 2) + 1, 4:6) = [0, 1, -pr($)]; + end + + // Handling complex conjugate zeros + for count = 1:nzc + SOS(count, 1:3) = [1, -2 * real(zc(count)), abs(zc(count))^2]; + end + + // Handling pair of real zeros + for count = 1:floor(nzr / 2) + SOS(count + nzc, 1:3) = [1, -zr(2 * count - 1) - zr(2 * count), zr(2 * count - 1) * zr(2 * count)]; + end + + // Handling last real zero (if any) + if pmodulo(nzr, 2) == 1 then + SOS(nzc + floor(nzr / 2) + 1, 1:3) = [0, 1, -zr($)]; + end + + // Completing SOS if needed (sections without pole or zero) + if npc + ceil(npr / 2) > nzc + ceil(nzr / 2) then + for count = nzc + ceil(nzr / 2) + 1 : npc + ceil(npr / 2) // sections without zero + SOS(count, 1:3) = [0, 0, 1]; + end + else + for count = npc + ceil(npr / 2) + 1 : nzc + ceil(nzr / 2) // sections without pole + SOS(count, 4:6) = [0, 0, 1]; + end + end + end + + if ~exists('SOS') then + SOS = [0, 0, 1, 0, 0, 1]; // leading zeros will be removed + end + + // Removing leading zeros if present in numerator and denominator + for count = 1:size(SOS, 1) + B = SOS(count, 1:3); + A = SOS(count, 4:6); + while B(1) == 0 & A(1) == 0 do + A(1) = []; + A($ + 1) = 0; + B(1) = []; + B($ + 1) = 0; + end + SOS(count, :) = [B, A]; + end + + // If no output argument for the overall gain, combine it into the first section. + if argn(1) < 2 then + SOS(1, 1:3) = k * SOS(1, 1:3); + else + G = k; + end endfunction + +//tests +//sos = zp2sos ([]); +//sos = zp2sos ([], []); +//sos = zp2sos ([], [], 2); +//[sos, g] = zp2sos ([], [], 2); +//sos = zp2sos([], [0], 1); +//sos = zp2sos([0], [], 1); +//sos = zp2sos([1,2,3,4,5,6], 2); +//sos = zp2sos([-1-%i, -1+%i], [-1-2*%i, -1+2*%i], 10); diff --git a/macros/zp2tf.sci b/macros/zp2tf.sci index da3e8b1..10da276 100644 --- a/macros/zp2tf.sci +++ b/macros/zp2tf.sci @@ -1,14 +1,14 @@ // Copyright (C) 2018 - IIT Bombay - FOSSEE -// // This file must be used under the terms of the CeCILL. // This source file is licensed as described in the file COPYING, which // you should have received as part of this distribution. The terms // are also available at // http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt -// Author:Sonu Sharma, RGIT Mumbai +// Original Source : https://octave.sourceforge.io/signal/ +// Modifieded by: Abinash Singh Under FOSSEE Internship +// Date of Modification: 3 Feb 2024 // Organization: FOSSEE, IIT Bombay // Email: toolbox@scilab.in - function [num, den] = zp2tf (z, p, k) //Converts zeros / poles to a transfer function. @@ -54,3 +54,7 @@ function [num, den] = zp2tf (z, p, k) den = flipdim(den,2); endfunction +/* +[num,den] = zp2tf([1 3 4 5],[-4 -3 1 4],7) //passed +[num,den] = zp2tf([15 78 6 23],[2 1],965) //passed +*/
\ No newline at end of file |