Mercurial > octave-nkf

changeset 3910:79a90a0f0eff

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[project @ 2002-04-25 05:36:52 by jwe]
author jwe
date Thu, 25 Apr 2002 05:36:53 +0000
parents e54140b9ebe1
children 8389e78e67d4
files scripts/ChangeLog scripts/linear-algebra/kron.m src/ChangeLog src/DLD-FUNCTIONS/kron.cc src/Makefile.in
diffstat 5 files changed, 131 insertions(+), 68 deletions(-) [+]
line wrap: on
line diff
--- a/scripts/ChangeLog	Wed Apr 24 21:26:40 2002 +0000
+++ b/scripts/ChangeLog	Thu Apr 25 05:36:53 2002 +0000
@@ -1,3 +1,7 @@
+2002-04-25  John W. Eaton  <jwe@bevo.che.wisc.edu>
+
+	* linear-algebra/kron.m: Delete.
+
 2002-04-24  Paul Kienzle <pkienzle@users.sf.net>
 
 	* signal/freqz.m: If nargout is zero, plot results instead of
--- a/scripts/linear-algebra/kron.m	Wed Apr 24 21:26:40 2002 +0000
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,66 +0,0 @@
-## Copyright (C) 1996, 1997 John W. Eaton
-##
-## This file is part of Octave.
-##
-## Octave 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, or (at your option)
-## any later version.
-##
-## Octave 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 Octave; see the file COPYING.  If not, write to the Free
-## Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-## 02111-1307, USA.
-
-## -*- texinfo -*-
-## @deftypefn {Function File} {} kron (@var{a}, @var{b})
-## Form the kronecker product of two matrices, defined block by block as
-##
-## @example
-## x = [a(i, j) b]
-## @end example
-##
-## For example,
-##
-## @example
-## @group
-## kron (1:4, ones (3, 1))
-##      @result{}  1  2  3  4
-##          1  2  3  4
-##          1  2  3  4
-## @end group
-## @end example
-## @end deftypefn
-
-## Author: A. S. Hodel <scotte@eng.auburn.edu>
-## Created: August 1993
-## Adapted-By: jwe
-
-function x = kron (a, b)
-
-  if (nargin == 2)
-
-    [m, n] = size (b);
-    [ma, na] = size (a);
-
-    x = zeros (ma*m, na*n);
-    i_vec = 1:m;
-    j_vec = 1:n;
-
-    for jj = 1:na
-      for ii = 1:ma
-        x(i_vec+(ii-1)*m,j_vec) = a(ii,jj) * b;
-      endfor
-      j_vec = j_vec + n;
-    endfor
-
-  else
-    usage ("kron (a, b)");
-  endif
-
-endfunction
--- a/src/ChangeLog	Wed Apr 24 21:26:40 2002 +0000
+++ b/src/ChangeLog	Thu Apr 25 05:36:53 2002 +0000
@@ -1,3 +1,8 @@
+2002-04-25  Paul Kienzle <pkienzle@users.sf.net>
+
+	* DLD-FUNCTIONS/kron.cc: New file.
+	* Makefile.in (DLD_SRC): Add it to the list.
+
 2002-04-22  John W. Eaton  <jwe@bevo.che.wisc.edu>
 
 	* parse.y (save_symtab): New non-terminal.  Save current symbol
@@ -54,7 +59,7 @@
 	* DLD-FUNCTIONS/qz.cc: Likewise.
 	* DLD-FUNCTIONS/rand.cc: Likewise.
 	* octave.cc: Likewise.
-	* src/toplev.cc (Foctave_config_info): Delete use of FORTRAN_MAIN_FLAG.
+	* toplev.cc (Foctave_config_info): Delete use of FORTRAN_MAIN_FLAG.
 	* oct-conf.h.in: Delete use of OCTAVE_CONF_FORTRAN_MAIN_FLAG.
 	* syscalls.cc (mk_stat_map):
 	Use HAVE_STRUCT_STAT_ST_RDEV instead of HAVE_ST_RDEV.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/DLD-FUNCTIONS/kron.cc	Thu Apr 25 05:36:53 2002 +0000
