diff options
| -rw-r--r-- | macros/fwhm.sci | 165 |
1 files changed, 135 insertions, 30 deletions
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); |