changeset 7649:1eac99a280a2

extend dmult to allow scaling arbitrary dimension
author Jaroslav Hajek <highegg@gmail.com>
date Wed, 26 Mar 2008 16:18:23 -0400
parents e7b999840056
children eb7bdde776f2
files scripts/ChangeLog scripts/linear-algebra/dmult.m
diffstat 2 files changed, 69 insertions(+), 14 deletions(-) [+]
line wrap: on
line diff
--- a/scripts/ChangeLog	Wed Mar 26 15:55:20 2008 -0400
+++ b/scripts/ChangeLog	Wed Mar 26 16:18:23 2008 -0400
@@ -1,3 +1,7 @@
+2008-03-26  Jaroslav Hajek <highegg@gmail.com>
+
+	* linear-algebra/dmult.m: Handle scaling along arbitrary dimension.
+
 2008-03-26  Soren Hauberg  <hauberg@gmail.com>
 
 	* polynomial/convn.m: New tests.
--- a/scripts/linear-algebra/dmult.m	Wed Mar 26 15:55:20 2008 -0400
+++ b/scripts/linear-algebra/dmult.m	Wed Mar 26 16:18:23 2008 -0400
@@ -1,5 +1,4 @@
-## Copyright (C) 1995, 1996, 1997, 1998, 2000, 2002, 2004, 2005, 2006,
-##               2007 Kurt Hornik
+## Copyright (C) 2008 VZLU Prague, a.s., Czech Republic
 ##
 ## This file is part of Octave.
 ##
@@ -18,24 +17,76 @@
 ## <http://www.gnu.org/licenses/>.
 
 ## -*- texinfo -*-
-## @deftypefn {Function File} {} dmult (@var{a}, @var{b})
+## @deftypefn {Function File} {@var{c} =} dmult (@var{a}, @var{b})
+## @deftypefnx {Function File} {@var{c} =} dmult (@var{a}, @var{b}, @var{ind})
+## Scale a matrix by rows or columns, or a multidimensional tensor along 
+## a specified dimension.
 ## If @var{a} is a vector of length @code{rows (@var{b})}, return
 ## @code{diag (@var{a}) * @var{b}} (but computed much more efficiently).
+## Similarly, if @var{b} is a vector of length @code{columns(@var{a})},
+## return @code{@var{a} * diag(@var{b})}. 
+##
+## If @var{b} is a multidimensional array and @var{a} a vector,
+## @var{c} will have the same shape as @var{b}, with 
+## @code{@var{C}(i,:,@dots{}) = @var{a}(i)*@var{b}(i,:,@dots{})}.
+##
+## If @var{a} is a multidimensional array and @var{b} a vector,
+## @var{c} will have the same shape as @var{a}, with 
+## @code{@var{C}(:,@dots{},i) = @var{a}(:,@dots{},i)*@var{b}(i)}.
+##
+## If @var{ind} is supplied, @var{a} should be an array and @var{b}
+## a vector of length @code{size (@var{a},index)}. The result is then
+## @code{@var{C}(:,@dots{},i,:,@dots{}) = @var{a}(:,@dots{},i,:,@dots{})*@var{b}(i)}
+## where i indexes the @var{ind}-th dimension.
 ## @end deftypefn
 
-## Author: KH <Kurt.Hornik@wu-wien.ac.at>
-## Description: Rescale the rows of a matrix
+## Author: Jaroslav Hajek <highegg@gmail.com>
+## Description: Scale a tensor along a dimension
+
+### Original Author: KH <Kurt.Hornik@wu-wien.ac.at>
+### Original Description: Rescale the rows of a matrix
 
-function M = dmult (a, B)
+function m = dmult (a, b, ind)
+  if (nargin == 2)
+    sa = size (a);
+    sb = size (b);
+    if (isvector (a) && length (a) == sb(1))
+      a = a(:);
+      m = reshape (kron (ones (prod (sb(2:end)), 1), a), sb) .* b;
+    elseif (isvector (b) && length (b) == sa(end))
+      b = b(:);
+      m = reshape (kron (b, ones (prod (sa (1:end-1)), 1)), sa) .* a;
+    else
+      error ("dmult: dimensions mismatch");
+    endif
 
-  if (nargin != 2)
+  elseif (nargin == 3 && isscalar (ind))
+    if (isvector (b) && ind > 0 && ind <= ndims (a)
+	&& length (b) == size (a, ind))
+      b = b(:);
+      sa = size (a); 
+      sal = prod (sa(1:ind-1)); sat = prod (sa(ind+1:end));
+      s = kron (ones (sat, 1), kron (b, ones (sal, 1)));
+      m = reshape (s, sa) .* a;
+    else
+      error ("dmult: dimensions mismatch or index out of range")
+    endif
+  else
     print_usage ();
   endif
- if (! isvector (a))
-    error ("dmult: a must be a vector of length rows (B)");
-  endif
-  a = a(:);
-  sb = size (B);
-  sb(1) = 1;
-  M = repmat (a(:), sb) .* B;
+
 endfunction
+
+%!test
+%! assert ( dmult ([1,2,3], ones(3)), [1,1,1;2,2,2;3,3,3] )
+%! assert ( dmult ([1,2,3]', ones(3)), [1,1,1;2,2,2;3,3,3] )
+%!test
+%! assert ( dmult ([1,2,3], ones(3,2,2)), reshape ([1,1,1,1;2,2,2,2;3,3,3,3], [3,2,2]) )
+%!test
+%! assert ( dmult (ones(3), [1,2,3]), [1,2,3;1,2,3;1,2,3] )
+%! assert ( dmult (ones(3), [1,2,3]'), [1,2,3;1,2,3;1,2,3] )
+%!test
+%! assert ( dmult (ones(2,2,3), [1,2,3]), reshape ([1,2,3;1,2,3;1,2,3;1,2,3], [2,2,3]) )
+%!test
+%! assert ( dmult (ones(3,4,2), [1 2 3 4], 2),...
+%! reshape ([1 1 1 2 2 2 3 3 3 4 4 4 1 1 1 2 2 2 3 3 3 4 4 4], [3,4,2]) )