Mercurial > hg > octave-nkf
changeset 6926:c05fbb1b7e1f
[project @ 2007-09-26 19:56:54 by dbateman]
author | dbateman |
---|---|
date | Wed, 26 Sep 2007 19:56:55 +0000 |
parents | 1401a79af68c |
children | cf07aa5666cb |
files | PROJECTS libcruft/ChangeLog libcruft/lapack/Makefile.in liboctave/CMatrix.cc liboctave/ChangeLog liboctave/dMatrix.cc src/ChangeLog src/mk-pkg-add src/parse.y |
diffstat | 9 files changed, 136 insertions(+), 96 deletions(-) [+] |
line wrap: on
line diff
--- a/PROJECTS +++ b/PROJECTS @@ -66,7 +66,7 @@ * Consider making the behavior of the / and \ operators for non-square systems compatible with Matlab. Currently, they return - the minimum norm solution from DGELSS, which behaves differently. + the minimum norm solution from DGELSY, which behaves differently. --------------- Sparse Matrices:
--- a/libcruft/ChangeLog +++ b/libcruft/ChangeLog @@ -1,3 +1,15 @@ +2007-09-26 David Bateman <dbateman@free.fr> + + * lapack/dgelsy.f, lapack/dlatrz.f, lapack/zlarz.f, + lapack/dgeqp3.f, lapack/dtzrzf.f, lapack/zlarzt.f, + lapack/dlaic1.f, lapack/zgelsy.f, lapack/zlatrz.f, + lapack/dlaqp2.f, lapack/zgeqp3.f, lapack/ztzrzf.f, + lapack/dlaqps.f, lapack/zlaic1.f, lapack/zunmr3.f, + lapack/dlarzb.f, lapack/zlaqp2.f, lapack/zunmrz.f, + lapack/dlarz.f, lapack/zlaqps.f, lapack/dlarzt.f, + lapack/zlarzb.f: New files + * lapack/Makefile.in (FSRC): Add the new files. + 2007-07-25 David Bateman <dbateman@free.fr> * Makefile.in, Makerules.in, fftpack/Makefile.in,
--- a/libcruft/lapack/Makefile.in +++ b/libcruft/lapack/Makefile.in @@ -15,39 +15,42 @@ EXTERNAL_DISTFILES = $(DISTFILES) FSRC = dbdsqr.f dgbcon.f dgbtf2.f dgbtrf.f dgbtrs.f dgebak.f \ - dgebal.f dgebd2.f dgebrd.f dgecon.f dgeesx.f dgeev.f dgehd2.f \ - dgehrd.f dgelq2.f dgelqf.f dgelss.f dgeqpf.f dgeqr2.f dgeqrf.f \ - dgesv.f dgesvd.f dgetf2.f dgetrf.f dgetri.f dgetrs.f dggbak.f \ - dggbal.f dgghrd.f dgtsv.f dgttrf.f dgttrs.f dhgeqz.f dhseqr.f \ - dlabad.f dlabrd.f dlacon.f dlacpy.f dladiv.f dlae2.f dlaev2.f \ - dlaexc.f dlag2.f dlahqr.f dlahrd.f dlaln2.f dlamc1.f dlamc2.f \ - dlamc3.f dlamc4.f dlamc5.f dlamch.f dlange.f dlanhs.f dlanst.f \ - dlansy.f dlantr.f dlanv2.f dlapy2.f dlapy3.f dlarf.f dlarfb.f \ - dlarfg.f dlarft.f dlarfx.f dlartg.f dlas2.f dlascl.f dlaset.f \ - dlasq1.f dlasq2.f dlasq3.f dlasq4.f dlasq5.f dlasq6.f dlasr.f \ - dlasrt.f dlassq.f dlasv2.f dlaswp.f dlasy2.f dlatbs.f dlatrd.f \ - dlatrs.f dlauu2.f dlauum.f dorg2l.f dorg2r.f dorgbr.f dorghr.f \ - dorgl2.f dorglq.f dorgql.f dorgqr.f dorgtr.f dorm2r.f dormbr.f \ - dorml2.f dormlq.f dormqr.f dpbcon.f dpbtf2.f dpbtrf.f dpbtrs.f \ - dpocon.f dpotf2.f dpotrf.f dpotri.f dpotrs.f dptsv.f dpttrf.f \ - dpttrs.f dptts2.f drscl.f dsteqr.f dsterf.f dsyev.f dsytd2.f \ - dsytrd.f dtgevc.f dtrcon.f dtrevc.f dtrexc.f dtrsen.f dtrsyl.f \ - dtrti2.f dtrtri.f dtrtrs.f dzsum1.f ieeeck.f ilaenv.f izmax1.f \ - spotf2.f spotrf.f zbdsqr.f zdrscl.f zgbcon.f zgbtf2.f zgbtrf.f \ - zgbtrs.f zgebak.f zgebal.f zgebd2.f zgebrd.f zgecon.f zgeesx.f \ - zgeev.f zgehd2.f zgehrd.f zgelq2.f zgelqf.f zgelss.f zgeqpf.f \ - zgeqr2.f zgeqrf.f zgesv.f zgesvd.f zgetf2.f zgetrf.f zgetri.f \ - zgetrs.f zggbal.f zgtsv.f zgttrf.f zgttrs.f zheev.f zhetd2.f \ - zhetrd.f zhseqr.f zlabrd.f zlacgv.f zlacon.f zlacpy.f zladiv.f \ - zlahqr.f zlahrd.f zlange.f zlanhe.f zlanhs.f zlantr.f zlarf.f \ - zlarfb.f zlarfg.f zlarft.f zlarfx.f zlartg.f zlascl.f zlaset.f \ - zlasr.f zlassq.f zlaswp.f zlatbs.f zlatrd.f zlatrs.f zlauu2.f \ - zlauum.f zpbcon.f zpbtf2.f zpbtrf.f zpbtrs.f zpocon.f zpotf2.f \ - zpotrf.f zpotri.f zpotrs.f zptsv.f zpttrf.f zpttrs.f zptts2.f \ - zrot.f zsteqr.f ztrcon.f ztrevc.f ztrexc.f ztrsen.f ztrsyl.f \ - ztrti2.f ztrtri.f ztrtrs.f zung2l.f zung2r.f zungbr.f zunghr.f \ - zungl2.f zunglq.f zungql.f zungqr.f zungtr.f zunm2r.f zunmbr.f \ - zunml2.f zunmlq.f zunmqr.f + dgebal.f dgebd2.f dgebrd.f dgecon.f dgeesx.f dgeev.f dgehd2.f\ + dgehrd.f dgelq2.f dgelqf.f dgelss.f dgelsy.f dgeqp3.f dgeqpf.f \ + dgeqr2.f dgeqrf.f dgesvd.f dgesv.f dgetf2.f dgetrf.f dgetri.f \ + dgetrs.f dggbak.f dggbal.f dgghrd.f dgtsv.f dgttrf.f dgttrs.f \ + dhgeqz.f dhseqr.f dlabad.f dlabrd.f dlacon.f dlacpy.f dladiv.f \ + dlae2.f dlaev2.f dlaexc.f dlag2.f dlahqr.f dlahrd.f dlaic1.f \ + dlaln2.f dlamc1.f dlamc2.f dlamc3.f dlamc4.f dlamc5.f dlamch.f \ + dlange.f dlanhs.f dlanst.f dlansy.f dlantr.f dlanv2.f dlapy2.f \ + dlapy3.f dlaqp2.f dlaqps.f dlarfb.f dlarf.f dlarfg.f dlarft.f \ + dlarfx.f dlartg.f dlarzb.f dlarz.f dlarzt.f dlas2.f dlascl.f \ + dlaset.f dlasq1.f dlasq2.f dlasq3.f dlasq4.f dlasq5.f dlasq6.f \ + dlasr.f dlasrt.f dlassq.f dlasv2.f dlaswp.f dlasy2.f dlatbs.f \ + dlatrd.f dlatrs.f dlatrz.f dlauu2.f dlauum.f dorg2l.f dorg2r.f \ + dorgbr.f dorghr.f dorgl2.f dorglq.f dorgql.f dorgqr.f dorgtr.f \ + dorm2r.f dormbr.f dorml2.f dormlq.f dormqr.f dpbcon.f dpbtf2.f \ + dpbtrf.f dpbtrs.f dpocon.f dpotf2.f dpotrf.f dpotri.f dpotrs.f \ + dptsv.f dpttrf.f dpttrs.f dptts2.f drscl.f dsteqr.f dsterf.f \ + dsyev.f dsytd2.f dsytrd.f dtgevc.f dtrcon.f dtrevc.f dtrexc.f \ + dtrsen.f dtrsyl.f dtrti2.f dtrtri.f dtrtrs.f dtzrzf.f dzsum1.f \ + ieeeck.f ilaenv.f izmax1.f spotf2.f spotrf.f zbdsqr.f zdrscl.f \ + zgbcon.f zgbtf2.f zgbtrf.f zgbtrs.f zgebak.f zgebal.f zgebd2.f \ + zgebrd.f zgecon.f zgeesx.f zgeev.f zgehd2.f zgehrd.f zgelq2.f \ + zgelqf.f zgelss.f zgelsy.f zgeqp3.f zgeqpf.f zgeqr2.f zgeqrf.f \ + zgesvd.f zgesv.f zgetf2.f zgetrf.f zgetri.f zgetrs.f zggbal.f \ + zgtsv.f zgttrf.f zgttrs.f zheev.f zhetd2.f zhetrd.f zhseqr.f \ + zlabrd.f zlacgv.f zlacon.f zlacpy.f zladiv.f zlahqr.f zlahrd.f \ + zlaic1.f zlange.f zlanhe.f zlanhs.f zlantr.f zlaqp2.f zlaqps.f \ + zlarfb.f zlarf.f zlarfg.f zlarft.f zlarfx.f zlartg.f zlarzb.f \ + zlarz.f zlarzt.f zlascl.f zlaset.f zlasr.f zlassq.f zlaswp.f \ + zlatbs.f zlatrd.f zlatrs.f zlatrz.f zlauu2.f zlauum.f zpbcon.f \ + zpbtf2.f zpbtrf.f zpbtrs.f zpocon.f zpotf2.f zpotrf.f zpotri.f \ + zpotrs.f zptsv.f zpttrf.f zpttrs.f zptts2.f zrot.f zsteqr.f \ + ztrcon.f ztrevc.f ztrexc.f ztrsen.f ztrsyl.f ztrti2.f ztrtri.f \ + ztrtrs.f ztzrzf.f zung2l.f zung2r.f zungbr.f zunghr.f zungl2.f \ + zunglq.f zungql.f zungqr.f zungtr.f zunm2r.f zunmbr.f zunml2.f \ + zunmlq.f zunmqr.f zunmr3.f zunmrz.f include $(TOPDIR)/Makeconf
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -120,9 +120,9 @@ F77_CHAR_ARG_LEN_DECL); F77_RET_T - F77_FUNC (zgelss, ZGELSS) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, + F77_FUNC (zgelsy, ZGELSY) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, Complex*, const octave_idx_type&, Complex*, - const octave_idx_type&, double*, double&, octave_idx_type&, + const octave_idx_type&, octave_idx_type*, double&, octave_idx_type&, Complex*, const octave_idx_type&, double*, octave_idx_type&); F77_RET_T @@ -2448,43 +2448,40 @@ Complex *presult = result.fortran_vec (); - octave_idx_type len_s = m < n ? m : n; - Array<double> s (len_s); - double *ps = s.fortran_vec (); + Array<octave_idx_type> jpvt (n); + octave_idx_type *pjpvt = jpvt.fortran_vec (); double rcond = -1.0; - octave_idx_type lrwork = (5 * (m < n ? m : n)) - 4; - lrwork = lrwork > 1 ? lrwork : 1; - Array<double> rwork (lrwork); + Array<double> rwork (2 * n); double *prwork = rwork.fortran_vec (); - // Ask ZGELSS what the dimension of WORK should be. + // Ask ZGELSY what the dimension of WORK should be. octave_idx_type lwork = -1; Array<Complex> work (1); - F77_XFCN (zgelss, ZGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, + F77_XFCN (zgelsy, ZGELSY, (m, n, nrhs, tmp_data, m, presult, + nrr, pjpvt, rcond, rank, work.fortran_vec (), lwork, prwork, info)); if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in zgelss"); + (*current_liboctave_error_handler) ("unrecoverable error in zgelsy"); else { lwork = static_cast<octave_idx_type> (std::real (work(0))); work.resize (lwork); - F77_XFCN (zgelss, ZGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, + F77_XFCN (zgelsy, ZGELSY, (m, n, nrhs, tmp_data, m, presult, + nrr, pjpvt, rcond, rank, work.fortran_vec (), lwork, prwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) - ("unrecoverable error in zgelss"); + ("unrecoverable error in zgelsy"); else { retval.resize (n, nrhs); @@ -2563,43 +2560,40 @@ Complex *presult = result.fortran_vec (); - octave_idx_type len_s = m < n ? m : n; - Array<double> s (len_s); - double *ps = s.fortran_vec (); + Array<octave_idx_type> jpvt (n); + octave_idx_type *pjpvt = jpvt.fortran_vec (); double rcond = -1.0; - octave_idx_type lrwork = (5 * (m < n ? m : n)) - 4; - lrwork = lrwork > 1 ? lrwork : 1; - Array<double> rwork (lrwork); + Array<double> rwork (2 * n); double *prwork = rwork.fortran_vec (); - // Ask ZGELSS what the dimension of WORK should be. + // Ask ZGELSY what the dimension of WORK should be. octave_idx_type lwork = -1; Array<Complex> work (1); - F77_XFCN (zgelss, ZGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, + F77_XFCN (zgelsy, ZGELSY, (m, n, nrhs, tmp_data, m, presult, + nrr, pjpvt, rcond, rank, work.fortran_vec (), lwork, prwork, info)); if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in zgelss"); + (*current_liboctave_error_handler) ("unrecoverable error in zgelsy"); else { lwork = static_cast<int> (std::real (work(0))); work.resize (lwork); - F77_XFCN (zgelss, ZGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, + F77_XFCN (zgelsy, ZGELSY, (m, n, nrhs, tmp_data, m, presult, + nrr, pjpvt, rcond, rank, work.fortran_vec (), lwork, prwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) - ("unrecoverable error in zgelss"); + ("unrecoverable error in zgelsy"); else { retval.resize (n);
--- a/liboctave/ChangeLog +++ b/liboctave/ChangeLog @@ -1,3 +1,9 @@ +2007-09-26 David Bateman <dbateman@free.fr> + + * dMatrix.cc (lssolve): Replace the use of xGELSS with xGELSY with + is much faster and no less accurate. + * CMatrix.cc (lssolve): ditto. + 2007-09-25 David Bateman <dbateman@free.fr> * dMatrix.cc (utsolve, ltsolve, fsolve, lssolve): Allow
--- a/liboctave/dMatrix.cc +++ b/liboctave/dMatrix.cc @@ -117,9 +117,9 @@ F77_CHAR_ARG_LEN_DECL); F77_RET_T - F77_FUNC (dgelss, DGELSS) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, + F77_FUNC (dgelsy, DGELSY) (const octave_idx_type&, const octave_idx_type&, const octave_idx_type&, double*, const octave_idx_type&, double*, - const octave_idx_type&, double*, double&, octave_idx_type&, + const octave_idx_type&, octave_idx_type*, double&, octave_idx_type&, double*, const octave_idx_type&, octave_idx_type&); F77_RET_T @@ -2072,36 +2072,35 @@ double *presult = result.fortran_vec (); - octave_idx_type len_s = m < n ? m : n; - Array<double> s (len_s); - double *ps = s.fortran_vec (); + Array<octave_idx_type> jpvt (n); + octave_idx_type *pjpvt = jpvt.fortran_vec (); double rcond = -1.0; - // Ask DGELSS what the dimension of WORK should be. + // Ask DGELSY what the dimension of WORK should be. octave_idx_type lwork = -1; Array<double> work (1); - F77_XFCN (dgelss, DGELSS, (m, n, nrhs, tmp_data, m, presult, nrr, ps, + F77_XFCN (dgelsy, DGELSY, (m, n, nrhs, tmp_data, m, presult, nrr, pjpvt, rcond, rank, work.fortran_vec (), lwork, info)); if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in dgelss"); + (*current_liboctave_error_handler) ("unrecoverable error in dgelsy"); else { lwork = static_cast<octave_idx_type> (work(0)); work.resize (lwork); - F77_XFCN (dgelss, DGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, + F77_XFCN (dgelsy, DGELSY, (m, n, nrhs, tmp_data, m, presult, + nrr, pjpvt, rcond, rank, work.fortran_vec (), lwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) - ("unrecoverable error in dgelss"); + ("unrecoverable error in dgelsy"); else { retval.resize (n, nrhs); @@ -2182,36 +2181,35 @@ double *presult = result.fortran_vec (); - octave_idx_type len_s = m < n ? m : n; - Array<double> s (len_s); - double *ps = s.fortran_vec (); + Array<octave_idx_type> jpvt (n); + octave_idx_type *pjpvt = jpvt.fortran_vec (); double rcond = -1.0; - // Ask DGELSS what the dimension of WORK should be. + // Ask DGELSY what the dimension of WORK should be. octave_idx_type lwork = -1; Array<double> work (1); - F77_XFCN (dgelss, DGELSS, (m, n, nrhs, tmp_data, m, presult, nrr, ps, + F77_XFCN (dgelsy, DGELSY, (m, n, nrhs, tmp_data, m, presult, nrr, pjpvt, rcond, rank, work.fortran_vec (), lwork, info)); if (f77_exception_encountered) - (*current_liboctave_error_handler) ("unrecoverable error in dgelss"); + (*current_liboctave_error_handler) ("unrecoverable error in dgelsy"); else { lwork = static_cast<octave_idx_type> (work(0)); work.resize (lwork); - F77_XFCN (dgelss, DGELSS, (m, n, nrhs, tmp_data, m, presult, - nrr, ps, rcond, rank, + F77_XFCN (dgelsy, DGELSY, (m, n, nrhs, tmp_data, m, presult, + nrr, pjpvt, rcond, rank, work.fortran_vec (), lwork, info)); if (f77_exception_encountered) (*current_liboctave_error_handler) - ("unrecoverable error in dgelss"); + ("unrecoverable error in dgelsy"); else { retval.resize (n);
--- a/src/ChangeLog +++ b/src/ChangeLog @@ -15,6 +15,10 @@ * ov-range.h (sparse_matrix_value, sparse_complex_matrix_value): New methods. + * mk-pkg-add: Simplfy the autoload commands. + * parse.y (Fautoload): Allow bare filename if file is in the same + directory as the script from where the autoload command is run. + 2007-09-25 Matthias Drochner <m.drochner@fz-juelich.de> * syscalls.cc (Fpopen2): Doc fix.
--- a/src/mk-pkg-add +++ b/src/mk-pkg-add @@ -16,7 +16,7 @@ if [ "$n" = "$base" ]; then true else - echo "autoload (\"$n\", fullfile (fileparts (mfilename (\"fullpath\")), \"$base.oct\"));" + echo "autoload (\"$n\", \"$base.oct\");" fi done fi
--- a/src/parse.y +++ b/src/parse.y @@ -3485,28 +3485,29 @@ @deftypefn {Built-in Function} {} autoload (@var{function}, @var{file})\n\ Define @var{function} to autoload from @var{file}.\n\ \n\ -The second argument, @var{file}, should be an absolute file name and\n\ -should not depend on the Octave load path.\n\ +The second argument, @var{file}, should be an absolute file name or\n\ +a file name in the same directory as the function or script from which\n\ +the autoload command was run. @var{file} should not depend on the\n\ +Octave load path.\n\ \n\ Normally, calls to @code{autoload} appear in PKG_ADD script files that\n\ are evaluated when a directory is added to the Octave's load path. To\n\ -avoid having to hardcode directory names in @var{file}, it is customary\n\ -to use\n\ +avoid having to hardcode directory names in @var{file}, if @var{file}\n\ +is in the same directory as the PKG_ADD script then\n\ \n\ @example\n\ -autoload (\"foo\",\n\ - fullfile (fileparts (mfilename (\"fullpath\")),\n\ - \"bar.oct\"));\n\ +autoload (\"foo\", \"bar.oct\");\n\ @end example\n\ \n\ -Uses like\n\ +will load the function @code{foo} from the file @code{bar.oct}. The above\n\ +when @code{bar.oct} is not in the same directory or uses like\n\ \n\ @example\n\ autoload (\"foo\", file_in_loadpath (\"bar.oct\"))\n\ @end example\n\ \n\ @noindent\n\ -are strongly discouraged.\n\ +are strongly discouraged, as their behavior might be unpredictable.\n\ \n\ With no arguments, return a structure containing the current autoload map.\n\ @seealso{PKG_ADD}\n\ @@ -3547,10 +3548,32 @@ std::string nm = argv[2]; if (! octave_env::absolute_pathname (nm)) - warning_with_id ("Octave:autoload-relative-file-name", - "autoload: `%s' is not an absolute file name", - nm.c_str ()); - + { + octave_function *fcn = + octave_call_stack::caller_user_script_or_function (); + bool found = false; + if (fcn) + { + std::string fname = fcn->fcn_file_name (); + if (! fname.empty ()) + { + fname = octave_env::make_absolute (fname, + octave_env::getcwd ()); + fname = fname.substr (0, + fname.find_last_of (file_ops::dir_sep_str) + 1); + file_stat fs (fname + nm); + if (fs.exists ()) + { + nm = fname + nm; + found = true; + } + } + } + if (! found) + warning_with_id ("Octave:autoload-relative-file-name", + "autoload: `%s' is not an absolute file name", + nm.c_str ()); + } autoload_map[argv[1]] = nm; } }