changeset 2959:610db3cb68da octave-forge

apply.m: uses feval to apply(func_handle,{arg1,arg2, .. .argn}); map.m: modified to work with function handles, and uses apply removing older eval code
author gnumuthu
date Tue, 23 Jan 2007 18:18:42 +0000
parents 84bd7e213e56
children 13356b38f959
files main/miscellaneous/inst/apply.m main/miscellaneous/inst/map.m
diffstat 2 files changed, 184 insertions(+), 71 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/main/miscellaneous/inst/apply.m	Tue Jan 23 18:18:42 2007 +0000
@@ -0,0 +1,96 @@
+## Copyright (C) 2007, Muthiah Annamalai
+##
+## Apply function like in LISP. Pass a (row only)cell-array of arguments,
+## supplied on invoking the function.
+##
+## 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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
+##
+
+## -*- texinfo -*-
+## @deftypefn {Loadable Function} {@var{return_value} =} apply (@var{@@function_handle},@var{cell_array_of_args})
+## @deftypefnx {Loadable Function} {@var{return_value} =} apply (@var{@@function_handle})
+## Apply calls the function @var{function_handle} with the arguments of the cell
+## array @var{cell_array_of_args} which contains the actual arguments arg1,arg2,..., argn
+## to the function, in that order. Apply invokes the function as
+## @var{function_handle}(arg1, arg2, ... ,argn), where the arguments are 
+## extracted from each elements of the 1-row cell array @var{cell_array_of_args}. 
+##
+## Apply also works on array of function handles if
+## @var{function_handle} is passed as a cell array of a handles; in this
+## case apply, evaluates each function (using the handle) with the same
+## arguments.
+##
+## The cell-array argument is optional second argument, in the form
+## of a 1-row with multiple elements. The elements of the cell-array 
+## form the actual arguments supplied when invoking the  function @var{function_handle}.
+##
+## The return value depends on the function invoked, and the validity of
+## the arguments.
+##
+## @example
+##   z=apply(@@sqrt,cell([1,2; 3,4]));
+##   z=apply(@@apply,cell(@@sqrt,cell([1,2; 3,4])));
+##   apply(@@sum,cell([1,2,3,4]))
+##   apply(@@max,cell([1,2,3,4]))
+##   apply(@@min,cell([1,2,3,4]))
+## @end example
+##
+##
+## In first case, apply computes the sqrt of the matrix [1,2; 3,4];
+## The second example is meta-apply, using apply on itself.
+## The rest of the examples invoke sum, max, min respectively.
+## @end deftypefn
+##
+
+function rval=apply(fun_handle,cell_array)
+
+  if (nargin == 0)
+    print_usage();
+    error("apply(): needs at least 1 argument, see usage");
+  elseif( nargin < 2)
+    if iscell(fun_handle)
+      for idx=1:length(fun_handle)
+	rval(idx)=feval(@feval,fun_handle{idx});
+      end
+    else
+      rval=feval(@feval,fun_handle);
+    end
+    return
+  elseif(!iscell(cell_array))
+    error("apply(): needs second argument, to be a cell-array");
+  end
+
+  
+  if iscell(fun_handle)
+    for idx=1:length(fun_handle)
+      rval(idx)=feval(@feval,fun_handle{idx},cell_array{:});
+    end
+    return
+  end
+
+  rval=feval(@feval,fun_handle,cell_array{:});
+end
+%!
+%!assert(apply({@min, @max, @mean},{[1:10]}),[ 1.0000 ,10.0000 ,5.5000])
+%!assert(apply(@min,{[1,2,3,4]}),1)
+%!assert(apply(@dot,{[1,2],[3,4]}),11)
+%!assert(apply(@min,{[1, 3]}),1)
+%!assert(apply(@sum,{[1:10]}),55)
+%!assert(apply(@sqrt,{[1,2; 3,4]}),sqrt([1,2;3,4]))
+%!assert(apply(@apply,{@sqrt,{[1,2; 3,4]}}),sqrt([1,2;3,4]))
+%!assert(apply(@sum,{[1,2,3,4]}),10)
+%!assert(apply(@max,{[1,2,3,4]}),4)
+%!assert(apply(@min,{[1,2,3,4]}),1)
+%!
--- a/main/miscellaneous/inst/map.m	Sun Jan 21 21:15:52 2007 +0000
+++ b/main/miscellaneous/inst/map.m	Tue Jan 23 18:18:42 2007 +0000
@@ -1,4 +1,5 @@
 ## Copyright (C) 2003 Tomer Altman
+## Copyright (C) 2007 Muthiah Annamalai
 ##
 ## This program is free software; you can redistribute it and/or
 ## modify it under the terms of the GNU General Public
@@ -16,15 +17,16 @@
 ## write to the Free Software Foundation, 59 Temple Place -
 ## Suite 330, Boston, MA 02111-1307, USA.
 
-## usage: result = map ( FUN_STR, ARG1, ... )
+## usage: result = map ( FUN_HANDLE, ARG1, ... )
 ##
-## map, like LISP's ( & numerous other language's ) function for
+## map, like Lisp's ( & numerous other language's ) function for
 ## iterating the result of a function applied to each of the data
 ## structure's elements in turn. The results are stored in the
 ## corresponding input's place. For now, just will work with cells and
 ## matrices, but support for structs are intended for future versions.
 ## Also, only "prefix" functions ( like "min(a,b,c,...)" ) are
