Mercurial > octave-nkf

changeset 5178:6758c11b5b99

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scripts/general/isequal.m	Thu Mar 03 05:18:04 2005 +0000
@@ -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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scripts/general/sortrows.m	Thu Mar 03 05:18:04 2005 +0000
@@ -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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scripts/set/ismember.m	Thu Mar 03 05:18:04 2005 +0000
@@ -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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scripts/set/setdiff.m	Thu Mar 03 05:18:04 2005 +0000
@@ -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
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/scripts/strings/strmatch.m	Thu Mar 03 05:18:04 2005 +0000
@@ -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