@@ -0,0 +1,120 @@
+/*
+
+Copyright (C) 2002 Paul Kienzle
+
+This file is part of Octave.
+
+Octave 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, or (at your option) any
+later version.
+
+Octave 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 Octave; see the file COPYING.  If not, write to the Free
+Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
+
+*/
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+
+#include "dMatrix.h"
+#include "CMatrix.h"
+
+#include "defun-dld.h"
+#include "error.h"
+#include "oct-obj.h"
+
+#if !defined (CXX_NEW_FRIEND_TEMPLATE_DECL)
+extern void
+kron (const Array2<double>&, const Array2<double>&, Array2<double>&);
+
+extern void
+kron (const Array2<Complex>&, const Array2<Complex>&, Array2<Complex>&);
+#endif
+
+template <class T>
+void
+kron (const Array2<T>& A, const Array2<T>& B, Array2<T>& C)
+{
+  C.resize (A.rows () * B.rows (), A.columns () * B.columns ());
+
+  int Ac, Ar, Cc, Cr;
+
+  for (Ac = Cc = 0; Ac < A.columns (); Ac++, Cc += B.columns ())
+    for (Ar = Cr = 0; Ar < A.rows (); Ar++, Cr += B.rows ())
+      {
+	const T v = A (Ar, Ac);
+	for (int Bc = 0; Bc < B.columns (); Bc++)
+	  for (int Br = 0; Br < B.rows (); Br++)
+	    C.xelem (Cr+Br, Cc+Bc) = v * B.elem (Br, Bc);
+      }
+}
+
+template void
+kron (const Array2<double>&, const Array2<double>&, Array2<double>&);
+
+template void
+kron (const Array2<Complex>&, const Array2<Complex>&, Array2<Complex>&);
+
+DEFUN_DLD (kron, args,  nargout, "-*- texinfo -*-\n\
+@deftypefn {Function File} {} kron (@var{a}, @var{b})\n\
+Form the kronecker product of two matrices, defined block by block as\n\
+\n\
+@example\n\
+x = [a(i, j) b]\n\
+@end example\n\
+\n\
+For example,\n\
+\n\
+@example\n\
+@group\n\
+kron (1:4, ones (3, 1))\n\
+      @result{}  1  2  3  4\n\
+          1  2  3  4\n\
+          1  2  3  4\n\
+@end group\n\
+@end example\n\
+@end deftypefn")
+{
+  octave_value_list retval;
+
+  int nargin = args.length ();
+
+  if (nargin != 2 || nargout > 1)
+    {
+      print_usage ("kron");
+    }
+  else if (args(0).is_complex_type () || args(1).is_complex_type ())
+    {
+      ComplexMatrix a (args(0).complex_matrix_value());
+      ComplexMatrix b (args(1).complex_matrix_value());
+
+      if (! error_state)
+	{
+	  ComplexMatrix c;
+	  kron (a, b, c);
+	  retval(0) = c;
+	}
+    }
+  else
+    {
+      Matrix a (args(0).matrix_value ());
+      Matrix b (args(1).matrix_value ());
+
+      if (! error_state)
+	{
+	  Matrix c;
+	  kron (a, b, c);
+	  retval (0) = c;
+	}
+    }
+
+  return retval;
+}
--- a/src/Makefile.in	Wed Apr 24 21:26:40 2002 +0000
+++ b/src/Makefile.in	Thu Apr 25 05:36:53 2002 +0000
@@ -42,7 +42,7 @@
 DLD_XSRC := balance.cc besselj.cc betainc.cc chol.cc colloc.cc dassl.cc \
 	det.cc eig.cc expm.cc fft.cc fft2.cc filter.cc find.cc \
 	fsolve.cc gammainc.cc getgrent.cc getpwent.cc getrusage.cc \
-	givens.cc hess.cc ifft.cc ifft2.cc inv.cc log.cc lpsolve.cc \
+	givens.cc hess.cc ifft.cc ifft2.cc inv.cc kron.cc log.cc lpsolve.cc \
 	lsode.cc lu.cc minmax.cc pinv.cc qr.cc quad.cc qz.cc rand.cc \
 	schur.cc sort.cc svd.cc syl.cc time.cc