-## supported.
+## supported. FUN_HANDLE can either be a function name string or a
+## function handle (recommended).
 ##
 ## Example:
 ##
@@ -44,7 +46,7 @@
 ##   [1,2] = 0.16765
 ##   [2,2] = 0.85477
 ## }
-## octave> map("min",A,B)
+## octave> map(@min,A,B)
 ## ans =
 ## {
 ##   [1,1] = 0.0096243
@@ -59,83 +61,98 @@
 ## Created: November 15, 2003
 ## Version: 0.1
 
-function return_type = map (fun_str,data_struct,varargin)
+## Last Modified by Muthiah Annamalai
+
+function return_type = map (fun_handle,data_struct,varargin)
   
-  if (nargin<2)
+  if (nargin >= 1)
 
-    error("map: incorrect number of arguments; expecting at least two.");
+    try
+      if ( ischar(fun_handle) )
+	fun_handle=eval(strcat("@",fun_handle));
+      end
+      fstr=typeinfo(fun_handle);
+    catch
+      error('Error: Cannot find function handle, or funtion doesnt exist')
+    end
+  end
 
-  elseif ( !ischar(fun_str) )
-
-    error("map: first argument must be a string: ", fun_str);
+  if (nargin<2)
+    error("map: incorrect number of arguments; expecting at least two.");
+  elseif ( strcmp(fstr,"function handle")==0 )
+    error("map: first argument is not a valid function handle ");
+  elseif ( !( isnumeric(data_struct) || iscell(data_struct) ) )
+    error("map: second argument must be either a matrix or a cell object:");
+  end
 
-  elseif ( !exist(fun_str) )
-
-    error("map: first argument is not a valid function name.");
+  [ rows, cols ] = size(data_struct);
+  typecell=0;
+  
+  if ( iscell(data_struct) )
+    typecell=1;
+    return_type = cell(rows,cols);
+  else
+    typecell=0;
+    return_type = zeros(rows,cols);
+  endif
+  
+  otherdata = length(varargin);
+  val{1:otherdata+1}=0;
 
-  elseif ( !( isnumeric(data_struct) || iscell(data_struct) ) )
-
-    error("map: second argument must be either a matrix or a cell object:");
-
+  if(typecell)
+    
+    if(otherdata >= 1)
+      
+      for i=1:rows	  
+	for j=1:cols
+	  val{1}=data_struct{i,j};
+	  for idx=2:otherdata+1
+	    val{idx}=varargin{idx-1}{i,j};
+	  end
+  	  return_type{i,j}=apply(fun_handle,val);
+	end
+      end
+      
+    else
+      
+      for i=1:rows	  
+	for j=1:cols	    
+	  return_type{i,j}=fun_handle(data_struct{i,j});
+	end
+      end
+      
+    end
+    
   else
-
-    [ rows, cols ] = size(data_struct);
-
-    if ( iscell(data_struct) )
-
-      index_str = "{i,j}";
-
-      return_type = cell(rows,cols);
+    
+    if(otherdata >= 1)
+      
+      for i=1:rows
+	for j=1:cols
+	  val{1}=data_struct(i,j);
+	  for idx=2:otherdata+1
+	    val{idx}=varargin{idx-1}(i,j);
+	  end
+  	  return_type(i,j)=apply(fun_handle,val);
+	end
+      end
 
     else
 
-      index_str = "(i,j)";
-
-      return_type = zeros(rows,cols);
-
-    endif
-      
-    ## List-o-infix-operators: +, -, /, *, &, &&, |, ||, \, ^, **, <, <=,
-    ## >, >=, ==, !=, ~=, <>, = 
+      for i=1:rows
+	for j=1:cols
+	  return_type(i,j)=fun_handle(data_struct(i,j));
+	end
+      end
 
-    for i=1:rows
-	
-      for j=1:cols
-	
-	##return_type{i,j} = feval( fun_str, data_struct{i,j} );
-	
-	LHS = ["return_type",index_str," = "];
-	
-	funcall = [fun_str, " ( "];
-	
-	data = ["data_struct",index_str];
-	
-	otherdata = length(varargin);
-	
-	for k=1:(otherdata-1)
-	  
-	  data = [data,", varargin{",int2str(k),"}",index_str];
-	  
-	endfor
-        
-        if otherdata != 0
-          data = [data,", varargin{",int2str(otherdata),"}",index_str];
-        endif
-        
-        data = [data," ); "];
-	
-	map_str = [LHS,funcall,data];
+    end
 
-	error_str = ["error(\"map: ",error_text,"\" )"];
-	
-	eval(map_str,error_str);
-		 
-      endfor
-
-    endfor
-
-    data_struct = {};
-
-  endif
+  end
 
 endfunction
+%!
+%!assert(map(@min,[1 2 3 4 5],[5 4 3 2 1]), [1 2 3 2 1])
+%!assert(map(@min,rand(1,5),[0 0 0 0 0]), [0 0 0 0 0])
+%!assert(map(@(x,y) (sin(x).^2 + cos(y).^2),-pi:0.5:+pi,-pi:0.5:+pi),ones(1,13))
+%!assert(map(@(x,y) (sin(x).^2 + cos(y).^2),-pi:0.5:+pi,-pi:0.5:+pi),ones(1,13))
+%!