Mercurial > hg > octave-nkf
changeset 5178:6758c11b5b99
[project @ 2005-03-03 05:18:04 by jwe]
author | jwe |
---|---|
date | Thu, 03 Mar 2005 05:18:04 +0000 |
parents | 86fa011d6404 |
children | 53f80b6d98d3 |
files | scripts/general/isequal.m scripts/general/sortrows.m scripts/set/ismember.m scripts/set/setdiff.m scripts/strings/strmatch.m |
diffstat | 5 files changed, 323 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/scripts/general/isequal.m @@ -0,0 +1,58 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +## isequal(x1, x2, ...) +## true if all parts of x1, x2, ... are equal + +function t = isequal(x,varargin) + if nargin != 2 + usage("isequal(x,y,...)"); + endif + + for arg = 1:length(varargin) + y = varargin{arg}; + if isstruct(x) + t = isstruct (y); + for [v, k] = x + t = t && struct_contains (y, k) && isequal (getfield(x,k), getfield(y,k)); + endfor + for [v,k] = y + t = t && struct_contains (x, k); + endfor + elseif islist(x) + t = islist(y) && length(x) == length(y); + if !t, return; endif + for i = 1:length(x) + t = isequal (x{i}, y{i}); + if !t, return; endif + endfor + elseif any (size (x) != size (y)) + t = false; + elseif iscell(x) || islist(x) + t = iscell (y) || islist(y); + if !t, return; endif + x = x (:); + y = y (:); + for i = 1:length(x) + t = isequal (x{i}, y{i}); + if !t, return; endif + endfor + else + t = all (x (:) == y (:)); + endif + if !t, return; endif + endfor +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/general/sortrows.m @@ -0,0 +1,61 @@ +## Copyright (C) 2000 Daniel Calvelo +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +## B = sortrows (A) +## returns matrix with rows sorted "lexicographically" +## +## B = sortrows(A, c) +## returns matrix with rows sorted according to the order of the +## columns specified in c. +## +## Set implicit_str_to_num_ok and implicit_num_to_str_ok to 1 if you +## use this for string sorting and octave 2.1.50 or earlier. + +## Author: Daniel Calvelo +## 2001-02-24 Paul Kienzle +## * cleanup according to Octave conventions +## * return reverse index +## * handle string arguments + +function [s, i] = sortrows (m, c) + + if nargin < 2 + indices = [ 1 : size(m,2) ]'; + else + indices = c (:); + endif + + if (isstr (m)) + s = toascii (m); + else + s = m; + endif + + ## since sort is 'stable' the order of identical elements will be + ## preserved, so by traversing the sort indices in reverse order + ## we will make sure that identical elements in index i are subsorted + ## by index j. + indices = flipud (indices); + i = [1 : size(m,1)]'; + for ii = 1 : length (indices); + [ trash, idx ] = sort ( s ( : , indices (ii) ) ); + s = s ( idx, : ); + i = i (idx ); + endfor + if (isstr (m)) + s = setstr(s); + endif +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/set/ismember.m @@ -0,0 +1,78 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {} ismember(@var{A}, @var{S}) +## +## Return a matrix the same shape as @var{A} which has 1 if +## @code{A(i,j)} is in @var{S} or 0 if it isn't. +## +## @end deftypefn +## @seealso{unique, union, intersect, setxor, setdiff} + +function c = ismember(a,S) + if nargin != 2 + usage("ismember(A,S)"); + endif + + [ra, ca] = size(a); + if isempty(a) || isempty(S) + c = zeros(ra, ca); + else + S = unique(S(:)); + lt = length(S); + if lt == 1 + c = ( a == S ); + elseif ra*ca == 1 + c = any (a == S); + else + ## Magic : the following code determines for each a, the index i + ## such that S(i)<= a < S(i+1). It does this by sorting the a + ## into S and remembering the source index where each element came + ## from. Since all the a's originally came after all the S's, if + ## the source index is less than the length of S, then the element + ## came from S. We can then do a cumulative sum on the indices to + ## figure out which element of S each a comes after. + ## E.g., S=[2 4 6], a=[1 2 3 4 5 6 7] + ## unsorted [S a] = [ 2 4 6 1 2 3 4 5 6 7 ] + ## sorted [ S a ] = [ 1 2 2 3 4 4 5 6 6 7 ] + ## source index p = [ 4 1 5 6 2 7 8 3 9 10 ] + ## boolean p<=l(S) = [ 0 1 0 0 1 0 0 1 0 0 ] + ## cumsum(p<=l(S)) = [ 0 1 1 1 2 2 2 3 3 3 ] + ## Note that this leaves a(1) coming after S(0) which doesn't + ## exist. So arbitrarily, we will dump all elements less than + ## S(1) into the interval after S(1). We do this by dropping S(1) + ## from the sort! E.g., S=[2 4 6], a=[1 2 3 4 5 6 7] + ## unsorted [S(2:3) a] =[4 6 1 2 3 4 5 6 7 ] + ## sorted [S(2:3) a] = [ 1 2 3 4 4 5 6 6 7 ] + ## source index p = [ 3 4 5 1 6 7 2 8 9 ] + ## boolean p<=l(S)-1 = [ 0 0 0 1 0 0 1 0 0 ] + ## cumsum(p<=l(S)-1) = [ 0 0 0 1 1 1 2 2 2 ] + ## Now we can use Octave's lvalue indexing to "invert" the sort, + ## and assign all these indices back to the appropriate A and S, + ## giving S_idx = [ -- 1 2], a_idx = [ 0 0 0 1 1 2 2 ]. Add 1 to + ## a_idx, and we know which interval S(i) contains a. It is + ## easy to now check membership by comparing S(a_idx) == a. This + ## magic works because S starts out sorted, and because sort + ## preserves the relative order of identical elements. + [v, p] = sort ( [ S(2:lt) ; a(:) ] ); + idx(p) = cumsum (p <= lt-1) + 1; + idx = idx (lt : lt+ra*ca-1); + c = ( a == reshape (S (idx), size (a)) ); + endif + endif +endfunction + \ No newline at end of file
new file mode 100644 --- /dev/null +++ b/scripts/set/setdiff.m @@ -0,0 +1,46 @@ +## Copyright (C) 2000 Paul Kienzle +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +## -*- texinfo -*- +## @deftypefn {Function File} {} setdiff(@var{a}, @var{b}) +## +## Return the elements in @var{a} but not in @var{b}, sorted in ascending +## order. If @var{a} and @var{b} are both column vectors return a column +## vector, otherwise return a row vector. +## +## @end deftypefn +## @seealso{unique, union, intersect, setxor, ismember} + +function c = setdiff(a,b) + if nargin != 2 + usage("setdiff(a,b)"); + endif + + c = unique(a); + if !isempty(c) && !isempty(b) + ## form a and b into combined set + b = unique(b); + [dummy, idx] = sort([ c(:) ; b(:)]); + ## eliminate those elements of a that are the same as in b + n = length(dummy); + c(idx(find(dummy(1:n-1) == dummy(2:n)))) = []; + ## reshape if necessary + if ( size(c,1) != 1 && size(b,1) == 1 ) + c = c.'; + endif + endif +endfunction + \ No newline at end of file
new file mode 100644 --- /dev/null +++ b/scripts/strings/strmatch.m @@ -0,0 +1,80 @@ +## Copyright (C) 2003 Alois Schloegl +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; if not, write to the Free Software +## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +## +## Copyright (C) 2000 Paul Kienzle + +## usage: strmatch(s, A [, 'exact']) +## Determines which entries of A match string s. A can be a string matrix +## or a cell array of strings. If 'exact' is not given, then s only needs +## to match A up to the length of s. Null characters match blanks. +## Results are returned as a column vector. +function idx = strmatch(s,A,exact) + if (nargin < 2 || nargin > 3) + usage("strmatch(s,A,'exact')"); + endif + + try istno = implicit_str_to_num_ok; + catch istno = 0; + end + try wstno = warn_str_to_num; + catch wstno = 0; + end + try dfi = do_fortran_indexing; + catch dfi = 0; + end + try wfi = warn_fortran_indexing; + catch wfi = 0; + end + unwind_protect + implicit_str_to_num_ok = 1; + warn_str_to_num = 0; + do_fortran_indexing = 1; + warn_fortran_indexing = 0; + + [nr, nc] = size (A); + if iscell(A) + match = zeros(prod(size(A)),1); + if nargin>2, + for k = 1:prod(size(A)), + match(k) = strcmp(s,A{k}); + end + else + for k = 1:prod(size(A)), + match(k) = strncmp(s,A{k},length(s)); + end + end + idx = find(match); + elseif (length (s) > nc) + idx = []; + else + if (nargin == 3 && length(s) < nc) s(1,nc) = ' '; endif + s (s==0) = ' '; + A (A==0) = ' '; + match = s(ones(size(A,1),1),:) == A(:,1:length(s)); + if (length(s) == 1) + idx = find(match); + else + idx = find(all(match')'); + endif + endif + + unwind_protect_cleanup + implicit_str_to_num_ok = istno; + warn_str_to_num = wstno; + do_fortran_indexing = dfi; + warn_fortran_indexing = wfi; + end_unwind_protect +endfunction