# HG changeset patch # User Jordi Gutiérrez Hermoso # Date 1336020744 14400 # Node ID e4d380c01dcfca99e0ca707d93438017214e0563 # Parent fa52c6e84ae0cf4828e4abf1b8f3d6f2c4777f16# Parent f4acb362b5130c56177a603f0c95e0c22bd2ecc4 maint: Periodic merge of default to gui diff --git a/.hgtags b/.hgtags --- a/.hgtags +++ b/.hgtags @@ -62,3 +62,5 @@ 95c43fc8dbe1a07a46fefb3372df5b2309d874fd rc-3-6-1-0 0000000000000000000000000000000000000000 release-3-2-4 e320928eeb3aa2370b792e83dafc3e0ddecdc871 release-3-2-4 +ba4d6343524b406b0d15aee34579f80783581c54 release-3-6-1 +704f7895eef03008dd79848eb9da4bfb40787d73 release-3-6-0 diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -6,6 +6,59 @@ Summary of important user-visible changes for version 3.8: --------------------------------------------------------- + ** Octave now supports nested functions with scoping rules that are + compatible with Matlab. A nested function is one declared and defined + within the body of another function. The nested function is only + accessible from within the enclosing function which makes it one + method for making private functions whose names do not conflict with those + in the global namespace (See also subfunctions and private functions). + In addition, variables in the enclosing function are visible within the + nested function. This makes it possible to have a pseudo-global variable + which can be seen by a group of functions, but which is not visible in + the global namespace. + + Example: + function outerfunc (...) + ... + function nested1 (...) + ... + function nested2 (...) + ... + endfunction + endfunction + + function nested3 (...) + ... + endfunction + endfunction + + ** 'emptymatch', 'noemptymatch' options added to regular expressions. + + With this addition Octave now accepts the entire set of Matlab options + for regular expressions. 'noemptymatch' is the default, but 'emptymatch' + has certain uses where you need to match an assertion rather than actual + characters. For example, + + regexprep ('World', '^', 'Hello ', 'emptymatch') + => Hello World + + where the pattern is actually the assertion '^' or start-of-line. + + ** For compatibility with Matlab, the regexp, regexpi, and regexprep + functions now process backslash escapes in single-quoted pattern + strings. In addition, the regexprep function now processes backslash + escapes in single-quoted replacement strings. + + ** Redundant terminal comma accepted by parser + + A redundant terminal comma is now accepted in matrix + definitions which allows writing code such as + + [a,... + b,... + c,... + ] = deal (1,2,3) + ** Warning IDs renamed: Octave:array-as-scalar => Octave:array-to-scalar @@ -13,9 +66,10 @@ ** Other new functions added in 3.8.0: - colorcube - lines - rgbplot + colorcube splinefit + lines tetramesh + rgbplot shrinkfaces + findfigs ** Deprecated functions. diff --git a/build-aux/common.mk b/build-aux/common.mk --- a/build-aux/common.mk +++ b/build-aux/common.mk @@ -90,6 +90,8 @@ F77_APPEND_UNDERSCORE=@F77_TOLOWER@ F77_APPEND_EXTRA_UNDERSCORE=@F77_TOLOWER@ +F77_ISNAN_MACRO=@F77_ISNAN_MACRO@ + X11_INCFLAGS = @X11_INCFLAGS@ X11_LIBS = @X11_LIBS@ diff --git a/configure.ac b/configure.ac --- a/configure.ac +++ b/configure.ac @@ -196,7 +196,6 @@ AC_MSG_WARN([$warn_docs]) fi], []) AC_SUBST(DOCDIR) -AM_CONDITIONAL([AMCOND_BUILD_DOCS], [test -n "$DOCDIR"]) ### If possible, use a 64-bit integer type for array dimensions and indexing. @@ -593,6 +592,14 @@ AC_MSG_ERROR([in order to build octave, you must have a compatible Fortran compiler or wrapper script for f2c that functions as a Fortran compiler installed and in your path. See the file INSTALL for more information.]) fi +OCTAVE_CHECK_FORTRAN_HAVE_ISNAN +F77_ISNAN_MACRO= +if test "x$octave_cv_fortran_have_isnan" = xno; then + AC_MSG_NOTICE([substituting ISNAN(X) with X.NE.X in fortran sources]) + F77_ISNAN_MACRO="s|ISNAN(\(@<:@^)@:>@*\))|(\1.NE.\1)|" +fi +AC_SUBST(F77_ISNAN_MACRO) + OCTAVE_CHECK_FORTRAN_INTEGER_SIZE if test "x$octave_cv_fortran_integer_size" = xno; then if $USE_64_BIT_IDX_T; then @@ -2109,7 +2116,7 @@ AC_LANG_PROGRAM([ #include ], [ - std::unordered_map m; + std::unordered_map m; ])], [], [unordered_map_requires_tr1_namespace=yes]) elif test "$ac_cv_header_tr1_unordered_map" = "yes"; then unordered_map_requires_tr1_namespace=yes @@ -2407,6 +2414,16 @@ OCTAVE_PROG_TEXI2DVI OCTAVE_PROG_TEXI2PDF +### Need to disable building documentation if gnuplot was not found, +### unless it was already disabled previously. + +if test -n "$DOCDIR" && test -n "$warn_gnuplot"; then + DOCDIR= + warn_docs="building documentation disabled because gnuplot was not found; make dist will fail" + AC_MSG_WARN([$warn_docs]) +fi +AM_CONDITIONAL([AMCOND_BUILD_DOCS], [test -n "$DOCDIR"]) + ### Even though we include config.h, we need to have the preprocessor ### defines available in a variable for the testif feature of the ### scripts/testfun/test.m function. Use UGLY_DEFS to hold all the -D diff --git a/doc/interpreter/contributors.in b/doc/interpreter/contributors.in --- a/doc/interpreter/contributors.in +++ b/doc/interpreter/contributors.in @@ -20,6 +20,7 @@ Richard Bovey John Bradshaw Marcus Brinkmann +Max Brister Remy Bruno Ansgar Burchard Marco Caliari diff --git a/doc/interpreter/doccheck/aspell-octave.en.pws b/doc/interpreter/doccheck/aspell-octave.en.pws --- a/doc/interpreter/doccheck/aspell-octave.en.pws +++ b/doc/interpreter/doccheck/aspell-octave.en.pws @@ -66,6 +66,7 @@ binopdf binornd Biomathematics +bitmapped bitmax bitwise bivariate @@ -830,6 +831,7 @@ Spearman's speye spfun +splinefit spmatrix spones spparms @@ -1039,6 +1041,7 @@ wp wspace xb +xc xcorr xdigit xerrorbar @@ -1060,6 +1063,7 @@ xyerrorbar xyerrorbars xyz +yc ydata yerrorbar yerrorbars diff --git a/doc/interpreter/geometry.txi b/doc/interpreter/geometry.txi --- a/doc/interpreter/geometry.txi +++ b/doc/interpreter/geometry.txi @@ -96,6 +96,7 @@ Octave has the functions @code{triplot}, @code{trimesh}, and @code{trisurf} to plot the Delaunay triangulation of a 2-dimensional set of points. +@code{tetramesh} will plot the triangulation of a 3-dimensional set of points. @DOCSTRING(triplot) @@ -103,6 +104,8 @@ @DOCSTRING(trisurf) +@DOCSTRING(tetramesh) + The difference between @code{triplot}, and @code{trimesh} or @code{triplot}, is that the former only plots the 2-dimensional triangulation itself, whereas the second two plot the value of a function @code{f (@var{x}, @var{y})}. An diff --git a/doc/interpreter/images b/doc/interpreter/images --- a/doc/interpreter/images +++ b/doc/interpreter/images @@ -2,3 +2,4 @@ interpimages.m interpft interpn interpderiv1 interpderiv2 plotimages.m plot hist errorbar polar mesh plot3 extended sparseimages.m gplot grid spmatrix spchol spcholperm +splineimages.m splinefit1 splinefit2 splinefit3 splinefit4 splinefit6 diff --git a/doc/interpreter/install.txi b/doc/interpreter/install.txi --- a/doc/interpreter/install.txi +++ b/doc/interpreter/install.txi @@ -65,13 +65,13 @@ yourself. @menu -* Obtaining the Depencies Automatically:: +* Obtaining the Dependencies Automatically:: * Build Tools:: * External Packages:: @end menu -@node Obtaining the Depencies Automatically -@subsection Obtaining the Depencies Automatically +@node Obtaining the Dependencies Automatically +@subsection Obtaining the Dependencies Automatically On some systems you can obtain many of Octave's build dependencies automatically. The commands for doing this vary by system. Similarly, diff --git a/doc/interpreter/octave.texi b/doc/interpreter/octave.texi --- a/doc/interpreter/octave.texi +++ b/doc/interpreter/octave.texi @@ -890,7 +890,7 @@ Build Dependencies -* Obtaining the Depencies Automatically:: +* Obtaining the Dependencies Automatically:: * Build Tools:: * External Packages:: diff --git a/doc/interpreter/plot.txi b/doc/interpreter/plot.txi --- a/doc/interpreter/plot.txi +++ b/doc/interpreter/plot.txi @@ -363,6 +363,8 @@ @DOCSTRING(isocolors) +@DOCSTRING(shrinkfaces) + @DOCSTRING(diffuse) @DOCSTRING(specular) @@ -1152,6 +1154,8 @@ @DOCSTRING(allchild) +@DOCSTRING(findfigs) + @node Graphics Object Properties @subsection Graphics Object Properties @cindex graphics object properties diff --git a/doc/interpreter/poly.txi b/doc/interpreter/poly.txi --- a/doc/interpreter/poly.txi +++ b/doc/interpreter/poly.txi @@ -132,18 +132,230 @@ Octave comes with good support for various kinds of interpolation, most of which are described in @ref{Interpolation}. One simple alternative to the functions described in the aforementioned chapter, is to fit -a single polynomial to some given data points. To avoid a highly -fluctuating polynomial, one most often wants to fit a low-order polynomial -to data. This usually means that it is necessary to fit the polynomial -in a least-squares sense, which just is what the @code{polyfit} function does. +a single polynomial, or a piecewise polynomial (spline) to some given +data points. To avoid a highly fluctuating polynomial, one most often +wants to fit a low-order polynomial to data. This usually means that it +is necessary to fit the polynomial in a least-squares sense, which just +is what the @code{polyfit} function does. @DOCSTRING(polyfit) In situations where a single polynomial isn't good enough, a solution -is to use several polynomials pieced together. The function @code{mkpp} -creates a piecewise polynomial, @code{ppval} evaluates the function -created by @code{mkpp}, and @code{unmkpp} returns detailed information -about the function. +is to use several polynomials pieced together. The function +@code{splinefit} fits a peicewise polynomial (spline) to a set of +data. + +@DOCSTRING(splinefit) + +The number of @var{breaks} (or knots) used to construct the piecewise +polynomial is a significant factor in suppressing the noise present in +the input data, @var{x} and @var{y}. This is demostrated by the example +below. + +@example +@group +x = 2 * pi * rand (1, 200); +y = sin (x) + sin (2 * x) + 0.2 * randn (size (x)); +## Uniform breaks +breaks = linspace (0, 2 * pi, 41); % 41 breaks, 40 pieces +pp1 = splinefit (x, y, breaks); +## Breaks interpolated from data +pp2 = splinefit (x, y, 10); % 11 breaks, 10 pieces +## Plot +xx = linspace (0, 2 * pi, 400); +y1 = ppval (pp1, xx); +y2 = ppval (pp2, xx); +plot (x, y, ".", xx, [y1; y2]) +axis tight +ylim auto +legend (@{"data", "41 breaks, 40 pieces", "11 breaks, 10 pieces"@}) +@end group +@end example + +@ifnotinfo +@noindent +The result of which can be seen in @ref{fig:splinefit1}. + +@float Figure,fig:splinefit1 +@center @image{splinefit1,4in} +@caption{Comparison of a fitting a piecewise polynomial with 41 breaks to one +with 11 breaks. The fit with the large number of breaks exhibits a fast ripple +that is not present in the underlying function.} +@end float +@end ifnotinfo + +The piece-wise polynomial fit, provided by @code{splinefit}, has +continuous derivatives up to the @var{order}-1. For example, a cubic fit +has continuous first and second derivatives. This is demonstrated by +the code + +@example +@group +## Data (200 points) +x = 2 * pi * rand (1, 200); +y = sin (x) + sin (2 * x) + 0.1 * randn (size (x)); +## Piecewise constant +pp1 = splinefit (x, y, 8, "order", 0); +## Piecewise linear +pp2 = splinefit (x, y, 8, "order", 1); +## Piecewise quadratic +pp3 = splinefit (x, y, 8, "order", 2); +## Piecewise cubic +pp4 = splinefit (x, y, 8, "order", 3); +## Piecewise quartic +pp5 = splinefit (x, y, 8, "order", 4); +## Plot +xx = linspace (0, 2 * pi, 400); +y1 = ppval (pp1, xx); +y2 = ppval (pp2, xx); +y3 = ppval (pp3, xx); +y4 = ppval (pp4, xx); +y5 = ppval (pp5, xx); +plot (x, y, ".", xx, [y1; y2; y3; y4; y5]) +axis tight +ylim auto +legend (@{"data", "order 0", "order 1", "order 2", "order 3", "order 4"@}) +@end group +@end example + +@ifnotinfo +@noindent +The result of which can be seen in @ref{fig:splinefit2}. + +@float Figure,fig:splinefit2 +@center @image{splinefit2,4in} +@caption{Comparison of a piecewise constant, linear, quadratic, cubic, and +quartic polynomials with 8 breaks to noisy data. The higher order solutions +more accurately represent the underlying function, but come with the +expense of computational complexity.} +@end float +@end ifnotinfo + +When the underlying function to provide a fit to is periodic, @code{splinefit} +is able to apply the boundary conditions needed to manifest a periodic fit. +This is demonstrated by the code below. + +@example +@group +## Data (100 points) +x = 2 * pi * [0, (rand (1, 98)), 1]; +y = sin (x) - cos (2 * x) + 0.2 * randn (size (x)); +## No constraints +pp1 = splinefit (x, y, 10, "order", 5); +## Periodic boundaries +pp2 = splinefit (x, y, 10, "order", 5, "periodic", true); +## Plot +xx = linspace (0, 2 * pi, 400); +y1 = ppval (pp1, xx); +y2 = ppval (pp2, xx); +plot (x, y, ".", xx, [y1; y2]) +axis tight +ylim auto +legend (@{"data", "no constraints", "periodic"@}) +@end group +@end example + +@ifnotinfo +@noindent +The result of which can be seen in @ref{fig:splinefit3}. + +@float Figure,fig:splinefit3 +@center @image{splinefit3,4in} +@caption{Comparison of piecewise polynomial fits to a noisy periodic +function with, and without, periodic boundary conditions.} +@end float +@end ifnotinfo + +More complex constraints may be added as well. For example, the code below +illustrates a periodic fit with values that have been clamped at the end points, +and a second periodic fit which is hinged at the end points. + +@example +@group +## Data (200 points) +x = 2 * pi * rand (1, 200); +y = sin (2 * x) + 0.1 * randn (size (x)); +## Breaks +breaks = linspace (0, 2 * pi, 10); +## Clamped endpoints, y = y' = 0 +xc = [0, 0, 2*pi, 2*pi]; +cc = [(eye (2)), (eye (2))]; +con = struct ("xc", xc, "cc", cc); +pp1 = splinefit (x, y, breaks, "constraints", con); +## Hinged periodic endpoints, y = 0 +con = struct ("xc", 0); +pp2 = splinefit (x, y, breaks, "constraints", con, "periodic", true); +## Plot +xx = linspace (0, 2 * pi, 400); +y1 = ppval (pp1, xx); +y2 = ppval (pp2, xx); +plot (x, y, ".", xx, [y1; y2]) +axis tight +ylim auto +legend (@{"data", "clamped", "hinged periodic"@}) +@end group +@end example + +@ifnotinfo +@noindent +The result of which can be seen in @ref{fig:splinefit4}. + +@float Figure,fig:splinefit4 +@center @image{splinefit4,4in} +@caption{Comparison of two periodic piecewise cubic fits to a noisy periodic +signal. One fit has its end points clamped and the second has its end points +hinged.} +@end float +@end ifnotinfo + +The @code{splinefit} function also provides the convenience of a @var{robust} +fitting, where the effect of outlying data is reduced. In the example below, +three different fits are provided. Two with differing levels of outlier +suppression and a third illustrating the non-robust solution. + +@example +@group +## Data +x = linspace (0, 2*pi, 200); +y = sin (x) + sin (2 * x) + 0.05 * randn (size (x)); +## Add outliers +x = [x, linspace(0,2*pi,60)]; +y = [y, -ones(1,60)]; +## Fit splines with hinged conditions +con = struct ("xc", [0, 2*pi]); +## Robust fitting, beta = 0.25 +pp1 = splinefit (x, y, 8, "constraints", con, "beta", 0.25); +## Robust fitting, beta = 0.75 +pp2 = splinefit (x, y, 8, "constraints", con, "beta", 0.75); +## No robust fitting +pp3 = splinefit (x, y, 8, "constraints", con); +## Plot +xx = linspace (0, 2*pi, 400); +y1 = ppval (pp1, xx); +y2 = ppval (pp2, xx); +y3 = ppval (pp3, xx); +plot (x, y, ".", xx, [y1; y2; y3]) +legend (@{"data with outliers","robust, beta = 0.25", ... + "robust, beta = 0.75", "no robust fitting"@}) +axis tight +ylim auto +@end group +@end example + +@ifnotinfo +@noindent +The result of which can be seen in @ref{fig:splinefit6}. + +@float Figure,fig:splinefit6 +@center @image{splinefit6,4in} +@caption{Comparison of two different levels of robust fitting (@var{beta} = 0.25 and 0.75) to noisy data combined with outlying data. A conventional fit, without +robust fitting (@var{beta} = 0) is also included.} +@end float +@end ifnotinfo + +The function, @code{ppval}, evaluates the piecewise polynomials, created +by @code{mkpp} or other means, and @code{unmkpp} returns detailed +information about the piecewise polynomial. The following example shows how to combine two linear functions and a quadratic into one function. Each of these functions is expressed diff --git a/doc/interpreter/splineimages.m b/doc/interpreter/splineimages.m new file mode 100644 --- /dev/null +++ b/doc/interpreter/splineimages.m @@ -0,0 +1,192 @@ +## Copyright (C) 2012 Ben Abbott, Jonas Lundgren +## +## 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 3 of the License, 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, see +## . + +function splineimages (nm, typ) + graphics_toolkit ("gnuplot"); + set_print_size (); + hide_output (); + if (strcmp (typ, "png")) + set (0, "defaulttextfontname", "*"); + endif + if (strcmp (typ, "eps")) + d_typ = "-depsc2"; + else + d_typ = cstrcat ("-d", typ); + endif + + if (strcmp (typ, "txt")) + image_as_txt (nm); + elseif (strcmp (nm, "splinefit1")) ## Breaks and Pieces + x = 2 * pi * rand (1, 200); + y = sin (x) + sin (2 * x) + 0.2 * randn (size (x)); + ## Uniform breaks + breaks = linspace (0, 2 * pi, 41); ## 41 breaks, 40 pieces + pp1 = splinefit (x, y, breaks); + ## Breaks interpolated from data + pp2 = splinefit (x, y, 10); ## 11 breaks, 10 pieces + ## Plot + xx = linspace (0, 2 * pi, 400); + y1 = ppval (pp1, xx); + y2 = ppval (pp2, xx); + plot (x, y, ".", xx, [y1; y2]) + axis tight + ylim ([-2.5 2.5]) + legend ("data", "41 breaks, 40 pieces", "11 breaks, 10 pieces") + print (cstrcat (nm, ".", typ), d_typ) + elseif (strcmp (nm, "splinefit2")) ## Spline orders + ## Data (200 points) + x = 2 * pi * rand (1, 200); + y = sin (x) + sin (2 * x) + 0.1 * randn (size (x)); + ## Splines + pp1 = splinefit (x, y, 8, "order", 0); ## Piecewise constant + pp2 = splinefit (x, y, 8, "order", 1); ## Piecewise linear + pp3 = splinefit (x, y, 8, "order", 2); ## Piecewise quadratic + pp4 = splinefit (x, y, 8, "order", 3); ## Piecewise cubic + pp5 = splinefit (x, y, 8, "order", 4); ## Etc. + ## Plot + xx = linspace (0, 2 * pi, 400); + y1 = ppval (pp1, xx); + y2 = ppval (pp2, xx); + y3 = ppval (pp3, xx); + y4 = ppval (pp4, xx); + y5 = ppval (pp5, xx); + plot (x, y, ".", xx, [y1; y2; y3; y4; y5]) + axis tight + ylim ([-2.5 2.5]) + legend ({"data", "order 0", "order 1", "order 2", "order 3", "order 4"}) + print (cstrcat (nm, ".", typ), d_typ) + elseif (strcmp (nm, "splinefit3")) + ## Data (100 points) + x = 2 * pi * [0, (rand (1, 98)), 1]; + y = sin (x) - cos (2 * x) + 0.2 * randn (size (x)); + ## No constraints + pp1 = splinefit (x, y, 10, "order", 5); + ## Periodic boundaries + pp2 = splinefit (x, y, 10, "order", 5, "periodic", true); + ## Plot + xx = linspace (0, 2 * pi, 400); + y1 = ppval (pp1, xx); + y2 = ppval (pp2, xx); + plot (x, y, ".", xx, [y1; y2]) + axis tight + ylim ([-2 3]) + legend ({"data", "no constraints", "periodic"}) + print (cstrcat (nm, ".", typ), d_typ) + elseif (strcmp (nm, "splinefit4")) + ## Data (200 points) + x = 2 * pi * rand (1, 200); + y = sin (2 * x) + 0.1 * randn (size (x)); + ## Breaks + breaks = linspace (0, 2 * pi, 10); + ## Clamped endpoints, y = y" = 0 + xc = [0, 0, 2*pi, 2*pi]; + cc = [(eye (2)), (eye (2))]; + con = struct ("xc", xc, "cc", cc); + pp1 = splinefit (x, y, breaks, "constraints", con); + ## Hinged periodic endpoints, y = 0 + con = struct ("xc", 0); + pp2 = splinefit (x, y, breaks, "constraints", con, "periodic", true); + ## Plot + xx = linspace (0, 2 * pi, 400); + y1 = ppval (pp1, xx); + y2 = ppval (pp2, xx); + plot (x, y, ".", xx, [y1; y2]) + axis tight + ylim ([-1.5 1.5]) + legend({"data", "clamped", "hinged periodic"}) + print (cstrcat (nm, ".", typ), d_typ) + elseif (strcmp (nm, "splinefit5")) + ## Truncated data + x = [0, 1, 2, 4, 8, 16, 24, 40, 56, 72, 80] / 80; + y = [0, 28, 39, 53, 70, 86, 90, 79, 55, 22, 2] / 1000; + xy = [x; y]; + ## Curve length parameter + ds = sqrt (diff (x).^2 + diff (y).^2); + s = [0, cumsum(ds)]; + ## Constraints at s = 0: (x,y) = (0,0), (dx/ds,dy/ds) = (0,1) + con = struct ("xc", [0 0], "yc", [0 0; 0 1], "cc", eye (2)); + ## Fit a spline with 4 pieces + pp = splinefit (s, xy, 4, "constraints", con); + ## Plot + ss = linspace (0, s(end), 400); + xyfit = ppval (pp, ss); + xyb = ppval(pp, pp.breaks); + plot (x, y, ".", xyfit(1,:), xyfit(2,:), "r", xyb(1,:), xyb(2,:), "ro") + legend ({"data", "spline", "breaks"}) + axis tight + ylim ([0 0.1]) + print (cstrcat (nm, ".", typ), d_typ) + elseif (strcmp (nm, "splinefit6")) + ## Data + x = linspace (0, 2*pi, 200); + y = sin (x) + sin (2 * x) + 0.05 * randn (size (x)); + ## Add outliers + x = [x, linspace(0,2*pi,60)]; + y = [y, -ones(1,60)]; + ## Fit splines with hinged conditions + con = struct ("xc", [0, 2*pi]); + pp1 = splinefit (x, y, 8, "constraints", con, "beta", 0.25); ## Robust fitting + pp2 = splinefit (x, y, 8, "constraints", con, "beta", 0.75); ## Robust fitting + pp3 = splinefit (x, y, 8, "constraints", con); ## No robust fitting + ## Plot + xx = linspace (0, 2*pi, 400); + y1 = ppval (pp1, xx); + y2 = ppval (pp2, xx); + y3 = ppval (pp3, xx); + plot (x, y, ".", xx, [y1; y2; y3]) + legend({"data with outliers","robust, beta = 0.25", ... + "robust, beta = 0.75", "no robust fitting"}) + axis tight + ylim ([-2 2]) + print (cstrcat (nm, ".", typ), d_typ) + endif + hide_output (); +endfunction + +function set_print_size () + image_size = [5.0, 3.5]; # in inches, 16:9 format + border = 0; # For postscript use 50/72 + set (0, "defaultfigurepapertype", ""); + set (0, "defaultfigurepaperorientation", "landscape"); + set (0, "defaultfigurepapersize", image_size + 2*border); + set (0, "defaultfigurepaperposition", [border, border, image_size]); +endfunction + +## Use this function before plotting commands and after every call to +## print since print() resets output to stdout (unfortunately, gnpulot +## can't pop output as it can the terminal type). +function hide_output () + f = figure (1); + set (f, "visible", "off"); +endfunction + +## generate something for the texinfo @image command to process +function image_as_txt(nm) + fid = fopen (sprintf ("%s.txt", nm), "wt"); + fputs (fid, "\n"); + fputs (fid, "+---------------------------------+\n"); + fputs (fid, "| Image unavailable in text mode. |\n"); + fputs (fid, "+---------------------------------+\n"); + fclose (fid); +endfunction + +%!demo +%! for s = 1:6 +%! splineimages (sprintf ("splinefit##d", s), "pdf") +%! endfor + diff --git a/doc/interpreter/strings.txi b/doc/interpreter/strings.txi diff --git a/doc/interpreter/system.txi b/doc/interpreter/system.txi --- a/doc/interpreter/system.txi +++ b/doc/interpreter/system.txi @@ -53,7 +53,7 @@ Microseconds after the second (0-999999). @item sec -Seconds after the minute (0-61). This number can be 61 to account +Seconds after the minute (0-60). This number can be 60 to account for leap seconds. @item min diff --git a/libcruft/Makefile.am b/libcruft/Makefile.am --- a/libcruft/Makefile.am +++ b/libcruft/Makefile.am @@ -31,6 +31,8 @@ libcruft_la_SOURCES = +nodist_libcruft_la_SOURCES = + libcruft_la_FFLAGS = $(F77_INTEGER_8_FLAG) libcruft_la_CPPFLAGS = \ @@ -98,5 +100,5 @@ EXTRA_DIST += mkf77def.in -DISTCLEANFILES = cruft.def ranlib.def +DISTCLEANFILES = cruft.def ranlib.def $(nodist_libcruft_la_SOURCES) diff --git a/libcruft/slatec-fn/derfc.f b/libcruft/slatec-fn/derfc.in.f rename from libcruft/slatec-fn/derfc.f rename to libcruft/slatec-fn/derfc.in.f diff --git a/libcruft/slatec-fn/erfc.f b/libcruft/slatec-fn/erfc.in.f rename from libcruft/slatec-fn/erfc.f rename to libcruft/slatec-fn/erfc.in.f diff --git a/libcruft/slatec-fn/module.mk b/libcruft/slatec-fn/module.mk --- a/libcruft/slatec-fn/module.mk +++ b/libcruft/slatec-fn/module.mk @@ -1,4 +1,7 @@ -EXTRA_DIST += slatec-fn/module.mk +EXTRA_DIST += \ + slatec-fn/module.mk \ + slatec-fn/derfc.in.f \ + slatec-fn/erfc.in.f libcruft_la_SOURCES += \ slatec-fn/albeta.f \ @@ -20,7 +23,6 @@ slatec-fn/dbetai.f \ slatec-fn/dcsevl.f \ slatec-fn/derf.f \ - slatec-fn/derfc.f \ slatec-fn/dgami.f \ slatec-fn/dgamit.f \ slatec-fn/dgamlm.f \ @@ -33,7 +35,6 @@ slatec-fn/dpchim.f \ slatec-fn/dpchst.f \ slatec-fn/erf.f \ - slatec-fn/erfc.f \ slatec-fn/gami.f \ slatec-fn/gamit.f \ slatec-fn/gamlim.f \ @@ -65,3 +66,15 @@ slatec-fn/xsgmainc.f \ slatec-fn/xgamma.f \ slatec-fn/xbetai.f + +nodist_libcruft_la_SOURCES += \ + slatec-fn/derfc.f \ + slatec-fn/erfc.f + +slatec-fn/erfc.f: slatec-fn/erfc.in.f Makefile + $(SED) -e "${F77_ISNAN_MACRO}" < $< > $@-t + mv $@-t $@ + +slatec-fn/derfc.f: slatec-fn/derfc.in.f Makefile + $(SED) -e "${F77_ISNAN_MACRO}" < $< > $@-t + mv $@-t $@ diff --git a/liboctave/Array.cc b/liboctave/Array.cc --- a/liboctave/Array.cc +++ b/liboctave/Array.cc @@ -2524,6 +2524,26 @@ template Array +Array::diag (octave_idx_type m, octave_idx_type n) const +{ + Array retval; + + if (ndims () == 2 && (rows () == 1 || cols () == 1)) + { + retval.resize (dim_vector (m, n), resize_fill_value ()); + + for (octave_idx_type i = 0; i < numel (); i++) + retval.xelem (i, i) = xelem (i); + } + else + (*current_liboctave_error_handler) + ("cat: invalid dimension"); + + return retval; +} + +template +Array Array::cat (int dim, octave_idx_type n, const Array *array_list) { // Default concatenation. diff --git a/liboctave/Array.h b/liboctave/Array.h --- a/liboctave/Array.h +++ b/liboctave/Array.h @@ -562,6 +562,8 @@ Array diag (octave_idx_type k = 0) const; + Array diag (octave_idx_type m, octave_idx_type n) const; + // Concatenation along a specified (0-based) dimension, equivalent to cat(). // dim = -1 corresponds to dim = 0 and dim = -2 corresponds to dim = 1, // but apply the looser matching rules of vertcat/horzcat. diff --git a/liboctave/CMatrix.cc b/liboctave/CMatrix.cc --- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -3239,6 +3239,23 @@ return MArray::diag (k); } +ComplexDiagMatrix +ComplexMatrix::diag (octave_idx_type m, octave_idx_type n) const +{ + ComplexDiagMatrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 1 || nc == 1) + retval = ComplexDiagMatrix (*this, m, n); + else + (*current_liboctave_error_handler) + ("diag: expecting vector argument"); + + return retval; +} + bool ComplexMatrix::row_is_real_only (octave_idx_type i) const { diff --git a/liboctave/CMatrix.h b/liboctave/CMatrix.h --- a/liboctave/CMatrix.h +++ b/liboctave/CMatrix.h @@ -357,6 +357,8 @@ ComplexMatrix diag (octave_idx_type k = 0) const; + ComplexDiagMatrix diag (octave_idx_type m, octave_idx_type n) const; + bool row_is_real_only (octave_idx_type) const; bool column_is_real_only (octave_idx_type) const; diff --git a/liboctave/CNDArray.cc b/liboctave/CNDArray.cc --- a/liboctave/CNDArray.cc +++ b/liboctave/CNDArray.cc @@ -862,6 +862,12 @@ return MArray::diag (k); } +ComplexNDArray +ComplexNDArray::diag (octave_idx_type m, octave_idx_type n) const +{ + return MArray::diag (m, n); +} + // This contains no information on the array structure !!! std::ostream& operator << (std::ostream& os, const ComplexNDArray& a) diff --git a/liboctave/CNDArray.h b/liboctave/CNDArray.h --- a/liboctave/CNDArray.h +++ b/liboctave/CNDArray.h @@ -142,6 +142,8 @@ ComplexNDArray diag (octave_idx_type k = 0) const; + ComplexNDArray diag (octave_idx_type m, octave_idx_type n) const; + ComplexNDArray& changesign (void) { MArray::changesign (); diff --git a/liboctave/DiagArray2.cc b/liboctave/DiagArray2.cc --- a/liboctave/DiagArray2.cc +++ b/liboctave/DiagArray2.cc @@ -82,16 +82,14 @@ // A two-dimensional array with diagonal elements only. -template -T -DiagArray2::checkelem (octave_idx_type r, octave_idx_type c) const +template +void +DiagArray2::check_idx (octave_idx_type r, octave_idx_type c) const { if (r < 0 || r >= dim1 ()) gripe_index_out_of_range (2, 1, r+1, dim1 ()); if (c < 0 || c >= dim2 ()) gripe_index_out_of_range (2, 2, c+1, dim2 ()); - - return elem (r, c); } template diff --git a/liboctave/DiagArray2.h b/liboctave/DiagArray2.h --- a/liboctave/DiagArray2.h +++ b/liboctave/DiagArray2.h @@ -119,15 +119,22 @@ T& dgelem (octave_idx_type i) { return Array::elem (i); } - T checkelem (octave_idx_type r, octave_idx_type c) const; + void check_idx (octave_idx_type r, octave_idx_type c) const; T operator () (octave_idx_type r, octave_idx_type c) const { #if defined (BOUNDS_CHECKING) - return checkelem (r, c); -#else + check_idx (r, c); +#endif return elem (r, c); + } + + T& operator () (octave_idx_type r, octave_idx_type c) + { +#if defined (BOUNDS_CHECKING) + check_idx (r, c); #endif + return elem (r, c); } // No checking. diff --git a/liboctave/boolNDArray.cc b/liboctave/boolNDArray.cc --- a/liboctave/boolNDArray.cc +++ b/liboctave/boolNDArray.cc @@ -134,6 +134,12 @@ return Array::diag (k); } +boolNDArray +boolNDArray::diag (octave_idx_type m, octave_idx_type n) const +{ + return Array::diag (m, n); +} + NDND_BOOL_OPS (boolNDArray, boolNDArray) NDND_CMP_OPS (boolNDArray, boolNDArray) diff --git a/liboctave/boolNDArray.h b/liboctave/boolNDArray.h --- a/liboctave/boolNDArray.h +++ b/liboctave/boolNDArray.h @@ -103,6 +103,7 @@ boolNDArray diag (octave_idx_type k = 0) const; + boolNDArray diag (octave_idx_type m, octave_idx_type n) const; }; NDND_BOOL_OP_DECLS (boolNDArray, boolNDArray, OCTAVE_API) diff --git a/liboctave/chNDArray.cc b/liboctave/chNDArray.cc --- a/liboctave/chNDArray.cc +++ b/liboctave/chNDArray.cc @@ -133,6 +133,12 @@ return Array::diag (k); } +charNDArray +charNDArray::diag (octave_idx_type m, octave_idx_type n) const +{ + return Array::diag (m, n); +} + NDS_CMP_OPS (charNDArray, char) NDS_BOOL_OPS (charNDArray, char) diff --git a/liboctave/chNDArray.h b/liboctave/chNDArray.h --- a/liboctave/chNDArray.h +++ b/liboctave/chNDArray.h @@ -96,6 +96,7 @@ charNDArray diag (octave_idx_type k = 0) const; + charNDArray diag (octave_idx_type m, octave_idx_type n) const; }; NDS_CMP_OP_DECLS (charNDArray, char, OCTAVE_API) diff --git a/liboctave/dMatrix.cc b/liboctave/dMatrix.cc --- a/liboctave/dMatrix.cc +++ b/liboctave/dMatrix.cc @@ -2783,6 +2783,23 @@ return MArray::diag (k); } +DiagMatrix +Matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + DiagMatrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 1 || nc == 1) + retval = DiagMatrix (*this, m, n); + else + (*current_liboctave_error_handler) + ("diag: expecting vector argument"); + + return retval; +} + ColumnVector Matrix::row_min (void) const { diff --git a/liboctave/dMatrix.h b/liboctave/dMatrix.h --- a/liboctave/dMatrix.h +++ b/liboctave/dMatrix.h @@ -316,6 +316,8 @@ Matrix diag (octave_idx_type k = 0) const; + DiagMatrix diag (octave_idx_type m, octave_idx_type n) const; + ColumnVector row_min (void) const; ColumnVector row_max (void) const; diff --git a/liboctave/dNDArray.cc b/liboctave/dNDArray.cc --- a/liboctave/dNDArray.cc +++ b/liboctave/dNDArray.cc @@ -877,6 +877,12 @@ return MArray::diag (k); } +NDArray +NDArray::diag (octave_idx_type m, octave_idx_type n) const +{ + return MArray::diag (m, n); +} + // This contains no information on the array structure !!! std::ostream& operator << (std::ostream& os, const NDArray& a) diff --git a/liboctave/dNDArray.h b/liboctave/dNDArray.h --- a/liboctave/dNDArray.h +++ b/liboctave/dNDArray.h @@ -154,6 +154,8 @@ NDArray diag (octave_idx_type k = 0) const; + NDArray diag (octave_idx_type m, octave_idx_type n) const; + NDArray& changesign (void) { MArray::changesign (); diff --git a/liboctave/fCMatrix.cc b/liboctave/fCMatrix.cc --- a/liboctave/fCMatrix.cc +++ b/liboctave/fCMatrix.cc @@ -3235,6 +3235,23 @@ return MArray::diag (k); } +FloatComplexDiagMatrix +FloatComplexMatrix::diag (octave_idx_type m, octave_idx_type n) const +{ + FloatComplexDiagMatrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 1 || nc == 1) + retval = FloatComplexDiagMatrix (*this, m, n); + else + (*current_liboctave_error_handler) + ("diag: expecting vector argument"); + + return retval; +} + bool FloatComplexMatrix::row_is_real_only (octave_idx_type i) const { diff --git a/liboctave/fCMatrix.h b/liboctave/fCMatrix.h --- a/liboctave/fCMatrix.h +++ b/liboctave/fCMatrix.h @@ -362,6 +362,8 @@ FloatComplexMatrix diag (octave_idx_type k = 0) const; + FloatComplexDiagMatrix diag (octave_idx_type m, octave_idx_type n) const; + bool row_is_real_only (octave_idx_type) const; bool column_is_real_only (octave_idx_type) const; diff --git a/liboctave/fCNDArray.cc b/liboctave/fCNDArray.cc --- a/liboctave/fCNDArray.cc +++ b/liboctave/fCNDArray.cc @@ -859,6 +859,12 @@ return MArray::diag (k); } +FloatComplexNDArray +FloatComplexNDArray::diag (octave_idx_type m, octave_idx_type n) const +{ + return MArray::diag (m, n); +} + // This contains no information on the array structure !!! std::ostream& operator << (std::ostream& os, const FloatComplexNDArray& a) diff --git a/liboctave/fCNDArray.h b/liboctave/fCNDArray.h --- a/liboctave/fCNDArray.h +++ b/liboctave/fCNDArray.h @@ -142,6 +142,8 @@ FloatComplexNDArray diag (octave_idx_type k = 0) const; + FloatComplexNDArray diag (octave_idx_type m, octave_idx_type n) const; + FloatComplexNDArray& changesign (void) { MArray::changesign (); diff --git a/liboctave/fMatrix.cc b/liboctave/fMatrix.cc --- a/liboctave/fMatrix.cc +++ b/liboctave/fMatrix.cc @@ -2783,6 +2783,23 @@ return MArray::diag (k); } +FloatDiagMatrix +FloatMatrix::diag (octave_idx_type m, octave_idx_type n) const +{ + FloatDiagMatrix retval; + + octave_idx_type nr = rows (); + octave_idx_type nc = cols (); + + if (nr == 1 || nc == 1) + retval = FloatDiagMatrix (*this, m, n); + else + (*current_liboctave_error_handler) + ("diag: expecting vector argument"); + + return retval; +} + FloatColumnVector FloatMatrix::row_min (void) const { diff --git a/liboctave/fMatrix.h b/liboctave/fMatrix.h --- a/liboctave/fMatrix.h +++ b/liboctave/fMatrix.h @@ -316,6 +316,8 @@ FloatMatrix diag (octave_idx_type k = 0) const; + FloatDiagMatrix diag (octave_idx_type m, octave_idx_type n) const; + FloatColumnVector row_min (void) const; FloatColumnVector row_max (void) const; diff --git a/liboctave/fNDArray.cc b/liboctave/fNDArray.cc --- a/liboctave/fNDArray.cc +++ b/liboctave/fNDArray.cc @@ -837,6 +837,12 @@ return MArray::diag (k); } +FloatNDArray +FloatNDArray::diag (octave_idx_type m, octave_idx_type n) const +{ + return MArray::diag (m, n); +} + // This contains no information on the array structure !!! std::ostream& operator << (std::ostream& os, const FloatNDArray& a) diff --git a/liboctave/fNDArray.h b/liboctave/fNDArray.h --- a/liboctave/fNDArray.h +++ b/liboctave/fNDArray.h @@ -151,6 +151,8 @@ FloatNDArray diag (octave_idx_type k = 0) const; + FloatNDArray diag (octave_idx_type m, octave_idx_type n) const; + FloatNDArray& changesign (void) { MArray::changesign (); diff --git a/liboctave/intNDArray.cc b/liboctave/intNDArray.cc --- a/liboctave/intNDArray.cc +++ b/liboctave/intNDArray.cc @@ -69,6 +69,13 @@ return MArray::diag (k); } +template +intNDArray +intNDArray::diag (octave_idx_type m, octave_idx_type n) const +{ + return MArray::diag (m, n); +} + // FIXME -- this is not quite the right thing. template diff --git a/liboctave/intNDArray.h b/liboctave/intNDArray.h --- a/liboctave/intNDArray.h +++ b/liboctave/intNDArray.h @@ -66,6 +66,8 @@ intNDArray diag (octave_idx_type k = 0) const; + intNDArray diag (octave_idx_type m, octave_idx_type n) const; + intNDArray& changesign (void) { MArray::changesign (); diff --git a/liboctave/oct-norm.cc b/liboctave/oct-norm.cc --- a/liboctave/oct-norm.cc +++ b/liboctave/oct-norm.cc @@ -415,7 +415,7 @@ // the OSE part VectorT y(m.rows (), 1, 0), z(m.rows (), 1); typedef typename VectorT::element_type RR; - RR lambda = 0, mu = 0; + RR lambda = 0, mu = 1; for (octave_idx_type k = 0; k < m.columns (); k++) { octave_quit (); diff --git a/liboctave/regexp.cc b/liboctave/regexp.cc --- a/liboctave/regexp.cc +++ b/liboctave/regexp.cc @@ -148,7 +148,7 @@ size_t tmp_pos1 = new_pos + 2; size_t tmp_pos2 = tmp_pos1; - while (tmp_pos1 <= pattern.length () && brackets > 0) + while (tmp_pos1 < pattern.length () && brackets > 0) { char ch = pattern.at (tmp_pos1); @@ -315,9 +315,9 @@ } else if (matches == PCRE_ERROR_NOMATCH) break; - else if (ovector[1] <= ovector[0]) + else if (ovector[1] <= ovector[0] && ! options.emptymatch ()) { - // Zero sized match. Skip to next char. + // Zero length match. Skip to next char. idx = ovector[0] + 1; if (idx < buffer.length ()) continue; @@ -400,7 +400,16 @@ regexp::match_element new_elem (named_tokens, tokens, match_string, token_extents, start, end); lst.push_back (new_elem); - idx = ovector[1]; + + if (ovector[1] <= ovector[0]) + { + // Zero length match. Skip to next char. + idx = ovector[0] + 1; + if (idx <= buffer.length ()) + continue; + } + else + idx = ovector[1]; if (options.once () || idx >= buffer.length ()) break; diff --git a/liboctave/regexp.h b/liboctave/regexp.h --- a/liboctave/regexp.h +++ b/liboctave/regexp.h @@ -95,11 +95,13 @@ opts (void) : x_case_insensitive (false), x_dotexceptnewline (false), - x_freespacing (false), x_lineanchors (false), x_once (false) { } + x_emptymatch (false), x_freespacing (false), x_lineanchors (false), + x_once (false) { } opts (const opts& o) : x_case_insensitive (o.x_case_insensitive), x_dotexceptnewline (o.x_dotexceptnewline), + x_emptymatch (o.x_emptymatch), x_freespacing (o.x_freespacing), x_lineanchors (o.x_lineanchors), x_once (o.x_once) @@ -111,6 +113,7 @@ { x_case_insensitive = o.x_case_insensitive; x_dotexceptnewline = o.x_dotexceptnewline; + x_emptymatch = o.x_emptymatch; x_freespacing = o.x_freespacing; x_lineanchors = o.x_lineanchors; x_once = o.x_once; @@ -123,12 +126,14 @@ void case_insensitive (bool val) { x_case_insensitive = val; } void dotexceptnewline (bool val) { x_dotexceptnewline = val; } + void emptymatch (bool val) { x_emptymatch = val; } void freespacing (bool val) { x_freespacing = val; } void lineanchors (bool val) { x_lineanchors = val; } void once (bool val) { x_once = val; } bool case_insensitive (void) const { return x_case_insensitive; } bool dotexceptnewline (void) const { return x_dotexceptnewline; } + bool emptymatch (void) const { return x_emptymatch; } bool freespacing (void) const { return x_freespacing; } bool lineanchors (void) const { return x_lineanchors; } bool once (void) const { return x_once; } @@ -137,6 +142,7 @@ bool x_case_insensitive; bool x_dotexceptnewline; + bool x_emptymatch; bool x_freespacing; bool x_lineanchors; bool x_once; diff --git a/m4/acinclude.m4 b/m4/acinclude.m4 --- a/m4/acinclude.m4 +++ b/m4/acinclude.m4 @@ -329,6 +329,28 @@ fi ]) dnl +dnl Check to see whether Fortran compiler has the intrinsic function ISNAN. +dnl +AC_DEFUN([OCTAVE_CHECK_FORTRAN_HAVE_ISNAN], [ + AC_LANG_PUSH(Fortran 77) + AC_CACHE_CHECK([whether $F77 has the intrinsic function ISNAN], + [octave_cv_fortran_have_isnan], +[AC_COMPILE_IFELSE( +[ program foo + implicit none + real x + double precision y + if (isnan(x)) then + print *, 'x is NaN' + end if + if (isnan(y)) then + print *, 'y is NaN' + end if + end program], [octave_cv_fortran_have_isnan=yes], [octave_cv_fortran_have_isnan=no] +)]) + AC_LANG_POP(Fortran 77) +]) +dnl dnl Check to see whether the default Fortran INTEGER is 64 bits wide. dnl AC_DEFUN([OCTAVE_CHECK_FORTRAN_INTEGER_SIZE], [ diff --git a/scripts/audio/mu2lin.m b/scripts/audio/mu2lin.m --- a/scripts/audio/mu2lin.m +++ b/scripts/audio/mu2lin.m @@ -41,21 +41,21 @@ print_usage (); endif - ulaw = [32124, 31100, 30076, 29052, 28028, 27004, 25980, 24956, \ - 23932, 22908, 21884, 20860, 19836, 18812, 17788, 16764, \ - 15996, 15484, 14972, 14460, 13948, 13436, 12924, 12412, \ - 11900, 11388, 10876, 10364, 9852, 9340, 8828, 8316, \ - 7932, 7676, 7420, 7164, 6908, 6652, 6396, 6140, \ - 5884, 5628, 5372, 5116, 4860, 4604, 4348, 4092, \ - 3900, 3772, 3644, 3516, 3388, 3260, 3132, 3004, \ - 2876, 2748, 2620, 2492, 2364, 2236, 2108, 1980, \ - 1884, 1820, 1756, 1692, 1628, 1564, 1500, 1436, \ - 1372, 1308, 1244, 1180, 1116, 1052, 988, 924, \ - 876, 844, 812, 780, 748, 716, 684, 652, \ - 620, 588, 556, 524, 492, 460, 428, 396, \ - 372, 356, 340, 324, 308, 292, 276, 260, \ - 244, 228, 212, 196, 180, 164, 148, 132, \ - 120, 112, 104, 96, 88, 80, 72, 64, \ + ulaw = [32124, 31100, 30076, 29052, 28028, 27004, 25980, 24956, ... + 23932, 22908, 21884, 20860, 19836, 18812, 17788, 16764, ... + 15996, 15484, 14972, 14460, 13948, 13436, 12924, 12412, ... + 11900, 11388, 10876, 10364, 9852, 9340, 8828, 8316, ... + 7932, 7676, 7420, 7164, 6908, 6652, 6396, 6140, ... + 5884, 5628, 5372, 5116, 4860, 4604, 4348, 4092, ... + 3900, 3772, 3644, 3516, 3388, 3260, 3132, 3004, ... + 2876, 2748, 2620, 2492, 2364, 2236, 2108, 1980, ... + 1884, 1820, 1756, 1692, 1628, 1564, 1500, 1436, ... + 1372, 1308, 1244, 1180, 1116, 1052, 988, 924, ... + 876, 844, 812, 780, 748, 716, 684, 652, ... + 620, 588, 556, 524, 492, 460, 428, 396, ... + 372, 356, 340, 324, 308, 292, 276, 260, ... + 244, 228, 212, 196, 180, 164, 148, 132, ... + 120, 112, 104, 96, 88, 80, 72, 64, ... 56, 48, 40, 32, 24, 16, 8, 0 ]; ulaw = [ -ulaw, ulaw ]; diff --git a/scripts/deprecated/cut.m b/scripts/deprecated/cut.m --- a/scripts/deprecated/cut.m +++ b/scripts/deprecated/cut.m @@ -51,10 +51,10 @@ if (!isvector (x)) error ("cut: X must be a vector"); endif - if isscalar (breaks) + if (isscalar (breaks)) breaks = linspace (min (x), max (x), breaks + 1); breaks(1) = breaks(1) - 1; - elseif isvector (breaks) + elseif (isvector (breaks)) breaks = sort (breaks); else error ("cut: BREAKS must be a scalar or vector"); @@ -62,7 +62,7 @@ group = NaN (size (x)); m = length (breaks); - if any (k = find ((x >= min (breaks)) & (x < max (breaks)))) + if (any (k = find ((x >= min (breaks)) & (x < max (breaks))))) n = length (k); group(k) = sum ((ones (m, 1) * reshape (x(k), 1, n)) >= (reshape (breaks, m, 1) * ones (1, n))); diff --git a/scripts/general/cplxpair.m b/scripts/general/cplxpair.m --- a/scripts/general/cplxpair.m +++ b/scripts/general/cplxpair.m @@ -52,7 +52,7 @@ function y = cplxpair (z, tol, dim) - if nargin < 1 || nargin > 3 + if (nargin < 1 || nargin > 3) print_usage (); endif diff --git a/scripts/general/genvarname.m b/scripts/general/genvarname.m --- a/scripts/general/genvarname.m +++ b/scripts/general/genvarname.m @@ -158,7 +158,7 @@ endif varname(i) = str(i); idx = 0; - while excluded + while (excluded) idx++; varname{i} = sprintf("%s%d", str{i}, idx); excluded = any (strcmp (varname{i}, exclusions)); @@ -166,7 +166,7 @@ exclusions(end+1) = varname(i); endfor - if strinput + if (strinput) varname = varname{1}; endif diff --git a/scripts/general/logspace.m b/scripts/general/logspace.m --- a/scripts/general/logspace.m +++ b/scripts/general/logspace.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} logspace (@var{a}, @var{b}) -## @deftypefnx {Function File} {} logspace (@var{b}, @var{b}, @var{n}) +## @deftypefnx {Function File} {} logspace (@var{a}, @var{b}, @var{n}) ## @deftypefnx {Function File} {} logspace (@var{a}, pi, @var{n}) ## Return a row vector with @var{n} elements logarithmically spaced from ## @tex diff --git a/scripts/general/num2str.m b/scripts/general/num2str.m --- a/scripts/general/num2str.m +++ b/scripts/general/num2str.m @@ -64,54 +64,82 @@ if (nargin != 1 && nargin != 2) print_usage (); + elseif (! ismatrix (x)) + error ("num2str: X must be a numeric, logical, or character array"); endif if (ischar (x)) retval = x; elseif (isempty (x)) retval = ""; - elseif (iscomplex (x)) + elseif (isreal (x)) + if (nargin == 2) + if (ischar (arg)) + fmt = arg; + elseif (isnumeric (arg) && isscalar (arg) && arg >= 0) + fmt = sprintf ("%%%d.%dg", arg+7, arg); + else + error ("num2str: PRECISION must be a scalar integer >= 0"); + endif + else + if (isnumeric (x)) + ## Setup a suitable format string + dgt = floor (log10 (max (abs (x(:))))); + if (any (x(:) != fix (x(:)))) + ## Floating point input + dgt = max (dgt + 4, 5); # Keep 4 sig. figures after decimal point + dgt = min (dgt, 16); # Cap significant digits at 16 + fmt = sprintf ("%%%d.%dg", dgt+7+any (x(:) < 0), dgt); + else + ## Integer input + dgt = max (dgt + 1, 1); + ## FIXME: Integers should be masked to show only 16 significant digits + ## See %!xtest below + fmt = sprintf ("%%%d.%dg", dgt+2+any (x(:) < 0), dgt); + endif + else + ## Logical input + fmt = "%3d"; + endif + endif + fmt = cstrcat (deblank (repmat (fmt, 1, columns (x))), "\n"); + nd = ndims (x); + tmp = sprintf (fmt, permute (x, [2, 1, 3:nd])); + retval = strtrim (char (strsplit (tmp(1:end-1), "\n"))); + else # Complex matrix input if (nargin == 2) if (ischar (arg)) fmt = cstrcat (arg, "%-+", arg(2:end), "i"); + elseif (isnumeric (arg) && isscalar (arg) && arg >= 0) + fmt = sprintf ("%%%d.%dg%%-+%d.%dgi", arg+7, arg, arg+7, arg); else - if (isnumeric (x) && x == fix (x) && abs (x) < (10 .^ arg)) - fmt = sprintf ("%%%dd%%-+%ddi ", arg, arg); - else - fmt = sprintf ("%%%d.%dg%%-+%d.%dgi", arg+7, arg, arg+7, arg); - endif + error ("num2str: PRECISION must be a scalar integer >= 0"); endif else ## Setup a suitable format string - if (isnumeric (x) && x == fix (x) && abs (x) < 1e10) - if (max (abs (real (x(:)))) == 0) - dgt1 = 2; - else - dgt1 = ceil (log10 (max (max (abs (real (x(:)))), - max (abs (imag (x(:))))))) + 2; - endif - dgt2 = dgt1 - (min (real (x(:))) >= 0); - - if (length (abs (x) == x) > 0) - fmt = sprintf("%%%dg%%+-%dgi ", dgt2, dgt1); - else - fmt = sprintf("%%%dd%%+-%ddi ", dgt2, dgt1); - endif - elseif (isscalar (x)) - fmt = "%.6g%-+.6gi"; + dgt = floor (log10 (max (max (abs (real (x(:)))), + max (abs (imag (x(:))))))); + if (any (x(:) != fix (x(:)))) + ## Floating point input + dgt = max (dgt + 4, 5); # Keep 4 sig. figures after decimal point + dgt = min (dgt, 16); # Cap significant digits at 16 + fmt = sprintf ("%%%d.%dg%%-+%d.%dgi", dgt+7, dgt, dgt+7, dgt); else - fmt = "%11.6g%-+11.6gi"; + ## Integer input + dgt = max (1 + dgt, 1); + ## FIXME: Integers should be masked to show only 16 significant digits + ## See %!xtest below + fmt = sprintf ("%%%d.%dg%%-+%d.%dgi", dgt+2, dgt, dgt+2, dgt); endif endif ## Manipulate the complex value to have real values in the odd ## columns and imaginary values in the even columns. - sz = size (x); - nc = sz(2); + nc = columns (x); nd = ndims (x); - perm = fix ([1:0.5:nc+0.5]); - perm(2:2:2*nc) = perm(2:2:2*nc) + nc; idx = repmat ({':'}, nd, 1); + perm(1:2:2*nc) = 1:nc; + perm(2:2:2*nc) = nc + (1:nc); idx{2} = perm; x = horzcat (real (x), imag (x)); x = x(idx{:}); @@ -120,59 +148,10 @@ tmp = sprintf (fmt, permute (x, [2, 1, 3:nd])); ## Put the "i"'s where they are supposed to be. - while (true) - tmp2 = strrep (tmp, " i\n", "i\n"); - if (length (tmp) == length (tmp2)) - break; - else - tmp = tmp2; - endif - endwhile - while (true) - tmp2 = strrep (tmp, " i", "i "); - if (tmp == tmp2) - break; - else - tmp = tmp2; - endif - endwhile + tmp = regexprep (tmp, " +i\n", "i\n"); + tmp = regexprep (tmp, "( +)i", "i$1"); - tmp(length (tmp)) = ""; - retval = char (strtrim (strsplit (tmp, "\n"))); - else - if (nargin == 2) - if (ischar (arg)) - fmt = arg; - else - if (isnumeric (x) && x == fix (x) && abs (x) < (10 .^ arg)) - fmt = sprintf ("%%%dd ", arg); - else - fmt = sprintf ("%%%d.%dg", arg+7, arg); - endif - endif - else - if (isnumeric (x) && x == fix (x) && abs (x) < 1e10) - if (max (abs (x(:))) == 0) - dgt = 2; - else - dgt = floor (log10 (max (abs(x(:))))) + (min (real (x(:))) < 0) + 2; - endif - if (length (abs (x) == x) > 0) - fmt = sprintf ("%%%dg ", dgt); - else - fmt = sprintf ("%%%dd ", dgt); - endif - elseif (isscalar (x)) - fmt = "%11.5g"; - else - fmt = "%11.5g"; - endif - endif - fmt = cstrcat (deblank (repmat (fmt, 1, columns (x))), "\n"); - nd = ndims (x); - tmp = sprintf (fmt, permute (x, [2, 1, 3:nd])); - tmp(length (tmp)) = ""; - retval = strtrim (char (strsplit (tmp, "\n"))); + retval = strtrim (char (strsplit (tmp(1:end-1), "\n"))); endif endfunction @@ -183,7 +162,26 @@ %!assert (num2str (123.456, 4), "123.5") %!assert (num2str ([1, 1.34; 3, 3.56], "%5.1f"), ["1.0 1.3"; "3.0 3.6"]) %!assert (num2str (1.234 + 27.3i), "1.234+27.3i") +%!assert (num2str ([true false true]), "1 0 1"); + +%!assert (num2str (19440606), "19440606") +%!assert (num2str (2^33), "8589934592") +%!assert (num2str (-2^33), "-8589934592") +%!assert (num2str (2^33+1i), "8589934592+1i") +%!assert (num2str (-2^33+1i), "-8589934592+1i") + +## FIXME: Integers greater than bitmax() should be masked to show just +## 16 digits of precision. +%!xtest +%! assert (num2str (1e23), "100000000000000000000000"); %!error num2str () %!error num2str (1, 2, 3) +%!error num2str ({1}) +%!error num2str (1, {1}) +%!error num2str (1, ones (2)) +%!error num2str (1, -1) +%!error num2str (1+1i, {1}) +%!error num2str (1+1i, ones (2)) +%!error num2str (1+1i, -1) diff --git a/scripts/geometry/delaunay.m b/scripts/geometry/delaunay.m --- a/scripts/geometry/delaunay.m +++ b/scripts/geometry/delaunay.m @@ -56,7 +56,7 @@ ## plot (VX, VY, "b", x, y, "r*"); ## @end group ## @end example -## @seealso{delaunay3, delaunayn, convhull, voronoi} +## @seealso{delaunay3, delaunayn, convhull, voronoi, triplot, trimesh, trisurf} ## @end deftypefn ## Author: Kai Habel diff --git a/scripts/geometry/delaunay3.m b/scripts/geometry/delaunay3.m --- a/scripts/geometry/delaunay3.m +++ b/scripts/geometry/delaunay3.m @@ -42,7 +42,7 @@ ## To append user options to the defaults it is necessary to repeat the ## default arguments in @var{options}. Use a null string to pass no arguments. ## -## @seealso{delaunay, delaunayn, convhull, voronoi} +## @seealso{delaunay, delaunayn, convhull, voronoi, tetramesh} ## @end deftypefn ## Author: Kai Habel diff --git a/scripts/geometry/delaunayn.m b/scripts/geometry/delaunayn.m --- a/scripts/geometry/delaunayn.m +++ b/scripts/geometry/delaunayn.m @@ -47,7 +47,7 @@ ## To append user options to the defaults it is necessary to repeat the ## default arguments in @var{options}. Use a null string to pass no arguments. ## -## @seealso{delaunay, delaunay3, convhulln, voronoin} +## @seealso{delaunay, delaunay3, convhulln, voronoin, trimesh, tetramesh} ## @end deftypefn function T = delaunayn (pts, varargin) diff --git a/scripts/geometry/rectint.m b/scripts/geometry/rectint.m --- a/scripts/geometry/rectint.m +++ b/scripts/geometry/rectint.m @@ -43,7 +43,7 @@ error ("rectint: A must have 4 columns"); elseif (columns (b) != 4) error ("rectint: B must have 4 columns"); - elseif any ([a(:,3:4);b(:,3:4)](:) < 0) + elseif (any ([a(:,3:4);b(:,3:4)](:) < 0)) error ("rectint: all widths and heights must be > 0"); endif @@ -105,7 +105,7 @@ endfor - if swapinputs + if (swapinputs) area = area'; endif diff --git a/scripts/help/gen_doc_cache.m b/scripts/help/gen_doc_cache.m --- a/scripts/help/gen_doc_cache.m +++ b/scripts/help/gen_doc_cache.m @@ -34,7 +34,7 @@ function gen_doc_cache (out_file = "doc-cache", directory = []) ## Check input - if (!ischar (out_file)) + if (! ischar (out_file)) print_usage (); endif @@ -42,11 +42,11 @@ if (isempty (directory)) cache = gen_builtin_cache (); elseif (iscell (directory)) - if all(cellfun (@ischar, directory)) + if (all (cellfun (@ischar, directory))) cache = gen_doc_cache_in_dir (directory); else error ("gen_doc_cache: cell must contain only strings"); - end + endif elseif (ischar (directory)) cache = gen_doc_cache_in_dir (directory); else @@ -120,15 +120,15 @@ dir_in_path = ismember (directory, strsplit (path (), pathsep ())); # dirs not in path - if !iscell (directory) + if (! iscell (directory)) directory = {directory}; - end + endif dirs_notpath = {directory{!dir_in_path}}; # add them - if !isempty (dirs_notpath) + if (! isempty (dirs_notpath)) cellfun (@addpath, dirs_notpath); - end + endif # create cache func = @(s_) create_cache (__list_functions__ (s_)); @@ -138,9 +138,9 @@ cache = [cache{:}]; #remove dirs form path - if !isempty (dirs_notpath) + if (! isempty (dirs_notpath)) cellfun (@rmpath, dirs_notpath); - end + endif endfunction diff --git a/scripts/help/unimplemented.m b/scripts/help/unimplemented.m --- a/scripts/help/unimplemented.m +++ b/scripts/help/unimplemented.m @@ -178,7 +178,6 @@ "figurepalette", "filebrowser", "fill3", - "findfigs", "fitsinfo", "fitsread", "flow", @@ -191,7 +190,6 @@ "gco", "getframe", "getpixelposition", - "gmres", "grabcode", "graymon", "gsvd", @@ -340,7 +338,6 @@ "serial", "setpixelposition", "showplottool", - "shrinkfaces", "smooth3", "snapnow", "sound", @@ -360,7 +357,6 @@ "surf2patch", "symmlq", "syntax", - "tetramesh", "texlabel", "textwrap", "tfqmr", diff --git a/scripts/image/hsv2rgb.m b/scripts/image/hsv2rgb.m --- a/scripts/image/hsv2rgb.m +++ b/scripts/image/hsv2rgb.m @@ -59,7 +59,7 @@ endif ## set values <0 to 0 and >1 to 1 - hsv_map = (hsv_map >= 0 & hsv_map <= 1) .* hsv_map \ + hsv_map = (hsv_map >= 0 & hsv_map <= 1) .* hsv_map ... + (hsv_map < 0) .* 0 + (hsv_map > 1); ## fill rgb map with v*(1-s) diff --git a/scripts/image/rainbow.m b/scripts/image/rainbow.m --- a/scripts/image/rainbow.m +++ b/scripts/image/rainbow.m @@ -48,16 +48,15 @@ elseif (n > 1) x = linspace (0, 1, n)'; - r = (x < 2/5) \ - + (x >= 2/5 & x < 3/5) .* (-5 * x + 3) \ - + (x >= 4/5) .* (10/3 * x - 8/3); + r = ((x < 2/5) + + (x >= 2/5 & x < 3/5) .* (-5 * x + 3) + + (x >= 4/5) .* (10/3 * x - 8/3)); - g = (x < 2/5) .* (5/2 * x) \ - + (x >= 2/5 & x < 3/5) \ - + (x >= 3/5 & x < 4/5) .* (-5 * x + 4); + g = ((x < 2/5) .* (5/2 * x) + + (x >= 2/5 & x < 3/5) + + (x >= 3/5 & x < 4/5) .* (-5 * x + 4)); - b = (x >= 3/5 & x < 4/5) .* (5 * x - 3) \ - + (x >= 4/5); + b = (x >= 3/5 & x < 4/5) .* (5 * x - 3) + (x >= 4/5); map = [r, g, b]; else diff --git a/scripts/io/strread.m b/scripts/io/strread.m --- a/scripts/io/strread.m +++ b/scripts/io/strread.m @@ -1,5 +1,5 @@ ## Copyright (C) 2009-2012 Eric Chassande-Mottin, CNRS (France) -## Copyright (C) 2012 Philip Nienhuis +## Parts Copyright (C) 2012 Philip Nienhuis ## ## This file is part of Octave. ## diff --git a/scripts/io/textread.m b/scripts/io/textread.m --- a/scripts/io/textread.m +++ b/scripts/io/textread.m @@ -41,14 +41,16 @@ ## delimiters. ## @end itemize ## -## The optional input @var{n} specifes the number of times to use -## @var{format} when parsing, i.e., the format repeat count. +## The optional input @var{n} specifes the number of data lines to read; in +## this sense it differs slightly from the format repeat count in strread. ## ## @seealso{strread, load, dlmread, fscanf, textscan} ## @end deftypefn function varargout = textread (filename, format = "%f", varargin) + BUFLENGTH = 4096; # Read buffer to speed up processing @var{n} + ## Check input if (nargin < 1) print_usage (); @@ -58,6 +60,17 @@ error ("textread: FILENAME and FORMAT arguments must be strings"); endif + if (! isempty (varargin) && isnumeric (varargin{1})) + nlines = varargin{1}; + else + nlines = Inf; + endif + if (nlines < 1) + printf ("textread: N = 0, no data read\n"); + varargout = cell (1, nargout); + return + endif + ## Read file fid = fopen (filename, "r"); if (fid == -1) @@ -71,28 +84,13 @@ fskipl (fid, varargin{headerlines + 1}); varargin(headerlines:headerlines+1) = []; endif - - if (! isempty (varargin) && isnumeric (varargin{1})) - nlines = varargin{1}; - else - nlines = Inf; - endif + st_pos = ftell (fid); - if (isfinite (nlines) && (nlines >= 0)) - str = tmp_str = ""; - n = 0; - ## FIXME: Can this be done without slow loop? - while (ischar (tmp_str) && n++ <= nlines) - str = strcat (str, tmp_str); - tmp_str = fgets (fid); - endwhile - else - str = fread (fid, "char=>char").'; - endif - fclose (fid); - - if (isempty (str)) + ## Read a first file chunk. Rest follows after endofline processing + [str, count] = fscanf (fid, "%c", BUFLENGTH); + if (isempty (str) || count < 1) warning ("textread: empty file"); + varargout = cell (1, nargout); return; endif @@ -103,8 +101,8 @@ error ("textread: character value required for EndOfLine"); endif else - ## Determine EOL from file. Search for EOL candidates in first 3000 chars - eol_srch_len = min (length (str), 3000); + ## Determine EOL from file. Search for EOL candidates in first BUFLENGTH chars + eol_srch_len = min (length (str), BUFLENGTH); ## First try DOS (CRLF) if (! isempty (strfind ("\r\n", str(1 : eol_srch_len)))) eol_char = "\r\n"; @@ -116,12 +114,49 @@ eol_char = "\n"; endif ## Set up default endofline param value - varargin(end+1:end+2) = {'endofline', eol_char}; + varargin(end+1:end+2) = {"endofline", eol_char}; endif - + + ## Now that we know what EOL looks like, we can process format_repeat_count. + ## FIXME The below isn't ML-compatible: counts lines, not format string uses + if (isfinite (nlines) && (nlines > 0)) + l_eol_char = length (eol_char); + eoi = findstr (str, eol_char); + n_eoi = length (eoi); + nblks = 0; + ## Avoid slow repeated str concatenation, first seek requested end of data + while (n_eoi < nlines && count == BUFLENGTH) + [nstr, count] = fscanf (fid, "%c", BUFLENGTH); + if (count > 0) + ## Watch out for multichar EOL being missed across buffer boundaries + if (l_eol_char > 1) + str = [str(end - length (eol_char) + 2 : end) nstr]; + else + str = nstr; + endif + eoi = findstr (str, eol_char); + n_eoi += numel (eoi); + ++nblks; + endif + endwhile + ## Found EOL delimiting last requested line. Compute ptr (incl. EOL) + if (isempty (eoi)) + printf ("textread: format repeat count specified but no endofline found\n"); + eoi_pos = nblks * BUFLENGTH + count; + else + eoi_pos = (nblks * BUFLENGTH) + eoi(end + min (nlines, n_eoi) - n_eoi); + endif + fseek (fid, st_pos, "bof"); + str = fscanf (fid, "%c", eoi_pos); + else + fseek (fid, st_pos, "bof"); + str = fread(fid, "char=>char").'; + endif + fclose (fid); + ## Set up default whitespace param value if needed - if (isempty (find (strcmpi ('whitespace', varargin)))) - varargin(end+1:end+2) = {'whitespace', " \b\t"}; + if (isempty (find (strcmpi ("whitespace", varargin)))) + varargin(end+1:end+2) = {"whitespace", " \b\t"}; endif ## Call strread to make it do the real work diff --git a/scripts/io/textscan.m b/scripts/io/textscan.m --- a/scripts/io/textscan.m +++ b/scripts/io/textscan.m @@ -52,8 +52,11 @@ ## have been encountered. If set to 0 or false, return an error and no data. ## @end itemize ## -## The optional input @var{n} specifes the number of times to use -## @var{format} when parsing, i.e., the format repeat count. +## When reading from a character string, optional input argument @var{n} +## specifes the number of times @var{format} should be used (i.e., to limit +## the amount of data read). +## When reading fro file, @var{n} specifes the number of data lines to read; +## in this sense it differs slightly from the format repeat count in strread. ## ## The output @var{C} is a cell array whose length is given by the number ## of format specifiers. @@ -66,6 +69,8 @@ function [C, position] = textscan (fid, format = "%f", varargin) + BUFLENGTH = 4096; ## Read buffer + ## Check input if (nargin < 1) print_usage (); @@ -89,6 +94,11 @@ else nlines = Inf; endif + if (nlines < 1) + printf ("textscan: N = 0, no data read\n"); + C = []; + return + endif if (! any (strcmpi (args, "emptyvalue"))) ## Matlab returns NaNs for missing values @@ -148,26 +158,17 @@ endif str = fid; else + st_pos = ftell (fid); ## Skip header lines if requested headerlines = find (strcmpi (args, "headerlines"), 1); ## Beware of zero valued headerline, fskipl would skip to EOF if (! isempty (headerlines) && (args{headerlines + 1} > 0)) - fskipl (fid, varargin{headerlines + 1}); + fskipl (fid, args{headerlines + 1}); args(headerlines:headerlines+1) = []; + st_pos = ftell (fid); endif - if (isfinite (nlines) && (nlines >= 0)) - str = tmp_str = ""; - n = 0; - ## FIXME: Can this be done without slow loop? - while (ischar (tmp_str) && n++ < nlines) - tmp_str = fgets (fid); - if (ischar (tmp_str)) - str = strcat (str, tmp_str); - endif - endwhile - else - str = fread (fid, "char=>char").'; - endif + ## Read a first file chunk. Rest follows after endofline processing + [str, count] = fscanf (fid, "%c", BUFLENGTH); endif ## Check for empty result @@ -189,8 +190,8 @@ error ("textscan: character value required for EndOfLine"); endif else - ## Determine EOL from file. Search for EOL candidates in first 3000 chars - eol_srch_len = min (length (str), 3000); + ## Determine EOL from file. Search for EOL candidates in first BUFLENGTH chars + eol_srch_len = min (length (str), BUFLENGTH); ## First try DOS (CRLF) if (! isempty (strfind ("\r\n", str(1 : eol_srch_len)))) eol_char = "\r\n"; @@ -202,7 +203,47 @@ eol_char = "\n"; endif ## Set up the default endofline param value - args(end+1:end+2) = {'endofline', eol_char}; + args(end+1:end+2) = {"endofline", eol_char}; + endif + + if (!ischar (fid)) + ## Now that we know what EOL looks like, we can process format_repeat_count. + ## FIXME The below isn't ML-compatible: counts lines, not format string uses + if (isfinite (nlines) && (nlines >= 0)) + l_eol_char = length (eol_char); + eoi = findstr (str, eol_char); + n_eoi = length (eoi); + nblks = 0; + ## Avoid slow repeated str concatenation, first seek requested end of data + while (n_eoi < nlines && count == BUFLENGTH) + [nstr, count] = fscanf (fid, "%c", BUFLENGTH); + if (count > 0) + ## Watch out for multichar EOL being missed across buffer boundaries + if (l_eol_char > 1) + str = [str(end - length (eol_char) + 2 : end) nstr]; + else + str = nstr; + endif + eoi = findstr (str, eol_char); + n_eoi += numel (eoi); + ++nblks; + endif + endwhile + ## OK, found EOL delimiting last requested line. Compute ptr (incl. EOL) + if (isempty (eoi)) + printf ("textscan: format repeat count specified but no endofline found\n"); + data_size = nblks * BUFLENGTH + count; + else + ## Compute data size to read incl complete EOL + data_size = (nblks * BUFLENGTH) + eoi(end + min (nlines, n_eoi) - n_eoi) \ + + l_eol_char - 1; + endif + fseek (fid, st_pos, "bof"); + str = fscanf (fid, "%c", data_size); + else + fseek (fid, st_pos, "bof"); + str = fread (fid, "char=>char").'; + endif endif ## Determine the number of data fields @@ -223,6 +264,7 @@ endif if (nargout == 2) + ## Remember file position (persistent var) position = ftell (fid); endif @@ -234,10 +276,10 @@ ## Start at rightmost column and work backwards to avoid ptr mixup ii = numel (C); - while ii > 1 + while (ii > 1) clss1 = class (C{ii}); jj = ii; - while (jj > 1 && strcmp (clss1, class (C{jj - 1}))) + while (jj > 1 && strcmp (clss1, class (C{jj - 1}))) ## Column to the left is still same class; check next column to the left --jj; endwhile diff --git a/scripts/linear-algebra/condest.m b/scripts/linear-algebra/condest.m --- a/scripts/linear-algebra/condest.m +++ b/scripts/linear-algebra/condest.m @@ -132,7 +132,7 @@ have_A = true; if (nargin > 1) - if (isscalar (varargin{2})) + if (! is_function_handle (varargin{2})) t = varargin{2}; have_t = true; elseif (nargin > 2) diff --git a/scripts/linear-algebra/onenormest.m b/scripts/linear-algebra/onenormest.m --- a/scripts/linear-algebra/onenormest.m +++ b/scripts/linear-algebra/onenormest.m @@ -95,7 +95,7 @@ function [est, v, w, iter] = onenormest (varargin) - if (size (varargin, 2) < 1 || size (varargin, 2) > 4) + if (nargin < 1 || nargin > 4) print_usage (); endif @@ -103,31 +103,31 @@ itmax = 10; if (ismatrix (varargin{1})) - n = size (varargin{1}, 1); - if n != size (varargin{1}, 2), + [n, nc] = size (varargin{1}); + if (n != nc) error ("onenormest: matrix must be square"); endif apply = @(x) varargin{1} * x; apply_t = @(x) varargin{1}' * x; - if (size (varargin) > 1) + if (nargin > 1) t = varargin{2}; else t = min (n, default_t); endif - issing = isa (varargin {1}, "single"); + issing = isa (varargin{1}, "single"); else - if (size (varargin, 2) < 3) - print_usage(); + if (nargin < 3) + print_usage (); endif - n = varargin{3}; apply = varargin{1}; apply_t = varargin{2}; - if (size (varargin) > 3) + n = varargin{3}; + if (nargin > 3) t = varargin{4}; else t = default_t; endif - issing = isa (varargin {3}, "single"); + issing = isa (n, "single"); endif ## Initial test vectors X. @@ -175,7 +175,7 @@ ## Test if any of S are approximately parallel to previous S ## vectors or current S vectors. If everything is parallel, - ## stop. Otherwise, replace any parallel vectors with + ## stop. Otherwise, replace any parallel vectors with ## rand{-1,+1}. partest = any (abs (S_old' * S - n) < 4*eps*n); if (all (partest)) @@ -201,8 +201,7 @@ Z = feval (apply_t, S); - ## Now find the largest non-previously-visted index per - ## vector. + ## Now find the largest non-previously-visted index per vector. h = max (abs (Z),2); [mh, mhi] = max (h); if (iter >= 2 && mhi == ind_best) @@ -216,10 +215,10 @@ ## Visited all these before, so stop. break; endif - ind = ind (!been_there (ind)); + ind = ind(! been_there(ind)); if (length (ind) < t) ## There aren't enough new vectors, so we're practically - ## in a cycle. Stop. + ## in a cycle. Stop. break; endif endif @@ -229,13 +228,14 @@ for zz = 1 : t X(ind(zz),zz) = 1; endfor - been_there (ind (1 : t)) = 1; + been_there(ind(1 : t)) = 1; endfor - ## The estimate est and vector w are set in the loop above. The - ## vector v selects the ind_best column of A. + ## The estimate est and vector w are set in the loop above. + ## The vector v selects the ind_best column of A. v = zeros (n, 1); v(ind_best) = 1; + endfunction diff --git a/scripts/miscellaneous/bzip2.m b/scripts/miscellaneous/bzip2.m --- a/scripts/miscellaneous/bzip2.m +++ b/scripts/miscellaneous/bzip2.m @@ -31,7 +31,7 @@ function entries = bzip2 (varargin) if (nargin == 1 || nargin == 2) - if nargout == 0 + if (nargout == 0) __xzip__ ("bzip2", "bz2", "bzip2 %s", varargin{:}); else entries = __xzip__ ("bzip2", "bz2", "bzip2 %s", varargin{:}); diff --git a/scripts/miscellaneous/compare_versions.m b/scripts/miscellaneous/compare_versions.m --- a/scripts/miscellaneous/compare_versions.m +++ b/scripts/miscellaneous/compare_versions.m @@ -141,22 +141,22 @@ endif ## Determine the operator. - if any (ismember (operator, "=")) + if (any (ismember (operator, "="))) equal_op = true; else equal_op = false; endif - if any (ismember (operator, "~!")) + if (any (ismember (operator, "~!"))) not_op = true; else not_op = false; endif - if any (ismember (operator, "<")) + if (any (ismember (operator, "<"))) lt_op = true; else lt_op = false; endif - if any (ismember (operator, ">")) + if (any (ismember (operator, ">"))) gt_op = true; else gt_op = false; diff --git a/scripts/miscellaneous/fact.m b/scripts/miscellaneous/fact.m --- a/scripts/miscellaneous/fact.m +++ b/scripts/miscellaneous/fact.m @@ -24,8 +24,8 @@ ## @end deftypefn -function f = fact() - persistent wisdom = \ +function f = fact () + persistent wisdom = ... { "Richard Stallman takes notes in binary."; "Richard Stallman doesn't need sudo. I will make him a sandwich anyway."; @@ -240,7 +240,7 @@ }; w = wisdom{randi([1, numel(wisdom)])}; - if nargout > 0 + if (nargout > 0) f = w; else w = wordwrap (w); @@ -254,14 +254,15 @@ out = "\n"; i = 1; numwords = numel (wc); - while i <= numwords; + while (i <= numwords); line = wc{i}; - while (i < numwords && length (newline = cstrcat (line, " ", wc{i+1})) < cols) + while (i < numwords + && length (newline = cstrcat (line, " ", wc{i+1})) < cols) line = newline; i++; endwhile out = cstrcat (out, line, "\n"); i++; endwhile - out = cstrcat(out, "\n"); + out = cstrcat (out, "\n"); endfunction \ No newline at end of file diff --git a/scripts/miscellaneous/menu.m b/scripts/miscellaneous/menu.m --- a/scripts/miscellaneous/menu.m +++ b/scripts/miscellaneous/menu.m @@ -44,13 +44,41 @@ page_screen_output (0, "local"); + ## Process Supplied Options + if (nargin == 2) + ## List in a cell array + if (iscell (varargin{1})) + varargin = varargin{1}; + nopt = length (varargin); + for i = 1:nopt + while (iscell (varargin{i})) + varargin{i} = varargin{i}{1}; + endwhile + endfor + else + nopt = nargin - 1; + endif + else + ## List with random elements in it - pick the first always + for i = 1:nargin - 1 + if (iscell (varargin{i})) + while (iscell (varargin{i})) + varargin{i} = varargin{i}{1}; + endwhile + else + if (! ischar (varargin{i})) + varargin{i} = varargin{i}(1); + endif + endif + endfor + nopt = length (varargin); + endif + if (! isempty (title)) disp (title); printf ("\n"); endif - nopt = nargin - 1; - while (1) for i = 1:nopt printf (" [%2d] ", i); diff --git a/scripts/optimization/fminbnd.m b/scripts/optimization/fminbnd.m --- a/scripts/optimization/fminbnd.m +++ b/scripts/optimization/fminbnd.m @@ -56,8 +56,8 @@ ## Get default options if requested. if (nargin == 1 && ischar (fun) && strcmp (fun, 'defaults')) - x = optimset ("MaxIter", Inf, "MaxFunEvals", Inf, "TolX", 1e-8, \ - "OutputFcn", [], "FunValCheck", "off"); + x = optimset ("MaxIter", Inf, "MaxFunEvals", Inf, "TolX", 1e-8, + "OutputFcn", [], "FunValCheck", "off"); return; endif diff --git a/scripts/optimization/fminunc.m b/scripts/optimization/fminunc.m --- a/scripts/optimization/fminunc.m +++ b/scripts/optimization/fminunc.m @@ -84,11 +84,11 @@ ## Get default options if requested. if (nargin == 1 && ischar (fcn) && strcmp (fcn, 'defaults')) - x = optimset ("MaxIter", 400, "MaxFunEvals", Inf, \ - "GradObj", "off", "TolX", 1e-7, "TolFun", 1e-7, - "OutputFcn", [], "FunValCheck", "off", - "FinDiffType", "central", - "TypicalX", [], "AutoScaling", "off"); + x = optimset ("MaxIter", 400, "MaxFunEvals", Inf, + "GradObj", "off", "TolX", 1e-7, "TolFun", 1e-7, + "OutputFcn", [], "FunValCheck", "off", + "FinDiffType", "central", + "TypicalX", [], "AutoScaling", "off"); return; endif diff --git a/scripts/optimization/fzero.m b/scripts/optimization/fzero.m --- a/scripts/optimization/fzero.m +++ b/scripts/optimization/fzero.m @@ -100,8 +100,8 @@ ## Get default options if requested. if (nargin == 1 && ischar (fun) && strcmp (fun, 'defaults')) - x = optimset ("MaxIter", Inf, "MaxFunEvals", Inf, "TolX", 1e-8, \ - "OutputFcn", [], "FunValCheck", "off"); + x = optimset ("MaxIter", Inf, "MaxFunEvals", Inf, "TolX", 1e-8, + "OutputFcn", [], "FunValCheck", "off"); return; endif diff --git a/scripts/optimization/sqp.m b/scripts/optimization/sqp.m --- a/scripts/optimization/sqp.m +++ b/scripts/optimization/sqp.m @@ -697,8 +697,8 @@ if (isempty (__sqp_cifcn__)) res = [x(lbidx,1)-__sqp_lb__; __sqp_ub__-x(ubidx,1)]; else - res = [feval(__sqp_cifcn__,x); \ - x(lbidx,1)-__sqp_lb__; __sqp_ub__-x(ubidx,1)]; + res = [feval(__sqp_cifcn__,x); x(lbidx,1)-__sqp_lb__; + __sqp_ub__-x(ubidx,1)]; endif endfunction diff --git a/scripts/pkg/private/configure_make.m b/scripts/pkg/private/configure_make.m --- a/scripts/pkg/private/configure_make.m +++ b/scripts/pkg/private/configure_make.m @@ -91,7 +91,7 @@ if (filenames(end) == "\n") filenames(end) = []; endif - filenames = split_by (filenames, "\n"); + filenames = strtrim (strsplit (filenames, "\n")); delete_idx = []; for i = 1:length (filenames) if (! all (isspace (filenames{i}))) diff --git a/scripts/pkg/private/install.m b/scripts/pkg/private/install.m --- a/scripts/pkg/private/install.m +++ b/scripts/pkg/private/install.m @@ -268,7 +268,7 @@ && any (strcmpi (a, str_true)))); endif - if (autoload > 0 || desc_autoload) + if (autoload > 0 || (autoload == 0 && desc_autoload)) fclose (fopen (fullfile (descriptions{i}.dir, "packinfo", ".autoload"), "wt")); descriptions{i}.autoload = 1; diff --git a/scripts/pkg/private/unload_packages.m b/scripts/pkg/private/unload_packages.m --- a/scripts/pkg/private/unload_packages.m +++ b/scripts/pkg/private/unload_packages.m @@ -35,7 +35,7 @@ endfor ## Get the current octave path. - p = split_by (path(), pathsep ()); + p = strtrim (strsplit (path(), pathsep ())); if (length (files) == 1 && strcmp (files{1}, "all")) ## Unload all. diff --git a/scripts/pkg/private/write_index.m b/scripts/pkg/private/write_index.m --- a/scripts/pkg/private/write_index.m +++ b/scripts/pkg/private/write_index.m @@ -74,7 +74,7 @@ if (! isfield (desc, "categories")) error ("the DESCRIPTION file must have a Categories field, when no INDEX file is given"); endif - categories = split_by (desc.categories, ","); + categories = strtrim (strsplit (desc.categories, ",")); if (length (categories) < 1) error ("the Category field is empty"); endif diff --git a/scripts/plot/__gnuplot_drawnow__.m b/scripts/plot/__gnuplot_drawnow__.m --- a/scripts/plot/__gnuplot_drawnow__.m +++ b/scripts/plot/__gnuplot_drawnow__.m @@ -259,9 +259,9 @@ size_str = ""; endif else - if isempty (h) + if (isempty (h)) disp ("gnuplot_set_term: figure handle is empty"); - elseif !isfigure(h) + elseif (! isfigure (h)) disp ("gnuplot_set_term: not a figure handle"); endif title_str = ""; diff --git a/scripts/plot/axis.m b/scripts/plot/axis.m --- a/scripts/plot/axis.m +++ b/scripts/plot/axis.m @@ -180,7 +180,7 @@ __do_tight_option__ (ca); elseif (strcmpi (ax, "square")) set (ca, "plotboxaspectratio", [1, 1, 1]); - elseif (strcmp (ax, "equal")) + elseif (strcmp (ax, "equal")) if (strcmp (get (get (ca, "parent"), "__graphics_toolkit__"), "gnuplot")) ## FIXME - gnuplot applies the aspect ratio activepostionproperty. set (ca, "activepositionproperty", "position"); @@ -321,7 +321,7 @@ scale = get (ca, strcat (ax, "scale")); if (! iscell (data)) data = {data}; - end + endif if (strcmp (scale, "log")) tmp = data; data = cellfun (@(x) x(x>0), tmp, "uniformoutput", false); @@ -346,7 +346,7 @@ set (ca, "xlim", __get_tight_lims__ (ca, "x"), "ylim", __get_tight_lims__ (ca, "y")); - if __calc_dimensions__ (ca) > 2 + if (__calc_dimensions__ (ca) > 2) set (ca, "zlim", __get_tight_lims__ (ca, "z")); endif diff --git a/scripts/plot/findfigs.m b/scripts/plot/findfigs.m new file mode 100644 --- /dev/null +++ b/scripts/plot/findfigs.m @@ -0,0 +1,81 @@ +## Copyright (C) 2008 Bill Denney +## Copyright (C) 2012 Carnë Draug +## +## 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 3 of the License, 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, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} findfigs () +## Find all visible figures that are currently off the screen and move them +## onto the screen. +## @seealso{allchild, figure, get, set} +## @end deftypefn + +## Author: Bill Denney +## Modified by: Carnë Draug + +function findfigs () + + figh = allchild (0); + units = get (0, "units"); + unwind_protect + if (!strcmp (units, "pixels")) + set (0, "units", "pixels"); + endif + screensize = get (0, "screensize"); + unwind_protect_cleanup + set (0, "units", units); + end_unwind_protect + + ## give the monitor a margin so that the figure must not just + ## marginally be on the monitor. + margin = 30; + screensize(1:2) += margin; + screensize(3:4) -= margin; + + for i = 1:numel (figh) + if strcmp (get (figh(i), "visible"), "on") + + units = get (figh(i), "units"); + unwind_protect + if (!strcmp (units, "pixels")) + set (figh(i), "units", "pixels"); + endif + pos = get (figh(i), "position"); + ## Test if (in order): + ## The left side is outside the right side of the screen + ## The bottom is above the top of the screen + ## The right side is outside the left of the screen + ## the top is below the bottom of the screen + if (pos(1) > screensize(3) + || pos(2) > screensize(4) + || pos(1)+pos(3) < screensize(1) + || pos(2)+pos(4) < screensize(2)) + + ## the new position will be at the top left of the screen + ## (all moved figures will overlap). The bottom left is chosen + ## instead of the top left because that allows for the unknown + ## amount of space for the menu bar and the title bar. + pos(1) = screensize(1); + pos(2) = screensize(2); + set (figh(i), "position", pos); + endif + unwind_protect_cleanup + set (figh(i), "units", units); + end_unwind_protect + endif + endfor +endfunction diff --git a/scripts/plot/findobj.m b/scripts/plot/findobj.m --- a/scripts/plot/findobj.m +++ b/scripts/plot/findobj.m @@ -148,16 +148,16 @@ na = na + 1; if (na <= numel(args)) if (ischar (args{na})) - if strcmpi(args{na}, "-and") + if (strcmpi (args{na}, "-and")) logicaloperator{np} = "and"; na = na+1; - elseif strcmpi(args{na}, "-or") + elseif (strcmpi (args{na}, "-or")) logicaloperator{np} = "or"; na = na+1; - elseif strcmpi(args{na}, "-xor") + elseif (strcmpi (args{na}, "-xor")) logicaloperator{np} = "xor"; na = na+1; - elseif strcmpi(args{na}, "-not") + elseif (strcmpi (args{na}, "-not")) logicaloperator{np} = "not"; na = na+1; endif @@ -173,7 +173,7 @@ endif else ## This is sloppy ... but works like Matlab. - if strcmpi(args{na}, "-not") + if (strcmpi (args{na}, "-not")) h = []; return endif @@ -213,7 +213,7 @@ else if (regularexpression(np)) match = regexp (p.(pname{np}), pvalue{np}); - if isempty (match) + if (isempty (match)) match = 0; endif elseif (numel (p.(pname{np})) == numel (pvalue{np})) diff --git a/scripts/plot/legend.m b/scripts/plot/legend.m --- a/scripts/plot/legend.m +++ b/scripts/plot/legend.m @@ -272,11 +272,14 @@ else error ("legend: expecting argument to be a character string"); endif + elseif (nargs > 1 && iscellstr (varargin{1})) + varargin = {varargin{1}{:}, varargin{2:end}}; + nargs = numel (varargin); endif if (strcmp (show, "off")) if (! isempty (hlegend)) - set (get (hlegend, "children"), "visible", "off"); + set (findobj (hlegend), "visible", "off"); hlegend = []; endif hobjects = []; @@ -284,7 +287,9 @@ text_strings = {}; elseif (strcmp (show, "on")) if (! isempty (hlegend)) - set (get (hlegend, "children"), "visible", "on"); + set (findobj (hlegend), "visible", "on"); + ## NOTE - Matlab sets both "visible", and "box" to "on" + set (hlegend, "visible", get (hlegend, "box")); else hobjects = []; hplots = []; @@ -304,7 +309,7 @@ hax = getfield (get (hlegend, "userdata"), "handle"); [hplots, text_strings] = __getlegenddata__ (hlegend); - if (strcmp (position, "default")) + if (strcmp (position, "default")) h = legend (hax, hplots, text_strings, "orientation", orientation); elseif (strcmp (orientation, "default")) if (outside) @@ -435,7 +440,7 @@ text_strings = {}; endif else - ## Delete the old legend if it exists + ## Preserve the old legend if it exists if (! isempty (hlegend)) if (strcmp (textpos, "default")) textpos = get (hlegend, "textposition"); @@ -454,10 +459,6 @@ orientation = get (hlegend, "orientation"); endif box = get (hlegend, "box"); - fkids = get (fig, "children"); - - delete (hlegend); - hlegend = []; else if (strcmp (textpos, "default")) textpos = "left"; @@ -468,7 +469,7 @@ if (strcmp (orientation, "default")) orientation = "vertical"; endif - box = "off"; + box = "on"; endif ## Get axis size and fontsize in points. @@ -505,16 +506,16 @@ addprops = true; hlegend = axes ("tag", "legend", "userdata", struct ("handle", ud), "box", box, - "xtick", [], "ytick", [], "xticklabel", "", - "yticklabel", "", "zticklabel", "", - "xlim", [0, 1], "ylim", [0, 1], "visible", "off", + "xtick", [], "ytick", [], + "xticklabel", "", "yticklabel", "", "zticklabel", "", + "xlim", [0, 1], "ylim", [0, 1], + "visible", ifelse (strcmp (box, "on"), "on", "off"), "activepositionproperty", "position"); else addprops = false; axes (hlegend); delete (get (hlegend, "children")); endif - ## Add text label to the axis first, checking their extents nentries = numel (hplots); texthandle = []; @@ -823,9 +824,7 @@ text_kids = findobj (kids, "-property", "interpreter", "type", "text"); interpreter = get (h, "interpreter"); textcolor = get (h, "textcolor"); - set (kids, "interpreter", interpreter, "color", textcolor); - hobj = cell2mat (get (kids, "userdata")); - set (hobj, "interpreter", interpreter); + set (text_kids, "interpreter", interpreter, "color", textcolor); endfunction function hideshowlegend (h, d, ca, pos1, pos2) @@ -972,11 +971,26 @@ endif endfunction +%!demo +%! plot (rand (2)) +%! legend ({'foo'}, 'bar', 'boxoff') +%! title ('legend() should warn about an extra label') + +%!demo +%! plot (rand (2,2)) ; +%! h = legend ('a', 'b') ; +%! legend ('right') ; +%! set (h, 'textposition', 'left') +%! set (h, 'textposition', 'right') +%! set (h, 'textcolor', [1 0 1]) %!demo %! clf; %! x = 0:1; %! plot (x,x,';I am Blue;', x,2*x,';I am Green;', x,3*x,';I am Red;'); +%! legend boxon +%! legend hide +%! legend show %!demo %! clf; @@ -1007,9 +1021,9 @@ %!demo %! clf; %! plot (1:10, 1:10, 1:10, fliplr (1:10)); -%! title ('Legend with box on'); +%! title ('Legend with box off'); %! legend ({'I am blue', 'I am green'}, 'location', 'east'); -%! legend boxon; +%! legend boxoff; %!demo %! clf; @@ -1043,7 +1057,6 @@ %! title ('Signals with random offset and uniform noise'); %! xlabel ('Sample Nr [k]'); ylabel ('Amplitude [V]'); %! legend (labels, 'location', 'southoutside'); -%! legend ('boxon'); %!demo %! clf; @@ -1122,19 +1135,15 @@ %! subplot (2,2,1); %! plot (x, rand (numel (x))); %! legend (cellstr (num2str (x)), 'location', 'northwestoutside'); -%! legend boxon; %! subplot (2,2,2); %! plot (x, rand (numel (x))); %! legend (cellstr (num2str (x)), 'location', 'northeastoutside'); -%! legend boxon; %! subplot (2,2,3); %! plot (x, rand (numel (x))); %! legend (cellstr (num2str (x)), 'location', 'southwestoutside'); -%! legend boxon; %! subplot (2,2,4); %! plot (x, rand (numel (x))); %! legend (cellstr (num2str (x)), 'location', 'southeastoutside'); -%! legend boxon; %!demo %! clf; diff --git a/scripts/plot/line.m b/scripts/plot/line.m --- a/scripts/plot/line.m +++ b/scripts/plot/line.m @@ -43,6 +43,21 @@ endfunction +%!demo +%! clf +%! x = 0:0.3:10; +%! y1 = cos (x); +%! y2 = sin (x); +%! subplot (3, 1, 1) +%! args = {"color", "b", "marker", "s"}; +%! line ([x(:), x(:)], [y1(:), y2(:)], args{:}) +%! title ("Test broadcasting for line()") +%! subplot (3, 1, 2) +%! line (x(:), [y1(:), y2(:)], args{:}) +%! subplot (3, 1, 3) +%! line ([x(:), x(:)+pi/2], y1(:), args{:}) +%! xlim ([0 10]) + %!test %! hf = figure ("visible", "off"); %! unwind_protect diff --git a/scripts/plot/module.mk b/scripts/plot/module.mk --- a/scripts/plot/module.mk +++ b/scripts/plot/module.mk @@ -98,6 +98,7 @@ plot/figure.m \ plot/fill.m \ plot/findall.m \ + plot/findfigs.m \ plot/findobj.m \ plot/fplot.m \ plot/gca.m \ @@ -162,6 +163,7 @@ plot/semilogyerr.m \ plot/shading.m \ plot/shg.m \ + plot/shrinkfaces.m \ plot/slice.m \ plot/sombrero.m \ plot/specular.m \ @@ -175,6 +177,7 @@ plot/surfc.m \ plot/surfl.m \ plot/surfnorm.m \ + plot/tetramesh.m \ plot/text.m \ plot/title.m \ plot/trimesh.m \ diff --git a/scripts/plot/peaks.m b/scripts/plot/peaks.m --- a/scripts/plot/peaks.m +++ b/scripts/plot/peaks.m @@ -55,7 +55,7 @@ if (nargin == 0) x = y = linspace (-3, 3, 49); elseif (nargin == 1) - if length(x) > 1 + if (length (x) > 1) y = x; else x = y = linspace (-3, 3, x); @@ -69,8 +69,8 @@ Y = y; endif - Z = 3 * (1 - X) .^ 2 .* exp(- X .^ 2 - (Y + 1) .^ 2) \ - - 10 * (X / 5 - X .^ 3 - Y .^ 5) .* exp(- X .^ 2 - Y .^ 2) \ + Z = 3 * (1 - X) .^ 2 .* exp(- X .^ 2 - (Y + 1) .^ 2) ... + - 10 * (X / 5 - X .^ 3 - Y .^ 5) .* exp(- X .^ 2 - Y .^ 2) ... - 1 / 3 * exp(- (X + 1) .^ 2 - Y .^ 2); if (nargout == 0) diff --git a/scripts/plot/private/__errplot__.m b/scripts/plot/private/__errplot__.m --- a/scripts/plot/private/__errplot__.m +++ b/scripts/plot/private/__errplot__.m @@ -219,7 +219,7 @@ tlgnd(end+1) = fmt.key; legend (gca(), hlgnd, tlgnd); - end + endif endfunction diff --git a/scripts/plot/private/__fltk_print__.m b/scripts/plot/private/__fltk_print__.m --- a/scripts/plot/private/__fltk_print__.m +++ b/scripts/plot/private/__fltk_print__.m @@ -153,7 +153,7 @@ vw = get (haxes, "view"); if (iscell (vw)) vw = vertcat (vw{:}); - end + endif is2D = all (abs (vw(:,2)) == 90); if (is2D) gl2ps_device{end} = [gl2ps_device{end}, "is2D"]; diff --git a/scripts/plot/private/__go_draw_axes__.m b/scripts/plot/private/__go_draw_axes__.m --- a/scripts/plot/private/__go_draw_axes__.m +++ b/scripts/plot/private/__go_draw_axes__.m @@ -1581,8 +1581,9 @@ else fontspec = ""; endif - fprintf (plot_stream, "set key %s %s;\nset key %s %s %s %s;\n", - inout, pos, box, reverse, horzvert, fontspec); + colorspec = get_text_colorspec (hlgnd.textcolor, mono); + fprintf (plot_stream, "set key %s %s;\nset key %s %s %s %s %s;\n", + inout, pos, box, reverse, horzvert, fontspec, colorspec); else fputs (plot_stream, "unset key;\n"); endif @@ -2322,7 +2323,7 @@ if (! isempty (n1)) n1 = n1 + 1; n2 = setdiff (n2, n1); - end + endif for n = numel(n2):-1:1 labels{m} = [labels{m}(1:n2(n)-1), "\\", labels{m}(n2(n):end)]; endfor @@ -2339,7 +2340,7 @@ persistent sym = __setup_sym_table__ (); persistent flds = fieldnames (sym); - [s, e, m] = regexp(str,'\\([a-zA-Z]+|0)','start','end','matches'); + [s, e, m] = regexp(str,'\\\\([a-zA-Z]+|0)','start','end','matches'); for i = length (s) : -1 : 1 ## special case for "\0" and replace with "{/Symbol \306}' diff --git a/scripts/plot/private/__line__.m b/scripts/plot/private/__line__.m --- a/scripts/plot/private/__line__.m +++ b/scripts/plot/private/__line__.m @@ -46,7 +46,15 @@ endif if (num_data_args > 0 && ! size_equal (varargin{1:num_data_args})) - error ("line: number of X, Y, and Z points must be equal"); + n = 1:num_data_args; + m = cellfun (@numel, varargin(1:num_data_args)); + [~, m] = max (m); + b = ones (size (varargin{m(1)})); + try + varargin(n) = cellfun (@(x) bsxfun (@times, b, x), varargin(n), "uniformoutput", false); + catch + error ("line: number of X, Y, and Z points must be equal"); + end_try_catch endif if (rem (nvargs - num_data_args, 2) != 0) diff --git a/scripts/plot/private/__patch__.m b/scripts/plot/private/__patch__.m --- a/scripts/plot/private/__patch__.m +++ b/scripts/plot/private/__patch__.m @@ -326,7 +326,7 @@ if (nr == 1 && nc > 1) nr = nc; nc = 1; - end + endif if (!isempty (z)) vert = [x(:), y(:), z(:)]; else diff --git a/scripts/plot/private/__print_parse_opts__.m b/scripts/plot/private/__print_parse_opts__.m --- a/scripts/plot/private/__print_parse_opts__.m +++ b/scripts/plot/private/__print_parse_opts__.m @@ -154,7 +154,7 @@ if (arg_st.ghostscript.resolution == 0) ## Do as Matlab does. - arg_st.ghostscript.resolution = num2str (get (0, "screenpixelsperinch")); + arg_st.ghostscript.resolution = get (0, "screenpixelsperinch"); endif if (isempty (arg_st.orientation)) diff --git a/scripts/plot/shrinkfaces.m b/scripts/plot/shrinkfaces.m new file mode 100644 --- /dev/null +++ b/scripts/plot/shrinkfaces.m @@ -0,0 +1,215 @@ +## Copyright (C) 2012 Martin Helm +## +## 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 3 of the License, 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, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} shrinkfaces (@var{p}, @var{sf}) +## @deftypefnx {Function File} {@var{nfv} =} shrinkfaces (@var{p}, @var{sf}) +## @deftypefnx {Function File} {@var{nfv} =} shrinkfaces (@var{fv}, @var{sf}) +## @deftypefnx {Function File} {@var{nfv} =} shrinkfaces (@var{f}, @var{v}, @var{sf}) +## @deftypefnx {Function File} {[@var{nf}, @var{nv}] =} shrinkfaces (@dots{}) +## +## Reduce the faces area for a given patch, structure or explicit faces +## and points matrices by a scale factor @var{sf}. The structure +## @var{fv} must contain the fields 'faces' and 'vertices'. If the +## factor @var{sf} is omitted then a default of 0.3 is used. +## +## Given a patch handle as the first input argument and no output +## parameters, perform the shrinking of the patch faces in place and +## redraw the patch. +## +## If called with one output argument, return a structure with fields +## 'faces', 'vertices', and 'facevertexcdata' containing the data after +## shrinking which can then directly be used as an input argument for the +## @command{patch} function. +## +## Performing the shrinking on faces which are not convex can lead to +## undesired results. +## +## For example +## +## @example +## @group +## [phi r] = meshgrid (linspace (0, 1.5*pi, 16), linspace (1, 2, 4)); +## tri = delaunay (phi(:), r(:)); +## v = [r(:).*sin(phi(:)) r(:).*cos(phi(:))]; +## clf () +## p = patch ("Faces", tri, "Vertices", v, "FaceColor", "none"); +## fv = shrinkfaces (p); +## patch (fv) +## axis equal +## grid on +## @end group +## @end example +## +## @noindent +## draws a triangulated 3/4 circle and the corresponding shrinked +## version. +## @seealso{patch} +## @end deftypefn + +## Author: Martin Helm + +function [nf, nv] = shrinkfaces (varargin) + + if (nargin < 1 || nargin > 3 || nargout > 2) + print_usage (); + endif + + sf = 0.3; + p = varargin{1}; + colors = []; + + if (ishandle (p) && nargin < 3) + faces = get (p, "Faces"); + vertices = get (p, "Vertices"); + colors = get (p, "FaceVertexCData"); + if (nargin == 2) + sf = varargin{2}; + endif + elseif (isstruct (p) && nargin < 3) + faces = p.faces; + vertices = p.vertices; + if (isfield (p, "facevertexcdata")) + colors = p.facevertexcdata; + endif + if (nargin == 2) + sf = varargin{2}; + endif + elseif (ismatrix (p) && nargin >= 2 && ismatrix (varargin{2})) + faces = p; + vertices = varargin{2}; + if (nargin == 3) + sf = varargin{3}; + endif + else + print_usage (); + endif + + if (! isscalar (sf) || sf <= 0) + error ("shrinkfaces: scale factor must be a positive scalar") + endif + + n = size (vertices, 2); + if (n < 2 || n > 3) + error ("shrinkfaces: only 2D and 3D patches are supported") + endif + + m = size (faces, 2); + if (m < 3) + error ("shrinkfaces: faces must consist of at least 3 vertices") + endif + + v = vertices(faces'(:), :); + if (isempty (colors) || size (colors, 1) == size (faces, 1)) + c = colors; + elseif (size (colors, 1) == size (vertices, 1)) + c = colors(faces'(:), :); + else + ## Discard inconsistent color data. + c = []; + endif + sv = size (v, 1); + ## we have to deal with a probably very large number of vertices, so + ## use sparse we use as midpoint (1/m, ..., 1/m) in generalized + ## barycentric coordinates. + midpoints = full (kron ( speye (sv / m), ones (m, m) / m) * sparse (v)); + v = sqrt (sf) * (v - midpoints) + midpoints; + f = reshape (1:sv, m, sv / m)'; + + switch (nargout) + case 0 + if (ishandle (p)) + set (p, "FaceVertexCData", [], "CData", []) # avoid exceptions + set (p, "Vertices", v, "Faces", f, "FaceVertexCData", c) + else + nf = struct ("faces", f, "vertices", v, "facevertexcdata", c); + endif + case 1 + nf = struct ("faces", f, "vertices", v, "facevertexcdata", c); + case 2 + nf = f; + nv = v; + endswitch + +endfunction + +%!demo +%! faces = [1 2 3; 1 3 4]; +%! vertices = [0 0; 1 0; 1 1; 0 1]; +%! clf () +%! patch ("Faces", faces, "Vertices", vertices, "FaceColor", "none") +%! fv = shrinkfaces (faces, vertices, 0.25); +%! patch (fv) +%! axis equal + +%!demo +%! faces = [1 2 3 4; 5 6 7 8]; +%! vertices = [0 0; 1 0; 2 1; 1 1; 2 0; 3 0; 4 1; 3.5 1]; +%! clf () +%! patch ("Faces", faces, "Vertices", vertices, "FaceColor", "none") +%! fv = shrinkfaces (faces, vertices, 0.25); +%! patch (fv) +%! axis equal +%! grid on + +%!demo +%! faces = [1 2 3 4]; +%! vertices = [-1 2; 0 0; 1 2; 0 1]; +%! clf () +%! patch ("Faces", faces, "Vertices", vertices, "FaceColor", "none") +%! fv = shrinkfaces (faces, vertices, 0.25); +%! patch (fv) +%! axis equal +%! grid on +%! title "faces which are not convex are clearly not allowed" + +%!demo +%! [phi r] = meshgrid (linspace (0, 1.5*pi, 16), linspace (1, 2, 4)); +%! tri = delaunay (phi(:), r(:)); +%! v = [r(:).*sin(phi(:)) r(:).*cos(phi(:))]; +%! clf () +%! p = patch ("Faces", tri, "Vertices", v, "FaceColor", "none"); +%! fv = shrinkfaces (p); +%! patch (fv) +%! axis equal +%! grid on + +%!demo +%! N = 10; # N intervals per axis +%! [x, y, z] = meshgrid (linspace (-4,4,N+1)); +%! val = x.^3 + y.^3 + z.^3; +%! fv = isosurface (x, y, z, val, 3, z); +%! +%! clf () +%! p = patch ("Faces", fv.faces, "Vertices", fv.vertices, "FaceVertexCData", ... +%! fv.facevertexcdata, "FaceColor", "interp", "EdgeColor", "black"); +%! axis equal +%! view (115, 30) +%! drawnow +%! shrinkfaces (p, 0.6); + +%!shared faces, vertices, nfv, nfv2 +%! faces = [1 2 3]; +%! vertices = [0 0 0; 1 0 0; 1 1 0]; +%! nfv = shrinkfaces (faces, vertices, 0.7); +%! nfv2 = shrinkfaces (nfv, 1/0.7); +%!assert (isfield (nfv, "faces")); +%!assert (isfield (nfv, "vertices")); +%!assert (size (nfv.faces), [1 3]); +%!assert (size (nfv.vertices), [3 3]); +%!assert (norm (nfv2.vertices - vertices), 0, 2*eps); diff --git a/scripts/plot/tetramesh.m b/scripts/plot/tetramesh.m new file mode 100644 --- /dev/null +++ b/scripts/plot/tetramesh.m @@ -0,0 +1,148 @@ +## Copyright (C) 2012 Martin Helm +## +## 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 3 of the License, 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, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} tetramesh (@var{T}, @var{X}) +## @deftypefnx {Function File} tetramesh (@var{T}, @var{X}, @var{C}) +## @deftypefnx {Function File} tetramesh (@dots{}, @var{property}, @var{val}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} tetramesh (@dots{}) +## +## Display the tetrahedrons defined in the m-by-4 matrix @var{T} +## as 3-D patches. @var{T} is typically the output of a Delaunay triangulation +## of a 3-D set of points. Every row of @var{T} contains four indices into +## the n-by-3 matrix @var{X} of the vertices of a tetrahedron. Every row in +## @var{X} represents one point in 3-D space. +## +## The vector @var{C} specifies the color of each tetrahedron as an index +## into the current colormap. The default value is 1:m where m is the number +## of tetrahedrons; the indices are scaled to map to the full range of the +## colormap. If there are more tetrahedrons than colors in the colormap then +## the values in @var{C} are cyclically repeated. +## +## Calling @code{tetramesh (@dots{}, "property", "value", @dots{})} passes all +## property/value pairs directly to the patch function as additional arguments. +## +## The optional return value @var{h} is a vector of patch handles where each +## handle represents one tetrahedron in the order given by @var{T}. +## A typical use case for @var{h} is to turn the respective patch "visible" +## property "on" or "off". +## +## Type @code{demo tetramesh} to see examples on using @code{tetramesh}. +## @seealso{delaunay3, delaunayn, trimesh, patch} +## @end deftypefn + +## Author: Martin Helm + +function h = tetramesh (varargin) + + [reg, prop] = parseparams (varargin); + + if (length (reg) < 2 || length (reg) > 3) + print_usage (); + endif + + T = reg{1}; + X = reg{2}; + + if (! ismatrix (T) || columns (T) != 4) + error ("tetramesh: T must be a n-by-4 matrix"); + endif + if (! ismatrix (X) || columns (X) != 3) + error ("tetramesh: X must be a n-by-3 matrix"); + endif + + size_T = rows (T); + colmap = colormap (); + + if (length (reg) < 3) + size_colmap = size (colmap, 1); + C = mod ((1:size_T)' - 1, size_colmap) + 1; + if (size_T < size_colmap && size_T > 1) + ## expand to the available range of colors + C = floor ((C - 1) * (size_colmap - 1) / (size_T - 1)) + 1; + endif + else + C = reg{3}; + if (! isvector (C) || size_T != length (C)) + error ("tetramesh: C must be a vector of the same length as T"); + endif + endif + + h = zeros (1, size_T); + if (strcmp (graphics_toolkit (), "gnuplot")) + ## tiny reduction of the tetrahedron size to help gnuplot by + ## avoiding identical faces with different colors + for i = 1:size_T + [th, p] = __shrink__ ([1 2 3 4], X(T(i, :), :), 1 - 1e-7); + hvec(i) = patch ("Faces", th, "Vertices", p, + "FaceColor", colmap(C(i), :), prop{:}); + endfor + else + for i = 1:size_T + th = [1 2 3; 2 3 4; 3 4 1; 4 1 2]; + hvec(i) = patch ("Faces", th, "Vertices", X(T(i, :), :), + "FaceColor", colmap(C(i), :), prop{:}); + endfor + endif + + if (nargout > 0) + h = hvec; + endif + +endfunction + +## shrink the tetrahedron relative to its center of gravity +function [tri, p] = __shrink__ (T, X, sf) + midpoint = repmat (sum (X(T, :), 1) / 4, 12, 1); + p = [X([1 2 3], :); X([2 3 4], :); X([3 4 1], :); X([4 1 2], :)]; + p = sf * (p - midpoint) + midpoint; + tri = reshape (1:12, 3, 4)'; +endfunction + + +%!demo +%! clf; +%! d = [-1 1]; +%! [x,y,z] = meshgrid (d, d, d); +%! x = [x(:); 0]; +%! y = [y(:); 0]; +%! z = [z(:); 0]; +%! tetra = delaunay3 (x, y, z); +%! X = [x(:) y(:) z(:)]; +%! colormap (jet (64)); +%! h = tetramesh (tetra, X); +%! set (h(1:2:end), "Visible", "off"); +%! axis equal; +%! view (30, 20); +%! title ("Using jet (64), every other tetrahedron invisible"); + +%!demo +%! clf; +%! d = [-1 1]; +%! [x,y,z] = meshgrid (d, d, d); +%! x = [x(:); 0]; +%! y = [y(:); 0]; +%! z = [z(:); 0]; +%! tetra = delaunay3 (x, y, z); +%! X = [x(:) y(:) z(:)]; +%! colormap (gray (256)); +%! tetramesh (tetra, X, 21:20:241, "EdgeColor", "w"); +%! axis equal; +%! view (30, 20); +%! title ("Using gray (256) and white edges"); + diff --git a/scripts/polynomial/module.mk b/scripts/polynomial/module.mk --- a/scripts/polynomial/module.mk +++ b/scripts/polynomial/module.mk @@ -1,5 +1,8 @@ FCN_FILE_DIRS += polynomial +polynomial_PRIVATE_FCN_FILES = \ + polynomial/private/__splinefit__.m + polynomial_FCN_FILES = \ polynomial/compan.m \ polynomial/conv.m \ @@ -24,6 +27,7 @@ polynomial/residue.m \ polynomial/roots.m \ polynomial/spline.m \ + polynomial/splinefit.m \ polynomial/unmkpp.m FCN_FILES += $(polynomial_FCN_FILES) diff --git a/scripts/polynomial/pchip.m b/scripts/polynomial/pchip.m --- a/scripts/polynomial/pchip.m +++ b/scripts/polynomial/pchip.m @@ -79,7 +79,7 @@ if (isvector (y)) y = y(:).'; ##row vector szy = size (y); - if !(size_equal (x, y)) + if (! size_equal (x, y)) error ("pchip: length of X and Y must match") endif else @@ -96,7 +96,7 @@ h = diff (x); y = fliplr (y); elseif (any (h <= 0)) - error("pchip: X must be strictly monotonic"); + error ("pchip: X must be strictly monotonic"); endif f1 = y(:, 1:n-1); diff --git a/scripts/polynomial/private/__splinefit__.m b/scripts/polynomial/private/__splinefit__.m new file mode 100644 --- /dev/null +++ b/scripts/polynomial/private/__splinefit__.m @@ -0,0 +1,624 @@ +## This function is private because it is maintained by Jonas Lundgren +## separtely from Octave. Please do not reformat to match Octave coding +## conventions as that would make it harder to integrate upstream +## changes. + +% Copyright (c) 2010, Jonas Lundgren +% All rights reserved. +% +% Redistribution and use in source and binary forms, with or without +% modification, are permitted provided that the following conditions are +% met: +% +% * Redistributions of source code must retain the above copyright +% notice, this list of conditions and the following disclaimer. +% * Redistributions in binary form must reproduce the above copyright +% notice, this list of conditions and the following disclaimer in +% the documentation and/or other materials provided with the distribution +% +% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +% IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +% ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +% LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +% POSSIBILITY OF SUCH DAMAGE. +function pp = __splinefit__(varargin) +%SPLINEFIT Fit a spline to noisy data. +% PP = SPLINEFIT(X,Y,BREAKS) fits a piecewise cubic spline with breaks +% (knots) BREAKS to the noisy data (X,Y). X is a vector and Y is a vector +% or an ND array. If Y is an ND array, then X(j) and Y(:,...,:,j) are +% matched. Use PPVAL to evaluate PP. +% +% PP = SPLINEFIT(X,Y,P) where P is a positive integer interpolates the +% breaks linearly from the sorted locations of X. P is the number of +% spline pieces and P+1 is the number of breaks. +% +% OPTIONAL INPUT +% Argument places 4 to 8 are reserved for optional input. +% These optional arguments can be given in any order: +% +% PP = SPLINEFIT(...,'p') applies periodic boundary conditions to +% the spline. The period length is MAX(BREAKS)-MIN(BREAKS). +% +% PP = SPLINEFIT(...,'r') uses robust fitting to reduce the influence +% from outlying data points. Three iterations of weighted least squares +% are performed. Weights are computed from previous residuals. +% +% PP = SPLINEFIT(...,BETA), where 0 < BETA < 1, sets the robust fitting +% parameter BETA and activates robust fitting ('r' can be omitted). +% Default is BETA = 1/2. BETA close to 0 gives all data equal weighting. +% Increase BETA to reduce the influence from outlying data. BETA close +% to 1 may cause instability or rank deficiency. +% +% PP = SPLINEFIT(...,N) sets the spline order to N. Default is a cubic +% spline with order N = 4. A spline with P pieces has P+N-1 degrees of +% freedom. With periodic boundary conditions the degrees of freedom are +% reduced to P. +% +% PP = SPLINEFIT(...,CON) applies linear constraints to the spline. +% CON is a structure with fields 'xc', 'yc' and 'cc': +% 'xc', x-locations (vector) +% 'yc', y-values (vector or ND array) +% 'cc', coefficients (matrix). +% +% Constraints are linear combinations of derivatives of order 0 to N-2 +% according to +% +% cc(1,j)*y(x) + cc(2,j)*y'(x) + ... = yc(:,...,:,j), x = xc(j). +% +% The maximum number of rows for 'cc' is N-1. If omitted or empty 'cc' +% defaults to a single row of ones. Default for 'yc' is a zero array. +% +% EXAMPLES +% +% % Noisy data +% x = linspace(0,2*pi,100); +% y = sin(x) + 0.1*randn(size(x)); +% % Breaks +% breaks = [0:5,2*pi]; +% +% % Fit a spline of order 5 +% pp = splinefit(x,y,breaks,5); +% +% % Fit a spline of order 3 with periodic boundary conditions +% pp = splinefit(x,y,breaks,3,'p'); +% +% % Constraints: y(0) = 0, y'(0) = 1 and y(3) + y"(3) = 0 +% xc = [0 0 3]; +% yc = [0 1 0]; +% cc = [1 0 1; 0 1 0; 0 0 1]; +% con = struct('xc',xc,'yc',yc,'cc',cc); +% +% % Fit a cubic spline with 8 pieces and constraints +% pp = splinefit(x,y,8,con); +% +% % Fit a spline of order 6 with constraints and periodicity +% pp = splinefit(x,y,breaks,con,6,'p'); +% +% See also SPLINE, PPVAL, PPDIFF, PPINT + +% Author: Jonas Lundgren 2010 + +% 2009-05-06 Original SPLINEFIT. +% 2010-06-23 New version of SPLINEFIT based on B-splines. +% 2010-09-01 Robust fitting scheme added. +% 2010-09-01 Support for data containing NaNs. +% 2011-07-01 Robust fitting parameter added. + +% Check number of arguments +error(nargchk(3,7,nargin)); + +% Check arguments +[x,y,dim,breaks,n,periodic,beta,constr] = arguments(varargin{:}); + +% Evaluate B-splines +base = splinebase(breaks,n); +pieces = base.pieces; +A = ppval(base,x); + +% Bin data +[junk,ibin] = histc(x,[-inf,breaks(2:end-1),inf]); %#ok + +% Sparse system matrix +mx = numel(x); +ii = [ibin; ones(n-1,mx)]; +ii = cumsum(ii,1); +jj = repmat(1:mx,n,1); +if periodic + ii = mod(ii-1,pieces) + 1; + A = sparse(ii,jj,A,pieces,mx); +else + A = sparse(ii,jj,A,pieces+n-1,mx); +end + +% Don't use the sparse solver for small problems +if pieces < 20*n/log(1.7*n) + A = full(A); +end + +% Solve +if isempty(constr) + % Solve Min norm(u*A-y) + u = lsqsolve(A,y,beta); +else + % Evaluate constraints + B = evalcon(base,constr,periodic); + % Solve constraints + [Z,u0] = solvecon(B,constr); + % Solve Min norm(u*A-y), subject to u*B = yc + y = y - u0*A; + A = Z*A; + v = lsqsolve(A,y,beta); + u = u0 + v*Z; +end + +% Periodic expansion of solution +if periodic + jj = mod(0:pieces+n-2,pieces) + 1; + u = u(:,jj); +end + +% Compute polynomial coefficients +ii = [repmat(1:pieces,1,n); ones(n-1,n*pieces)]; +ii = cumsum(ii,1); +jj = repmat(1:n*pieces,n,1); +C = sparse(ii,jj,base.coefs,pieces+n-1,n*pieces); +coefs = u*C; +coefs = reshape(coefs,[],n); + +% Make piecewise polynomial +pp = mkpp(breaks,coefs,dim); + + +%-------------------------------------------------------------------------- +function [x,y,dim,breaks,n,periodic,beta,constr] = arguments(varargin) +%ARGUMENTS Lengthy input checking +% x Noisy data x-locations (1 x mx) +% y Noisy data y-values (prod(dim) x mx) +% dim Leading dimensions of y +% breaks Breaks (1 x (pieces+1)) +% n Spline order +% periodic True if periodic boundary conditions +% beta Robust fitting parameter, no robust fitting if beta = 0 +% constr Constraint structure +% constr.xc x-locations (1 x nx) +% constr.yc y-values (prod(dim) x nx) +% constr.cc Coefficients (?? x nx) + +% Reshape x-data +x = varargin{1}; +mx = numel(x); +x = reshape(x,1,mx); + +% Remove trailing singleton dimensions from y +y = varargin{2}; +dim = size(y); +while numel(dim) > 1 && dim(end) == 1 + dim(end) = []; +end +my = dim(end); + +% Leading dimensions of y +if numel(dim) > 1 + dim(end) = []; +else + dim = 1; +end + +% Reshape y-data +pdim = prod(dim); +y = reshape(y,pdim,my); + +% Check data size +if mx ~= my + mess = 'Last dimension of array y must equal length of vector x.'; + error('arguments:datasize',mess) +end + +% Treat NaNs in x-data +inan = find(isnan(x)); +if ~isempty(inan) + x(inan) = []; + y(:,inan) = []; + mess = 'All data points with NaN as x-location will be ignored.'; + warning('arguments:nanx',mess) +end + +% Treat NaNs in y-data +inan = find(any(isnan(y),1)); +if ~isempty(inan) + x(inan) = []; + y(:,inan) = []; + mess = 'All data points with NaN in their y-value will be ignored.'; + warning('arguments:nany',mess) +end + +% Check number of data points +mx = numel(x); +if mx == 0 + error('arguments:nodata','There must be at least one data point.') +end + +% Sort data +if any(diff(x) < 0) + [x,isort] = sort(x); + y = y(:,isort); +end + +% Breaks +if isscalar(varargin{3}) + % Number of pieces + p = varargin{3}; + if ~isreal(p) || ~isfinite(p) || p < 1 || fix(p) < p + mess = 'Argument #3 must be a vector or a positive integer.'; + error('arguments:breaks1',mess) + end + if x(1) < x(end) + % Interpolate breaks linearly from x-data + dx = diff(x); + ibreaks = linspace(1,mx,p+1); + [junk,ibin] = histc(ibreaks,[0,2:mx-1,mx+1]); %#ok + breaks = x(ibin) + dx(ibin).*(ibreaks-ibin); + else + breaks = x(1) + linspace(0,1,p+1); + end +else + % Vector of breaks + breaks = reshape(varargin{3},1,[]); + if isempty(breaks) || min(breaks) == max(breaks) + mess = 'At least two unique breaks are required.'; + error('arguments:breaks2',mess); + end +end + +% Unique breaks +if any(diff(breaks) <= 0) + breaks = unique(breaks); +end + +% Optional input defaults +n = 4; % Cubic splines +periodic = false; % No periodic boundaries +robust = false; % No robust fitting scheme +beta = 0.5; % Robust fitting parameter +constr = []; % No constraints + +% Loop over optional arguments +for k = 4:nargin + a = varargin{k}; + if ischar(a) && isscalar(a) && lower(a) == 'p' + % Periodic conditions + periodic = true; + elseif ischar(a) && isscalar(a) && lower(a) == 'r' + % Robust fitting scheme + robust = true; + elseif isreal(a) && isscalar(a) && isfinite(a) && a > 0 && a < 1 + % Robust fitting parameter + beta = a; + robust = true; + elseif isreal(a) && isscalar(a) && isfinite(a) && a > 0 && fix(a) == a + % Spline order + n = a; + elseif isstruct(a) && isscalar(a) + % Constraint structure + constr = a; + else + error('arguments:nonsense','Failed to interpret argument #%d.',k) + end +end + +% No robust fitting +if ~robust + beta = 0; +end + +% Check exterior data +h = diff(breaks); +xlim1 = breaks(1) - 0.01*h(1); +xlim2 = breaks(end) + 0.01*h(end); +if x(1) < xlim1 || x(end) > xlim2 + if periodic + % Move data inside domain + P = breaks(end) - breaks(1); + x = mod(x-breaks(1),P) + breaks(1); + % Sort + [x,isort] = sort(x); + y = y(:,isort); + else + mess = 'Some data points are outside the spline domain.'; + warning('arguments:exteriordata',mess) + end +end + +% Return +if isempty(constr) + return +end + +% Unpack constraints +xc = []; +yc = []; +cc = []; +names = fieldnames(constr); +for k = 1:numel(names) + switch names{k} + case {'xc'} + xc = constr.xc; + case {'yc'} + yc = constr.yc; + case {'cc'} + cc = constr.cc; + otherwise + mess = 'Unknown field ''%s'' in constraint structure.'; + warning('arguments:unknownfield',mess,names{k}) + end +end + +% Check xc +if isempty(xc) + mess = 'Constraints contains no x-locations.'; + error('arguments:emptyxc',mess) +else + nx = numel(xc); + xc = reshape(xc,1,nx); +end + +% Check yc +if isempty(yc) + % Zero array + yc = zeros(pdim,nx); +elseif numel(yc) == 1 + % Constant array + yc = zeros(pdim,nx) + yc; +elseif numel(yc) ~= pdim*nx + % Malformed array + error('arguments:ycsize','Cannot reshape yc to size %dx%d.',pdim,nx) +else + % Reshape array + yc = reshape(yc,pdim,nx); +end + +% Check cc +if isempty(cc) + cc = ones(size(xc)); +elseif numel(size(cc)) ~= 2 + error('arguments:ccsize1','Constraint coefficients cc must be 2D.') +elseif size(cc,2) ~= nx + mess = 'Last dimension of cc must equal length of xc.'; + error('arguments:ccsize2',mess) +end + +% Check high order derivatives +if size(cc,1) >= n + if any(any(cc(n:end,:))) + mess = 'Constraints involve derivatives of order %d or larger.'; + error('arguments:difforder',mess,n-1) + end + cc = cc(1:n-1,:); +end + +% Check exterior constraints +if min(xc) < xlim1 || max(xc) > xlim2 + if periodic + % Move constraints inside domain + P = breaks(end) - breaks(1); + xc = mod(xc-breaks(1),P) + breaks(1); + else + mess = 'Some constraints are outside the spline domain.'; + warning('arguments:exteriorconstr',mess) + end +end + +% Pack constraints +constr = struct('xc',xc,'yc',yc,'cc',cc); + + +%-------------------------------------------------------------------------- +function pp = splinebase(breaks,n) +%SPLINEBASE Generate B-spline base PP of order N for breaks BREAKS + +breaks = breaks(:); % Breaks +breaks0 = breaks'; % Initial breaks +h = diff(breaks); % Spacing +pieces = numel(h); % Number of pieces +deg = n - 1; % Polynomial degree + +% Extend breaks periodically +if deg > 0 + if deg <= pieces + hcopy = h; + else + hcopy = repmat(h,ceil(deg/pieces),1); + end + % to the left + hl = hcopy(end:-1:end-deg+1); + bl = breaks(1) - cumsum(hl); + % and to the right + hr = hcopy(1:deg); + br = breaks(end) + cumsum(hr); + % Add breaks + breaks = [bl(deg:-1:1); breaks; br]; + h = diff(breaks); + pieces = numel(h); +end + +% Initiate polynomial coefficients +coefs = zeros(n*pieces,n); +coefs(1:n:end,1) = 1; + +% Expand h +ii = [1:pieces; ones(deg,pieces)]; +ii = cumsum(ii,1); +ii = min(ii,pieces); +H = h(ii(:)); + +% Recursive generation of B-splines +for k = 2:n + % Antiderivatives of splines + for j = 1:k-1 + coefs(:,j) = coefs(:,j).*H/(k-j); + end + Q = sum(coefs,2); + Q = reshape(Q,n,pieces); + Q = cumsum(Q,1); + c0 = [zeros(1,pieces); Q(1:deg,:)]; + coefs(:,k) = c0(:); + % Normalize antiderivatives by max value + fmax = repmat(Q(n,:),n,1); + fmax = fmax(:); + for j = 1:k + coefs(:,j) = coefs(:,j)./fmax; + end + % Diff of adjacent antiderivatives + coefs(1:end-deg,1:k) = coefs(1:end-deg,1:k) - coefs(n:end,1:k); + coefs(1:n:end,k) = 0; +end + +% Scale coefficients +scale = ones(size(H)); +for k = 1:n-1 + scale = scale./H; + coefs(:,n-k) = scale.*coefs(:,n-k); +end + +% Reduce number of pieces +pieces = pieces - 2*deg; + +% Sort coefficients by interval number +ii = [n*(1:pieces); deg*ones(deg,pieces)]; +ii = cumsum(ii,1); +coefs = coefs(ii(:),:); + +% Make piecewise polynomial +pp = mkpp(breaks0,coefs,n); + + +%-------------------------------------------------------------------------- +function B = evalcon(base,constr,periodic) +%EVALCON Evaluate linear constraints + +% Unpack structures +breaks = base.breaks; +pieces = base.pieces; +n = base.order; +xc = constr.xc; +cc = constr.cc; + +% Bin data +[junk,ibin] = histc(xc,[-inf,breaks(2:end-1),inf]); %#ok + +% Evaluate constraints +nx = numel(xc); +B0 = zeros(n,nx); +for k = 1:size(cc,1) + if any(cc(k,:)) + B0 = B0 + repmat(cc(k,:),n,1).*ppval(base,xc); + end + % Differentiate base + coefs = base.coefs(:,1:n-k); + for j = 1:n-k-1 + coefs(:,j) = (n-k-j+1)*coefs(:,j); + end + base.coefs = coefs; + base.order = n-k; +end + +% Sparse output +ii = [ibin; ones(n-1,nx)]; +ii = cumsum(ii,1); +jj = repmat(1:nx,n,1); +if periodic + ii = mod(ii-1,pieces) + 1; + B = sparse(ii,jj,B0,pieces,nx); +else + B = sparse(ii,jj,B0,pieces+n-1,nx); +end + + +%-------------------------------------------------------------------------- +function [Z,u0] = solvecon(B,constr) +%SOLVECON Find a particular solution u0 and null space Z (Z*B = 0) +% for constraint equation u*B = yc. + +yc = constr.yc; +tol = 1000*eps; + +% Remove blank rows +ii = any(B,2); +B2 = full(B(ii,:)); + +% Null space of B2 +if isempty(B2) + Z2 = []; +else + % QR decomposition with column permutation + [Q,R,dummy] = qr(B2); %#ok + R = abs(R); + jj = all(R < R(1)*tol, 2); + Z2 = Q(:,jj)'; +end + +% Sizes +[m,ncon] = size(B); +m2 = size(B2,1); +nz = size(Z2,1); + +% Sparse null space of B +Z = sparse(nz+1:nz+m-m2,find(~ii),1,nz+m-m2,m); +Z(1:nz,ii) = Z2; + +% Warning rank deficient +if nz + ncon > m2 + mess = 'Rank deficient constraints, rank = %d.'; + warning('solvecon:deficient',mess,m2-nz); +end + +% Particular solution +u0 = zeros(size(yc,1),m); +if any(yc(:)) + % Non-homogeneous case + u0(:,ii) = yc/B2; + % Check solution + if norm(u0*B - yc,'fro') > norm(yc,'fro')*tol + mess = 'Inconsistent constraints. No solution within tolerance.'; + error('solvecon:inconsistent',mess) + end +end + + +%-------------------------------------------------------------------------- +function u = lsqsolve(A,y,beta) +%LSQSOLVE Solve Min norm(u*A-y) + +% Avoid sparse-complex limitations +if issparse(A) && ~isreal(y) + A = full(A); +end + +% Solution +u = y/A; + +% Robust fitting +if beta > 0 + [m,n] = size(y); + alpha = 0.5*beta/(1-beta)/m; + for k = 1:3 + % Residual + r = u*A - y; + rr = r.*conj(r); + rrmean = sum(rr,2)/n; + rrmean(~rrmean) = 1; + rrhat = (alpha./rrmean)'*rr; + % Weights + w = exp(-rrhat); + spw = spdiags(w',0,n,n); + % Solve weighted problem + u = (y*spw)/(A*spw); + end +end + diff --git a/scripts/polynomial/residue.m b/scripts/polynomial/residue.m --- a/scripts/polynomial/residue.m +++ b/scripts/polynomial/residue.m @@ -285,7 +285,7 @@ k = []; endif - if numel (e) + if (numel (e)) indx = 1:numel(p); else [e, indx] = mpoles (p, toler, 0); @@ -297,7 +297,7 @@ for n = indx pn = [1, -p(n)]; - if n == 1 + if (n == 1) pden = pn; else pden = conv (pden, pn); diff --git a/scripts/polynomial/spline.m b/scripts/polynomial/spline.m --- a/scripts/polynomial/spline.m +++ b/scripts/polynomial/spline.m @@ -131,31 +131,12 @@ b = b(1:n-1,:); a = a(1:n-1,:); else - if (n == 3) - dg = 1.5 * h(1) - 0.5 * h(2); - c(2:n-1,:) = 1/dg(1); - else - dg = 2 * (h(1:n-2) .+ h(2:n-1)); - dg(1) = dg(1) - 0.5 * h(1); - dg(n-2) = dg(n-2) - 0.5 * h(n-1); - - e = h(2:n-2); - - g = 3 * diff (a(2:n,:)) ./ h(2:n-1,idx) ... - - 3 * diff (a(1:n-1,:)) ./ h(1:n-2,idx); - g(1,:) = 3 * (a(3,:) - a(2,:)) / h(2) ... - - 3 / 2 * (3 * (a(2,:) - a(1,:)) / h(1) - dfs); - g(n-2,:) = 3 / 2 * (3 * (a(n,:) - a(n-1,:)) / h(n-1) - dfe) ... - - 3 * (a(n-1,:) - a(n-2,:)) / h(n-2); - - c(2:n-1,:) = spdiags ([[e(:); 0], dg, [0; e(:)]], - [-1, 0, 1], n-2, n-2) \ g; - endif - - c(1,:) = (3 / h(1) * (a(2,:) - a(1,:)) - 3 * dfs - - c(2,:) * h(1)) / (2 * h(1)); - c(n,:) = - (3 / h(n-1) * (a(n,:) - a(n-1,:)) - 3 * dfe - + c(n-1,:) * h(n-1)) / (2 * h(n-1)); + g(1,:) = (a(2,:) - a(1,:)) / h(1) - dfs; + g(2:n-1,:) = (a(3:n,:) - a(2:n-1,:)) ./ h(2:n-1) - ... + (a(2:n-1,:) - a(1:n-2,:)) ./ h(1:n-2); + g(n,:) = dfe - (a(n,:) - a(n-1,:)) / h(n-1); + c = spdiags([[h/6;0],[h(1)/3;(h(1:n-2)+h(2:n-1))/3;h(n-1)/3],[0;h/6]],... + [-1,0,1],n,n) \ (g / 2); b(1:n-1,:) = diff (a) ./ h(1:n-1, idx) ... - h(1:n-1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:)); d = diff (c) ./ (3 * h(1:n-1, idx)); @@ -297,11 +278,23 @@ %! y = [1,2,3,4]; %! pp = spline (x,y); %! [x,P] = unmkpp (pp); -%! assert (norm (P-[3,-3,1,2]), 0, abserr); +%! assert (P, [3,-3,1,2], abserr); %!test %! x = [2,1]; %! y = [1,2,3,4]; %! pp = spline (x,y); %! [x,P] = unmkpp (pp); -%! assert (norm (P-[7,-9,1,3]), 0, abserr); +%! assert (P, [7,-9,1,3], abserr); +%!test +%! x = [0,1,2]; +%! y = [0,0,1,0,0]; +%! pp = spline (x,y); +%! [x,P] = unmkpp (pp); +%! assert (P, [-2,3,0,0;2,-3,0,1], abserr); +%!test +%! x = [0,1,2,3]; +%! y = [0,0,1,1,0,0]; +%! pp = spline (x,y); +%! [x,P] = unmkpp (pp); +%! assert (P, [-1,2,0,0;0,-1,1,1;1,-1,-1,1], abserr); diff --git a/scripts/polynomial/splinefit.m b/scripts/polynomial/splinefit.m new file mode 100644 --- /dev/null +++ b/scripts/polynomial/splinefit.m @@ -0,0 +1,237 @@ +## Copyright (C) 2012 Ben Abbott, Jonas Lundgren +## +## 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 3 of the License, 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, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{pp} =} splinefit (@var{x}, @var{y}, @var{breaks}) +## Fits a piecewise cubic spline with breaks (knots) @var{breaks} to the +## noisy data, @var{x} and @var{y}. @var{x} is a vector, and @var{y} +## a vector or ND array. If @var{y} is an ND array, then @var{x}(j) +## is matched to @var{y}(:,...,:,j). +## +## The fitted spline is returned as a piece-wise polynomial, @var{pp}, and +## may be evaluated using @code{ppval}. +## +## @deftypefnx {Function File} {@var{pp} =} splinefit (@var{x}, @var{y}, @var{p}) +## @var{p} is a positive integer defining the number of intervals along @var{x}, +## and @var{p}+1 is the number of breaks. The number of points in each interval +## differ by no more than 1. +## +## @deftypefnx {Function File} {@var{pp} =} splinefit (@dots{}, "periodic", @var{periodic}) +## @deftypefnx {Function File} {@var{pp} =} splinefit (@dots{}, "robust", @var{robust}) +## @deftypefnx {Function File} {@var{pp} =} splinefit (@dots{}, "beta", @var{beta}) +## @deftypefnx {Function File} {@var{pp} =} splinefit (@dots{}, "order", @var{order}) +## @deftypefnx {Function File} {@var{pp} =} splinefit (@dots{}, "constraints", @var{constraints}) +## +## The optional property @var{periodic} is a logical value which specifies +## whether a periodic boundary condition is applied to the spline. The +## length of the period is @code{max(@var{breaks})-min(@var{breaks})}. +## The default value is @code{false}. +## +## The optional property @var{robust} is a logical value which specifies +## if robust fitting is to be applied to reduce the influence of outlying +## data points. Three iterations of weighted least squares are performed. +## Weights are computed from previous residuals. The sensitivity of outlier +## identification is controlled by the property @var{beta}. The value of +## @var{beta} is stricted to the range, 0 < @var{beta} < 1. The default +## value is @var{beta} = 1/2. Values close to 0 give all data equal +## weighting. Increasing values of @var{beta} reduce the influence of +## outlying data. Values close to unity may cause instability or rank +## deficiency. +## +## The splines are constructed of polynomials with degree @var{order}. +## The default is a cubic, @var{order}=3. A spline with P pieces has +## P+@var{order} degrees of freedom. With periodic boundary conditions +## the degrees of freedom are reduced to P. +## +## The optional property, @var{constaints}, is a structure specifying +## linear constraints on the fit. The structure has three fields, "xc", +## "yc", and "cc". +## +## @table @asis +## @item "xc" +## Vector of the x-locations of the constraints. +## @item "yc" +## Constaining values at the locations, @var{xc}. +## The default is an array of zeros. +## @item "cc" +## Coefficients (matrix). The default is an array of ones. The number of +## rows is limited to the order of the piece-wise polynomials, @var{order}. +## @end table +## +## Constraints are linear combinations of derivatives of order 0 to +## @var{order}-1 according to +## +## @example +## @group +## @tex +## $cc(1,j) \cdot y(xc(j)) + cc(2,j) \cdot y\prime(xc(j)) + ... = yc(:,\dots,:,j)$. +## @end tex +## @ifnottex +## cc(1,j) * y(xc(j)) + cc(2,j) * y'(xc(j)) + ... = yc(:,...,:,j). +## @end ifnottex +## @end group +## @end example +## +## @seealso{interp1, unmkpp, ppval, spline, pchip, ppder, ppint, ppjumps} +## @end deftypefn + +%!demo +%! % Noisy data +%! x = linspace (0, 2*pi, 100); +%! y = sin (x) + 0.1 * randn (size (x)); +%! % Breaks +%! breaks = [0:5, 2*pi]; +%! % Fit a spline of order 5 +%! pp = splinefit (x, y, breaks, "order", 4); +%! clf () +%! plot (x, y, "s", x, ppval (pp, x), "r", breaks, ppval (pp, breaks), "+r") +%! xlabel ("Independent Variable") +%! ylabel ("Dependent Variable") +%! title ("Fit a piece-wise polynomial of order 4"); +%! legend ({"data", "fit", "breaks"}) +%! axis tight +%! ylim auto + +%!demo +%! % Noisy data +%! x = linspace (0,2*pi, 100); +%! y = sin (x) + 0.1 * randn (size (x)); +%! % Breaks +%! breaks = [0:5, 2*pi]; +%! % Fit a spline of order 3 with periodic boundary conditions +%! pp = splinefit (x, y, breaks, "order", 2, "periodic", true); +%! clf () +%! plot (x, y, "s", x, ppval (pp, x), "r", breaks, ppval (pp, breaks), "+r") +%! xlabel ("Independent Variable") +%! ylabel ("Dependent Variable") +%! title ("Fit a periodic piece-wise polynomial of order 2"); +%! legend ({"data", "fit", "breaks"}) +%! axis tight +%! ylim auto + +%!demo +%! % Noisy data +%! x = linspace (0, 2*pi, 100); +%! y = sin (x) + 0.1 * randn (size (x)); +%! % Breaks +%! breaks = [0:5, 2*pi]; +%! % Constraints: y(0) = 0, y'(0) = 1 and y(3) + y"(3) = 0 +%! xc = [0 0 3]; +%! yc = [0 1 0]; +%! cc = [1 0 1; 0 1 0; 0 0 1]; +%! con = struct ("xc", xc, "yc", yc, "cc", cc); +%! % Fit a cubic spline with 8 pieces and constraints +%! pp = splinefit (x, y, 8, "constraints", con); +%! clf () +%! plot (x, y, "s", x, ppval (pp, x), "r", breaks, ppval (pp, breaks), "+r") +%! xlabel ("Independent Variable") +%! ylabel ("Dependent Variable") +%! title ("Fit a cubic spline with constraints") +%! legend ({"data", "fit", "breaks"}) +%! axis tight +%! ylim auto + +%!demo +%! % Noisy data +%! x = linspace (0, 2*pi, 100); +%! y = sin (x) + 0.1 * randn (size (x)); +%! % Breaks +%! breaks = [0:5, 2*pi]; +%! xc = [0 0 3]; +%! yc = [0 1 0]; +%! cc = [1 0 1; 0 1 0; 0 0 1]; +%! con = struct ("xc", xc, "yc", yc, "cc", cc); +%! % Fit a spline of order 6 with constraints and periodicity +%! pp = splinefit (x, y, breaks, "constraints", con, "order", 5, "periodic", true); +%! clf () +%! plot (x, y, "s", x, ppval (pp, x), "r", breaks, ppval (pp, breaks), "+r") +%! xlabel ("Independent Variable") +%! ylabel ("Dependent Variable") +%! title ("Fit a 5th order piece-wise periodic polynomial with constraints") +%! legend ({"data", "fit", "breaks"}) +%! axis tight +%! ylim auto + +function pp = splinefit (x, y, breaks, varargin) + if (nargin > 3) + n = cellfun (@ischar, varargin, "uniformoutput", true); + varargin(n) = lower (varargin(n)); + try + props = struct (varargin{:}); + catch + print_usage (); + end_try_catch + else + props = struct (); + endif + fields = fieldnames (props); + for f = 1:numel(fields) + if (! any (strcmp (fields{f}, + {"periodic", "robust", "beta", "order", "constraints"}))) + error ("splinefit:invalidproperty", + "unrecognized property '%s'", fields{f}); + endif + endfor + args = {}; + if (isfield (props, "periodic") && props.periodic) + args{end+1} = "p"; + endif + if (isfield (props, "robust") && props.robust) + args{end+1} = "r"; + endif + if (isfield (props, "beta")) + if (0 < props.beta && props.beta < 1) + args{end+1} = props.beta; + else + error ("splinefit:invalidbeta", "invalid beta parameter (0 < beta < 1)"); + endif + endif + if (isfield (props, "order")) + if (props.order >= 0) + args{end+1} = props.order + 1; + else + error ("splinefit:invalidorder", "invalid order"); + endif + endif + if (isfield (props, "constraints")) + args{end+1} = props.constraints; + endif + if (nargin < 3) + print_usage (); + elseif (! isnumeric (breaks) || ! isvector (breaks)) + print_usage (); + endif + pp = __splinefit__ (x, y, breaks, args{:}); +endfunction + +%!shared xb, yb, x +%! xb = 0:2:10; +%! yb = randn (size (xb)); +%! x = 0:0.1:10; + +%!test +%! y = interp1 (xb, yb, x, "linear"); +%! assert (ppval (splinefit (x, y, xb, "order", 1), x), y, 10 * eps ()); +%!test +%! y = interp1 (xb, yb, x, "spline"); +%! assert (ppval (splinefit (x, y, xb, "order", 3), x), y, 10 * eps ()); +%!test +%! y = interp1 (xb, yb, x, "spline"); +%! assert (ppval (splinefit (x, y, xb), x), y, 10 * eps ()); + + diff --git a/scripts/prefs/rmpref.m b/scripts/prefs/rmpref.m --- a/scripts/prefs/rmpref.m +++ b/scripts/prefs/rmpref.m @@ -17,14 +17,15 @@ ## . ## -*- texinfo -*- -## @deftypefn {Function File} {} rmpref (@var{group}, @var{pref}) +## @deftypefn {Function File} {} rmpref (@var{group}) +## @deftypefnx {Function File} {} rmpref (@var{group}, @var{pref}) ## Remove the named preference @var{pref} from the preference group ## @var{group}. ## ## The named preference group must be a character string. ## -## The preference @var{pref} may be a character string or a cell array -## of character strings. +## The preference @var{pref} may be a character string or cell array +## of strings. ## ## If @var{pref} is not specified, remove the preference group ## @var{group}. @@ -37,25 +38,48 @@ function retval = rmpref (group, pref) - prefs = loadprefs (); + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (! ischar (group)) + error ("rmpref: GROUP must be a string"); + elseif (nargin == 2 && ! (ischar (pref) || iscellstr (pref))) + error ("rmpref: PREF must be a string or cell array of strings"); + endif if (nargin == 1) - if (ischar (group)) - retval = isfield (prefs, group); + if (ispref (group)) + prefs = loadprefs (); + prefs = rmfield (prefs, group); + saveprefs (prefs); else - error ("expecting group to be a character array"); - endif - elseif (nargin == 2) - grp = getpref (group, pref); - if (ischar (pref) || iscellstr (pref)) - retval = isfield (grp, pref); + error ("rmpref: group <%s> does not exist", group); endif else - print_usage (); + valid = ispref (group, pref); + if (all (valid)) + prefs = loadprefs (); + prefs.(group) = rmfield (prefs.(group), pref); + saveprefs (prefs); + else + if (! ispref (group)) + error ("rmpref: group <%s> does not exist", group); + else + idx = find (! valid, 1); + error ("rmpref: pref <%s> does not exist", (cellstr (pref)){idx} ); + endif + endif endif endfunction -%% Testing these functions will require some care to avoid wiping out -%% existing (or creating unwanted) preferences for the user running the -%% tests. + +## Testing these functions will require some care to avoid wiping out +## existing (or creating unwanted) preferences for the user running the +## tests. + +## Test input validation +%!error rmpref () +%!error rmpref (1,2,3) +%!error rmpref ({"__group1__"}) +%!error rmpref ("__group1__", 1) + diff --git a/scripts/signal/periodogram.m b/scripts/signal/periodogram.m --- a/scripts/signal/periodogram.m +++ b/scripts/signal/periodogram.m @@ -122,7 +122,7 @@ if (strcmp (range, "onesided")) range = 1; - elseif strcmp (range, "twosided") + elseif (strcmp (range, "twosided")) range = 2; else range = 2-isreal (x); diff --git a/scripts/sparse/sprandsym.m b/scripts/sparse/sprandsym.m --- a/scripts/sparse/sprandsym.m +++ b/scripts/sparse/sprandsym.m @@ -119,7 +119,7 @@ ## numerically to avoid overflow. ## Degenerate case - if k == 1 + if (k == 1) r = 1; return endif diff --git a/scripts/statistics/base/moment.m b/scripts/statistics/base/moment.m --- a/scripts/statistics/base/moment.m +++ b/scripts/statistics/base/moment.m @@ -165,7 +165,7 @@ if (any (type == "c")) x = center (x, dim); endif - if any (type == "a") + if (any (type == "a")) x = abs (x); endif diff --git a/scripts/statistics/distributions/expcdf.m b/scripts/statistics/distributions/expcdf.m --- a/scripts/statistics/distributions/expcdf.m +++ b/scripts/statistics/distributions/expcdf.m @@ -59,10 +59,10 @@ cdf(k) = 1; k = (x > 0) & (x < Inf) & (lambda > 0); - if isscalar (lambda) - cdf(k) = 1 - exp (- x(k) / lambda); + if (isscalar (lambda)) + cdf(k) = 1 - exp (-x(k) / lambda); else - cdf(k) = 1 - exp (- x(k) ./ lambda(k)); + cdf(k) = 1 - exp (-x(k) ./ lambda(k)); endif endfunction diff --git a/scripts/statistics/distributions/expinv.m b/scripts/statistics/distributions/expinv.m --- a/scripts/statistics/distributions/expinv.m +++ b/scripts/statistics/distributions/expinv.m @@ -63,7 +63,7 @@ inv(k) = Inf; k = (x >= 0) & (x < 1) & (lambda > 0); - if isscalar (lambda) + if (isscalar (lambda)) inv(k) = - lambda * log (1 - x(k)); else inv(k) = - lambda(k) .* log (1 - x(k)); diff --git a/scripts/statistics/distributions/exppdf.m b/scripts/statistics/distributions/exppdf.m --- a/scripts/statistics/distributions/exppdf.m +++ b/scripts/statistics/distributions/exppdf.m @@ -53,10 +53,10 @@ pdf(k) = NaN; k = (x >= 0) & (x < Inf) & (lambda > 0); - if isscalar (lambda) - pdf(k) = exp (- x(k) / lambda) / lambda; + if (isscalar (lambda)) + pdf(k) = exp (-x(k) / lambda) / lambda; else - pdf(k) = exp (- x(k) ./ lambda(k)) ./ lambda(k); + pdf(k) = exp (-x(k) ./ lambda(k)) ./ lambda(k); endif endfunction diff --git a/scripts/statistics/distributions/poissrnd.m b/scripts/statistics/distributions/poissrnd.m --- a/scripts/statistics/distributions/poissrnd.m +++ b/scripts/statistics/distributions/poissrnd.m @@ -76,7 +76,7 @@ endif if (isscalar (lambda)) - if (lambda > 0 && lambda < Inf) + if (lambda >= 0 && lambda < Inf) rnd = randp (lambda, sz); if (strcmp (cls, "single")) rnd = single (rnd); @@ -87,7 +87,7 @@ else rnd = NaN (sz, cls); - k = (lambda > 0) & (lambda < Inf); + k = (lambda >= 0) & (lambda < Inf); rnd(k) = randp (lambda(k)); endif @@ -118,3 +118,6 @@ %!error poissrnd (ones (2,2), [3, 2]) %!error poissrnd (ones (2,2), 2, 3) +%!assert (poissrnd (0, 1, 1), 0) +%!assert (poissrnd ([0, 0, 0], [1, 3]), [0 0 0]) + diff --git a/scripts/statistics/tests/prop_test_2.m b/scripts/statistics/tests/prop_test_2.m --- a/scripts/statistics/tests/prop_test_2.m +++ b/scripts/statistics/tests/prop_test_2.m @@ -65,9 +65,9 @@ endif if (strcmp (alt, "!=") || strcmp (alt, "<>")) pval = 2 * min (cdf, 1 - cdf); - elseif strcmp (alt, ">") + elseif (strcmp (alt, ">")) pval = 1 - cdf; - elseif strcmp (alt, "<") + elseif (strcmp (alt, "<")) pval = cdf; else error ("prop_test_2: option %s not recognized", alt); diff --git a/scripts/statistics/tests/sign_test.m b/scripts/statistics/tests/sign_test.m --- a/scripts/statistics/tests/sign_test.m +++ b/scripts/statistics/tests/sign_test.m @@ -68,9 +68,9 @@ endif if (strcmp (alt, "!=") || strcmp (alt, "<>")) pval = 2 * min (cdf, 1 - cdf); - elseif strcmp (alt, ">") + elseif (strcmp (alt, ">")) pval = 1 - cdf; - elseif strcmp (alt, "<") + elseif (strcmp (alt, "<")) pval = cdf; else error ("sign_test: option %s not recognized", alt); diff --git a/scripts/statistics/tests/t_test.m b/scripts/statistics/tests/t_test.m --- a/scripts/statistics/tests/t_test.m +++ b/scripts/statistics/tests/t_test.m @@ -68,9 +68,9 @@ endif if (strcmp (alt, "!=") || strcmp (alt, "<>")) pval = 2 * min (cdf, 1 - cdf); - elseif strcmp (alt, ">") + elseif (strcmp (alt, ">")) pval = 1 - cdf; - elseif strcmp (alt, "<") + elseif (strcmp (alt, "<")) pval = cdf; else error ("t_test: option %s not recognized", alt); diff --git a/scripts/statistics/tests/t_test_2.m b/scripts/statistics/tests/t_test_2.m --- a/scripts/statistics/tests/t_test_2.m +++ b/scripts/statistics/tests/t_test_2.m @@ -69,9 +69,9 @@ endif if (strcmp (alt, "!=") || strcmp (alt, "<>")) pval = 2 * min (cdf, 1 - cdf); - elseif strcmp (alt, ">") + elseif (strcmp (alt, ">")) pval = 1 - cdf; - elseif strcmp (alt, "<") + elseif (strcmp (alt, "<")) pval = cdf; else error ("t_test_2: option %s not recognized", alt); diff --git a/scripts/statistics/tests/t_test_regression.m b/scripts/statistics/tests/t_test_regression.m --- a/scripts/statistics/tests/t_test_regression.m +++ b/scripts/statistics/tests/t_test_regression.m @@ -81,9 +81,9 @@ if (strcmp (alt, "!=") || strcmp (alt, "<>")) pval = 2 * min (cdf, 1 - cdf); - elseif strcmp (alt, ">") + elseif (strcmp (alt, ">")) pval = 1 - cdf; - elseif strcmp (alt, "<") + elseif (strcmp (alt, "<")) pval = cdf; else error ("t_test_regression: the value `%s' for alt is not possible", alt); diff --git a/scripts/strings/regexptranslate.m b/scripts/strings/regexptranslate.m --- a/scripts/strings/regexptranslate.m +++ b/scripts/strings/regexptranslate.m @@ -53,7 +53,7 @@ function y = regexptranslate (op, s) - if nargin != 2 + if (nargin != 2) print_usage (); endif @@ -67,7 +67,7 @@ '\*', '.*'), '\?', '.'); elseif (strcmp ("escape", op)) - y = regexprep (s, '([^\w])', '\$1'); + y = regexprep (s, '([^\w])', '\\$1'); else error ("regexptranslate: invalid operation OP"); endif diff --git a/scripts/time/datetick.m b/scripts/time/datetick.m --- a/scripts/time/datetick.m +++ b/scripts/time/datetick.m @@ -199,22 +199,22 @@ endif if (isempty (form)) - r = max(ticks) - min(ticks); - if r < 10/60/24 + r = max (ticks) - min (ticks); + if (r < 10/60/24) ## minutes and seconds form = 13; - elseif r < 2 + elseif (r < 2) ## hours form = 15; - elseif r < 15 + elseif (r < 15) ## days form = 8; - elseif r < 365 + elseif (r < 365) ## FIXME -- FORM should be 19 for European users who use dd/mm ## instead of mm/dd. How can that be determined automatically? ## months form = 6; - elseif r < 90*12 + elseif (r < 90*12) ## quarters form = 27; else diff --git a/src/Cell.cc b/src/Cell.cc --- a/src/Cell.cc +++ b/src/Cell.cc @@ -315,3 +315,9 @@ { return Array::diag (k); } + +Cell +Cell::diag (octave_idx_type m, octave_idx_type n) const +{ + return Array::diag (m, n); +} diff --git a/src/Cell.h b/src/Cell.h --- a/src/Cell.h +++ b/src/Cell.h @@ -114,6 +114,8 @@ Cell diag (octave_idx_type k = 0) const; + Cell diag (octave_idx_type m, octave_idx_type n) const; + Cell xisalnum (void) const { return map (&octave_value::xisalnum); } Cell xisalpha (void) const { return map (&octave_value::xisalpha); } Cell xisascii (void) const { return map (&octave_value::xisascii); } diff --git a/src/DLD-FUNCTIONS/__contourc__.cc b/src/DLD-FUNCTIONS/__contourc__.cc --- a/src/DLD-FUNCTIONS/__contourc__.cc +++ b/src/DLD-FUNCTIONS/__contourc__.cc @@ -335,8 +335,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__delaunayn__.cc b/src/DLD-FUNCTIONS/__delaunayn__.cc --- a/src/DLD-FUNCTIONS/__delaunayn__.cc +++ b/src/DLD-FUNCTIONS/__delaunayn__.cc @@ -224,8 +224,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__dispatch__.cc b/src/DLD-FUNCTIONS/__dispatch__.cc --- a/src/DLD-FUNCTIONS/__dispatch__.cc +++ b/src/DLD-FUNCTIONS/__dispatch__.cc @@ -131,8 +131,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__dsearchn__.cc b/src/DLD-FUNCTIONS/__dsearchn__.cc --- a/src/DLD-FUNCTIONS/__dsearchn__.cc +++ b/src/DLD-FUNCTIONS/__dsearchn__.cc @@ -110,8 +110,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc b/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc --- a/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc +++ b/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc @@ -135,10 +135,8 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ #endif diff --git a/src/DLD-FUNCTIONS/__glpk__.cc b/src/DLD-FUNCTIONS/__glpk__.cc --- a/src/DLD-FUNCTIONS/__glpk__.cc +++ b/src/DLD-FUNCTIONS/__glpk__.cc @@ -856,8 +856,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__lin_interpn__.cc b/src/DLD-FUNCTIONS/__lin_interpn__.cc --- a/src/DLD-FUNCTIONS/__lin_interpn__.cc +++ b/src/DLD-FUNCTIONS/__lin_interpn__.cc @@ -357,8 +357,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__magick_read__.cc b/src/DLD-FUNCTIONS/__magick_read__.cc --- a/src/DLD-FUNCTIONS/__magick_read__.cc +++ b/src/DLD-FUNCTIONS/__magick_read__.cc @@ -533,10 +533,8 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ #ifdef HAVE_MAGICK @@ -925,10 +923,8 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ #ifdef HAVE_MAGICK @@ -1150,10 +1146,8 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ #undef GET_PARAM @@ -1217,8 +1211,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__pchip_deriv__.cc b/src/DLD-FUNCTIONS/__pchip_deriv__.cc --- a/src/DLD-FUNCTIONS/__pchip_deriv__.cc +++ b/src/DLD-FUNCTIONS/__pchip_deriv__.cc @@ -163,8 +163,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__qp__.cc b/src/DLD-FUNCTIONS/__qp__.cc --- a/src/DLD-FUNCTIONS/__qp__.cc +++ b/src/DLD-FUNCTIONS/__qp__.cc @@ -530,8 +530,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/__voronoi__.cc b/src/DLD-FUNCTIONS/__voronoi__.cc --- a/src/DLD-FUNCTIONS/__voronoi__.cc +++ b/src/DLD-FUNCTIONS/__voronoi__.cc @@ -329,8 +329,6 @@ } /* - ## No test needed for internal helper function. %!assert (1) - */ diff --git a/src/DLD-FUNCTIONS/besselj.cc b/src/DLD-FUNCTIONS/besselj.cc --- a/src/DLD-FUNCTIONS/besselj.cc +++ b/src/DLD-FUNCTIONS/besselj.cc @@ -654,92 +654,92 @@ %!shared alpha, x, jx, yx, ix, kx, nix %! %! # Bessel functions, even order, positive and negative x -%! alpha = 2; x = 1.25; +%! alpha = 2; x = 1.25; %! jx = 0.1710911312405234823613091417; %! yx = -1.193199310178553861283790424; %! ix = 0.2220184483766341752692212604; %! kx = 0.9410016167388185767085460540; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! -%!assert(besselj(-alpha,x), jx, 100*eps) -%!assert(bessely(-alpha,x), yx, 100*eps) -%!assert(besseli(-alpha,x), ix, 100*eps) -%!assert(besselk(-alpha,x), kx, 100*eps) -%!assert(besselh(-alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(-alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (-alpha,x), jx, 100*eps) +%!assert (bessely (-alpha,x), yx, 100*eps) +%!assert (besseli (-alpha,x), ix, 100*eps) +%!assert (besselk (-alpha,x), kx, 100*eps) +%!assert (besselh (-alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (-alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(-alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(-alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(-alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(-alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(-alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(-alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (-alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (-alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (-alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (-alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (-alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (-alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! %! x *= -1; %! yx = -1.193199310178553861283790424 + 0.3421822624810469647226182835*I; %! kx = 0.9410016167388185767085460540 - 0.6974915263814386815610060884*I; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! %! # Bessel functions, odd order, positive and negative x -%! alpha = 3; x = 2.5; +%! alpha = 3; x = 2.5; %! jx = 0.2166003910391135247666890035; %! yx = -0.7560554967536709968379029772; %! ix = 0.4743704087780355895548240179; %! kx = 0.2682271463934492027663765197; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! -%!assert(besselj(-alpha,x), -jx, 100*eps) -%!assert(bessely(-alpha,x), -yx, 100*eps) -%!assert(besseli(-alpha,x), ix, 100*eps) -%!assert(besselk(-alpha,x), kx, 100*eps) -%!assert(besselh(-alpha,1,x), -(jx + I*yx), 100*eps) -%!assert(besselh(-alpha,2,x), -(jx - I*yx), 100*eps) +%!assert (besselj (-alpha,x), -jx, 100*eps) +%!assert (bessely (-alpha,x), -yx, 100*eps) +%!assert (besseli (-alpha,x), ix, 100*eps) +%!assert (besselk (-alpha,x), kx, 100*eps) +%!assert (besselh (-alpha,1,x), -(jx + I*yx), 100*eps) +%!assert (besselh (-alpha,2,x), -(jx - I*yx), 100*eps) %! -%!assert(besselj(-alpha,x,1), -jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(-alpha,x,1), -yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(-alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(-alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(-alpha,1,x,1), -(jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(-alpha,2,x,1), -(jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (-alpha,x,1), -jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (-alpha,x,1), -yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (-alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (-alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (-alpha,1,x,1), -(jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (-alpha,2,x,1), -(jx - I*yx)*exp(I*x), 100*eps) %! %! x *= -1; %! jx = -jx; @@ -747,57 +747,57 @@ %! ix = -ix; %! kx = -0.2682271463934492027663765197 - 1.490278591297463775542004240*I; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! %! # Bessel functions, fractional order, positive and negative x %! -%! alpha = 3.5; x = 2.75; +%! alpha = 3.5; x = 2.75; %! jx = 0.1691636439842384154644784389; %! yx = -0.8301381935499356070267953387; %! ix = 0.3930540878794826310979363668; %! kx = 0.2844099013460621170288192503; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! %! nix = 0.2119931212254662995364461998; %! -%!assert(besselj(-alpha,x), yx, 100*eps) -%!assert(bessely(-alpha,x), -jx, 100*eps) -%!assert(besseli(-alpha,x), nix, 100*eps) -%!assert(besselk(-alpha,x), kx, 100*eps) -%!assert(besselh(-alpha,1,x), -I*(jx + I*yx), 100*eps) -%!assert(besselh(-alpha,2,x), I*(jx - I*yx), 100*eps) +%!assert (besselj (-alpha,x), yx, 100*eps) +%!assert (bessely (-alpha,x), -jx, 100*eps) +%!assert (besseli (-alpha,x), nix, 100*eps) +%!assert (besselk (-alpha,x), kx, 100*eps) +%!assert (besselh (-alpha,1,x), -I*(jx + I*yx), 100*eps) +%!assert (besselh (-alpha,2,x), I*(jx - I*yx), 100*eps) %! -%!assert(besselj(-alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(-alpha,x,1), -jx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(-alpha,x,1), nix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(-alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(-alpha,1,x,1), -I*(jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(-alpha,2,x,1), I*(jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (-alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (-alpha,x,1), -jx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (-alpha,x,1), nix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (-alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (-alpha,1,x,1), -I*(jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (-alpha,2,x,1), I*(jx - I*yx)*exp(I*x), 100*eps) %! %! x *= -1; %! jx *= -I; @@ -805,55 +805,55 @@ %! ix *= -I; %! kx = -0.9504059335995575096509874508*I; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! %! # Bessel functions, even order, complex x %! -%! alpha = 2; x = 1.25 + 3.625 * I; +%! alpha = 2; x = 1.25 + 3.625 * I; %! jx = -1.299533366810794494030065917 + 4.370833116012278943267479589*I; %! yx = -4.370357232383223896393056727 - 1.283083391453582032688834041*I; %! ix = -0.6717801680341515541002273932 - 0.2314623443930774099910228553*I; %! kx = -0.01108009888623253515463783379 + 0.2245218229358191588208084197*I; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! -%!assert(besselj(-alpha,x), jx, 100*eps) -%!assert(bessely(-alpha,x), yx, 100*eps) -%!assert(besseli(-alpha,x), ix, 100*eps) -%!assert(besselk(-alpha,x), kx, 100*eps) -%!assert(besselh(-alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(-alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (-alpha,x), jx, 100*eps) +%!assert (bessely (-alpha,x), yx, 100*eps) +%!assert (besseli (-alpha,x), ix, 100*eps) +%!assert (besselk (-alpha,x), kx, 100*eps) +%!assert (besselh (-alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (-alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(-alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(-alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(-alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(-alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(-alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(-alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (-alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (-alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (-alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (-alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (-alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (-alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! %! # Bessel functions, odd order, complex x %! @@ -863,71 +863,71 @@ %! ix = -0.6182064685486998097516365709 + 0.4677561094683470065767989920*I; %! kx = -0.1568585587733540007867882337 - 0.05185853709490846050505141321*I; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! -%!assert(besselj(-alpha,x), -jx, 100*eps) -%!assert(bessely(-alpha,x), -yx, 100*eps) -%!assert(besseli(-alpha,x), ix, 100*eps) -%!assert(besselk(-alpha,x), kx, 100*eps) -%!assert(besselh(-alpha,1,x), -(jx + I*yx), 100*eps) -%!assert(besselh(-alpha,2,x), -(jx - I*yx), 100*eps) +%!assert (besselj (-alpha,x), -jx, 100*eps) +%!assert (bessely (-alpha,x), -yx, 100*eps) +%!assert (besseli (-alpha,x), ix, 100*eps) +%!assert (besselk (-alpha,x), kx, 100*eps) +%!assert (besselh (-alpha,1,x), -(jx + I*yx), 100*eps) +%!assert (besselh (-alpha,2,x), -(jx - I*yx), 100*eps) %! -%!assert(besselj(-alpha,x,1), -jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(-alpha,x,1), -yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(-alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(-alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(-alpha,1,x,1), -(jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(-alpha,2,x,1), -(jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (-alpha,x,1), -jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (-alpha,x,1), -yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (-alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (-alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (-alpha,1,x,1), -(jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (-alpha,2,x,1), -(jx - I*yx)*exp(I*x), 100*eps) %! %! # Bessel functions, fractional order, complex x %! -%! alpha = 3.5; x = 1.75 + 4.125 * I; +%! alpha = 3.5; x = 1.75 + 4.125 * I; %! jx = -3.018566131370455929707009100 - 0.7585648436793900607704057611*I; %! yx = 0.7772278839106298215614791107 - 3.018518722313849782683792010*I; %! ix = 0.2100873577220057189038160913 - 0.6551765604618246531254970926*I; %! kx = 0.1757147290513239935341488069 + 0.08772348296883849205562558311*I; %! -%!assert(besselj(alpha,x), jx, 100*eps) -%!assert(bessely(alpha,x), yx, 100*eps) -%!assert(besseli(alpha,x), ix, 100*eps) -%!assert(besselk(alpha,x), kx, 100*eps) -%!assert(besselh(alpha,1,x), jx + I*yx, 100*eps) -%!assert(besselh(alpha,2,x), jx - I*yx, 100*eps) +%!assert (besselj (alpha,x), jx, 100*eps) +%!assert (bessely (alpha,x), yx, 100*eps) +%!assert (besseli (alpha,x), ix, 100*eps) +%!assert (besselk (alpha,x), kx, 100*eps) +%!assert (besselh (alpha,1,x), jx + I*yx, 100*eps) +%!assert (besselh (alpha,2,x), jx - I*yx, 100*eps) %! -%!assert(besselj(alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(alpha,x,1), ix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (alpha,x,1), jx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (alpha,x,1), ix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (alpha,1,x,1), (jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (alpha,2,x,1), (jx - I*yx)*exp(I*x), 100*eps) %! %! nix = 0.09822388691172060573913739253 - 0.7110230642207380127317227407*I; %! -%!assert(besselj(-alpha,x), yx, 100*eps) -%!assert(bessely(-alpha,x), -jx, 100*eps) -%!assert(besseli(-alpha,x), nix, 100*eps) -%!assert(besselk(-alpha,x), kx, 100*eps) -%!assert(besselh(-alpha,1,x), -I*(jx + I*yx), 100*eps) -%!assert(besselh(-alpha,2,x), I*(jx - I*yx), 100*eps) +%!assert (besselj (-alpha,x), yx, 100*eps) +%!assert (bessely (-alpha,x), -jx, 100*eps) +%!assert (besseli (-alpha,x), nix, 100*eps) +%!assert (besselk (-alpha,x), kx, 100*eps) +%!assert (besselh (-alpha,1,x), -I*(jx + I*yx), 100*eps) +%!assert (besselh (-alpha,2,x), I*(jx - I*yx), 100*eps) %! -%!assert(besselj(-alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) -%!assert(bessely(-alpha,x,1), -jx*exp(-abs(imag(x))), 100*eps) -%!assert(besseli(-alpha,x,1), nix*exp(-abs(real(x))), 100*eps) -%!assert(besselk(-alpha,x,1), kx*exp(x), 100*eps) -%!assert(besselh(-alpha,1,x,1), -I*(jx + I*yx)*exp(-I*x), 100*eps) -%!assert(besselh(-alpha,2,x,1), I*(jx - I*yx)*exp(I*x), 100*eps) +%!assert (besselj (-alpha,x,1), yx*exp(-abs(imag(x))), 100*eps) +%!assert (bessely (-alpha,x,1), -jx*exp(-abs(imag(x))), 100*eps) +%!assert (besseli (-alpha,x,1), nix*exp(-abs(real(x))), 100*eps) +%!assert (besselk (-alpha,x,1), kx*exp(x), 100*eps) +%!assert (besselh (-alpha,1,x,1), -I*(jx + I*yx)*exp(-I*x), 100*eps) +%!assert (besselh (-alpha,2,x,1), I*(jx - I*yx)*exp(I*x), 100*eps) Tests contributed by Robert T. Short. @@ -973,7 +973,7 @@ %! [-0.014224472826781, 0.2051040386, 0.0415716780]; %! [-0.103110398228686, -0.1634199694, 0.0844338303]]; %! -%! Yt = [[-Inf, -Inf, -Inf ]; +%! Yt = [[-Inf, -Inf, -Inf ]; %! [ 0.4980703596, 0.1459181380, -0.38133585 ]; %! [-0.3085176252, 0.1478631434, 0.36766288 ]; %! [ 0.1173132861, -0.2591285105, -0.18641422 ]; @@ -982,51 +982,51 @@ %! [ 0.2054642960, 0.0210736280, -0.20265448 ]; %! [-0.1604111925, 0.0985727987, 0.17167666 ]]; %! -%! J = besselj(n,z); -%! Y = bessely(n,z); -%! assert(Jt(:,1), J(:,1), 0.5e-10); -%! assert(Yt(:,1), Y(:,1), 0.5e-10); -%! assert(Jt(:,2:3), J(:,2:3), 0.5e-10); +%! J = besselj (n,z); +%! Y = bessely (n,z); +%! assert (Jt(:,1), J(:,1), 0.5e-10); +%! assert (Yt(:,1), Y(:,1), 0.5e-10); +%! assert (Jt(:,2:3), J(:,2:3), 0.5e-10); Table 9.2 - J and Y for integer orders 3-9. %!test -%! n = (3:9); -%! z = (0:2:20).'; +%! n = (3:9); +%! z = (0:2:20).'; %! -%! Jt = [[ 0.0000e+00, 0.0000e+00, 0.0000e+00, 0.0000e+00, 0.0000e+00, 0.0000e+00, 0.0000e+00]; -%! [ 1.2894e-01, 3.3996e-02, 7.0396e-03, 1.2024e-03, 1.7494e-04, 2.2180e-05, 2.4923e-06]; -%! [ 4.3017e-01, 2.8113e-01, 1.3209e-01, 4.9088e-02, 1.5176e-02, 4.0287e-03, 9.3860e-04]; -%! [ 1.1477e-01, 3.5764e-01, 3.6209e-01, 2.4584e-01, 1.2959e-01, 5.6532e-02, 2.1165e-02]; -%! [-2.9113e-01,-1.0536e-01, 1.8577e-01, 3.3758e-01, 3.2059e-01, 2.2345e-01, 1.2632e-01]; -%! [ 5.8379e-02,-2.1960e-01,-2.3406e-01,-1.4459e-02, 2.1671e-01, 3.1785e-01, 2.9186e-01]; -%! [ 1.9514e-01, 1.8250e-01,-7.3471e-02,-2.4372e-01,-1.7025e-01, 4.5095e-02, 2.3038e-01]; -%! [-1.7681e-01, 7.6244e-02, 2.2038e-01, 8.1168e-02,-1.5080e-01,-2.3197e-01,-1.1431e-01]; -%! [-4.3847e-02,-2.0264e-01,-5.7473e-02, 1.6672e-01, 1.8251e-01,-7.0211e-03,-1.8953e-01]; -%! [ 1.8632e-01, 6.9640e-02,-1.5537e-01,-1.5596e-01, 5.1399e-02, 1.9593e-01, 1.2276e-01]; -%! [-9.8901e-02, 1.3067e-01, 1.5117e-01,-5.5086e-02,-1.8422e-01,-7.3869e-02, 1.2513e-01]]; +%! Jt = [[ 0.0000e+00, 0.0000e+00, 0.0000e+00, 0.0000e+00, 0.0000e+00, 0.0000e+00, 0.0000e+00]; +%! [ 1.2894e-01, 3.3996e-02, 7.0396e-03, 1.2024e-03, 1.7494e-04, 2.2180e-05, 2.4923e-06]; +%! [ 4.3017e-01, 2.8113e-01, 1.3209e-01, 4.9088e-02, 1.5176e-02, 4.0287e-03, 9.3860e-04]; +%! [ 1.1477e-01, 3.5764e-01, 3.6209e-01, 2.4584e-01, 1.2959e-01, 5.6532e-02, 2.1165e-02]; +%! [-2.9113e-01,-1.0536e-01, 1.8577e-01, 3.3758e-01, 3.2059e-01, 2.2345e-01, 1.2632e-01]; +%! [ 5.8379e-02,-2.1960e-01,-2.3406e-01,-1.4459e-02, 2.1671e-01, 3.1785e-01, 2.9186e-01]; +%! [ 1.9514e-01, 1.8250e-01,-7.3471e-02,-2.4372e-01,-1.7025e-01, 4.5095e-02, 2.3038e-01]; +%! [-1.7681e-01, 7.6244e-02, 2.2038e-01, 8.1168e-02,-1.5080e-01,-2.3197e-01,-1.1431e-01]; +%! [-4.3847e-02,-2.0264e-01,-5.7473e-02, 1.6672e-01, 1.8251e-01,-7.0211e-03,-1.8953e-01]; +%! [ 1.8632e-01, 6.9640e-02,-1.5537e-01,-1.5596e-01, 5.1399e-02, 1.9593e-01, 1.2276e-01]; +%! [-9.8901e-02, 1.3067e-01, 1.5117e-01,-5.5086e-02,-1.8422e-01,-7.3869e-02, 1.2513e-01]]; %! -%! Yt = [[ -Inf, -Inf, -Inf, -Inf, -Inf, -Inf, -Inf]; -%! [-1.1278e+00,-2.7659e+00,-9.9360e+00,-4.6914e+01,-2.7155e+02,-1.8539e+03,-1.4560e+04]; -%! [-1.8202e-01,-4.8894e-01,-7.9585e-01,-1.5007e+00,-3.7062e+00,-1.1471e+01,-4.2178e+01]; -%! [ 3.2825e-01, 9.8391e-02,-1.9706e-01,-4.2683e-01,-6.5659e-01,-1.1052e+00,-2.2907e+00]; -%! [ 2.6542e-02, 2.8294e-01, 2.5640e-01, 3.7558e-02,-2.0006e-01,-3.8767e-01,-5.7528e-01]; -%! [-2.5136e-01,-1.4495e-01, 1.3540e-01, 2.8035e-01, 2.0102e-01, 1.0755e-03,-1.9930e-01]; -%! [ 1.2901e-01,-1.5122e-01,-2.2982e-01,-4.0297e-02, 1.8952e-01, 2.6140e-01, 1.5902e-01]; -%! [ 1.2350e-01, 2.0393e-01,-6.9717e-03,-2.0891e-01,-1.7209e-01, 3.6816e-02, 2.1417e-01]; -%! [-1.9637e-01,-7.3222e-05, 1.9633e-01, 1.2278e-01,-1.0425e-01,-2.1399e-01,-1.0975e-01]; -%! [ 3.3724e-02,-1.7722e-01,-1.1249e-01, 1.1472e-01, 1.8897e-01, 3.2253e-02,-1.6030e-01]; -%! [ 1.4967e-01, 1.2409e-01,-1.0004e-01,-1.7411e-01,-4.4312e-03, 1.7101e-01, 1.4124e-01]]; +%! Yt = [[ -Inf, -Inf, -Inf, -Inf, -Inf, -Inf, -Inf]; +%! [-1.1278e+00,-2.7659e+00,-9.9360e+00,-4.6914e+01,-2.7155e+02,-1.8539e+03,-1.4560e+04]; +%! [-1.8202e-01,-4.8894e-01,-7.9585e-01,-1.5007e+00,-3.7062e+00,-1.1471e+01,-4.2178e+01]; +%! [ 3.2825e-01, 9.8391e-02,-1.9706e-01,-4.2683e-01,-6.5659e-01,-1.1052e+00,-2.2907e+00]; +%! [ 2.6542e-02, 2.8294e-01, 2.5640e-01, 3.7558e-02,-2.0006e-01,-3.8767e-01,-5.7528e-01]; +%! [-2.5136e-01,-1.4495e-01, 1.3540e-01, 2.8035e-01, 2.0102e-01, 1.0755e-03,-1.9930e-01]; +%! [ 1.2901e-01,-1.5122e-01,-2.2982e-01,-4.0297e-02, 1.8952e-01, 2.6140e-01, 1.5902e-01]; +%! [ 1.2350e-01, 2.0393e-01,-6.9717e-03,-2.0891e-01,-1.7209e-01, 3.6816e-02, 2.1417e-01]; +%! [-1.9637e-01,-7.3222e-05, 1.9633e-01, 1.2278e-01,-1.0425e-01,-2.1399e-01,-1.0975e-01]; +%! [ 3.3724e-02,-1.7722e-01,-1.1249e-01, 1.1472e-01, 1.8897e-01, 3.2253e-02,-1.6030e-01]; +%! [ 1.4967e-01, 1.2409e-01,-1.0004e-01,-1.7411e-01,-4.4312e-03, 1.7101e-01, 1.4124e-01]]; %! -%! n = (3:9); -%! z = (0:2:20).'; -%! J=besselj(n,z); -%! Y=bessely(n,z); +%! n = (3:9); +%! z = (0:2:20).'; +%! J = besselj (n,z); +%! Y = bessely (n,z); %! -%! assert(J(1,:), zeros (1, columns (J))); -%! assert(J(2:end,:), Jt(2:end,:), -5e-5); -%! assert(Yt(1,:), Y(1,:)); -%! assert(Y(2:end,:), Yt(2:end,:), -5e-5); +%! assert (J(1,:), zeros (1, columns (J))); +%! assert (J(2:end,:), Jt(2:end,:), -5e-5); +%! assert (Yt(1,:), Y(1,:)); +%! assert (Y(2:end,:), Yt(2:end,:), -5e-5); Table 9.4 - J and Y for various integer orders and arguments. @@ -1053,10 +1053,10 @@ %! %! n = [(0:5:20).';30;40;50;100]; %! z = [1,2,5,10,50,100]; -%! J = besselj(n.',z.').'; -%! Y = bessely(n.',z.').'; -%! assert(J, Jt, -1e-9); -%! assert(Y, Yt, -1e-9); +%! J = besselj (n.', z.').'; +%! Y = bessely (n.', z.').'; +%! assert (J, Jt, -1e-9); +%! assert (Y, Yt, -1e-9); Table 9.8 - I and K for integer orders 0, 1, 2. @@ -1064,20 +1064,20 @@ %! n = 0:2; %! z1 = [0.1;2.5;5.0]; %! z2 = [7.5;10.0;15.0;20.0]; -%! rtbl = [ [ 0.9071009258 0.0452984468 0.1251041992 2.6823261023 10.890182683 1.995039646 ]; -%! [ 0.2700464416 0.2065846495 0.2042345837 0.7595486903 0.9001744239 0.759126289 ]; -%! [ 0.1835408126 0.1639722669 0.7002245988 0.5478075643 0.6002738588 0.132723593 ]; -%! [ 0.1483158301 0.1380412115 0.111504840 0.4505236991 0.4796689336 0.57843541 ]; -%! [ 0.1278333372 0.1212626814 0.103580801 0.3916319344 0.4107665704 0.47378525 ]; -%! [ 0.1038995314 0.1003741751 0.090516308 0.3210023535 0.3315348950 0.36520701 ]; -%! [ 0.0897803119 0.0875062222 0.081029690 0.2785448768 0.2854254970 0.30708743 ]]; +%! rtbl = [[ 0.9071009258 0.0452984468 0.1251041992 2.6823261023 10.890182683 1.995039646 ]; +%! [ 0.2700464416 0.2065846495 0.2042345837 0.7595486903 0.9001744239 0.759126289 ]; +%! [ 0.1835408126 0.1639722669 0.7002245988 0.5478075643 0.6002738588 0.132723593 ]; +%! [ 0.1483158301 0.1380412115 0.111504840 0.4505236991 0.4796689336 0.57843541 ]; +%! [ 0.1278333372 0.1212626814 0.103580801 0.3916319344 0.4107665704 0.47378525 ]; +%! [ 0.1038995314 0.1003741751 0.090516308 0.3210023535 0.3315348950 0.36520701 ]; +%! [ 0.0897803119 0.0875062222 0.081029690 0.2785448768 0.2854254970 0.30708743 ]]; %! %! tbl = [besseli(n,z1,1), besselk(n,z1,1)]; -%! tbl(:,3) = tbl(:,3).*(exp(z1).*z1.^(-2)); -%! tbl(:,6) = tbl(:,6).*(exp(-z1).*z1.^(2)); +%! tbl(:,3) = tbl(:,3) .* (exp(z1).*z1.^(-2)); +%! tbl(:,6) = tbl(:,6) .* (exp(-z1).*z1.^(2)); %! tbl = [tbl;[besseli(n,z2,1),besselk(n,z2,1)]]; %! -%! assert(tbl, rtbl, -2e-8); +%! assert (tbl, rtbl, -2e-8); Table 9.9 - I and K for orders 3-9. @@ -1094,8 +1094,7 @@ %! [ 7.3263e-02 6.0059e-02 4.6571e-02 3.4186e-02 2.3780e-02 1.5691e-02 9.8324e-03]; %! [ 7.1300e-02 5.9640e-02 4.7444e-02 3.5917e-02 2.5894e-02 1.7792e-02 1.1661e-02]]; %! -%! Kt = [ -%! [ Inf Inf Inf Inf Inf Inf Inf]; +%! Kt = [[ Inf Inf Inf Inf Inf Inf Inf]; %! [ 4.7836e+00 1.6226e+01 6.9687e+01 3.6466e+02 2.2576e+03 1.6168e+04 1.3160e+05]; %! [ 1.6317e+00 3.3976e+00 8.4268e+00 2.4465e+01 8.1821e+01 3.1084e+02 1.3252e+03]; %! [ 9.9723e-01 1.6798e+00 3.2370e+00 7.0748e+00 1.7387e+01 4.7644e+01 1.4444e+02]; @@ -1109,13 +1108,13 @@ %! %! n = (3:9); %! z = (0:2:20).'; -%! I=besseli(n,z,1); -%! K=besselk(n,z,1); +%! I = besseli (n,z,1); +%! K = besselk (n,z,1); %! -%! assert(abs (I(1,:)), zeros(1, columns(I))); -%! assert(I(2:end,:), It(2:end,:), -5e-5); -%! assert(Kt(1,:), K(1,:)); -%! assert(K(2:end,:), Kt(2:end,:), -5e-5); +%! assert (abs (I(1,:)), zeros (1, columns(I))); +%! assert (I(2:end,:), It(2:end,:), -5e-5); +%! assert (Kt(1,:), K(1,:)); +%! assert (K(2:end,:), Kt(2:end,:), -5e-5); Table 9.11 - I and K for various integer orders and arguments. @@ -1142,24 +1141,24 @@ %! %! n = [(0:5:20).';30;40;50;100]; %! z = [1,2,5,10,50,100]; -%! I = besseli(n.',z.').'; -%! K = besselk(n.',z.').'; -%! assert(I, It, -5e-9); -%! assert(K, Kt, -5e-9); +%! I = besseli (n.', z.').'; +%! K = besselk (n.', z.').'; +%! assert (I, It, -5e-9); +%! assert (K, Kt, -5e-9); The next section checks that negative integer orders and positive integer orders are appropriately related. %!test -%! n=(0:2:20); -%! assert(besselj(n,1), besselj(-n,1), 1e-8); -%! assert(-besselj(n+1,1), besselj(-n-1,1), 1e-8); +%! n = (0:2:20); +%! assert (besselj (n,1), besselj (-n,1), 1e-8); +%! assert (-besselj (n+1,1), besselj (-n-1,1), 1e-8); besseli(n,z) = besseli(-n,z); %!test -%! n=(0:2:20); -%! assert(besseli(n,1), besseli(-n,1), 1e-8); +%! n = (0:2:20); +%! assert (besseli (n,1), besseli (-n,1), 1e-8); Table 10.1 - j and y for integer orders 0, 1, 2. Compare against excerpts of Table 10.1, Abramowitz and Stegun. @@ -1195,7 +1194,7 @@ %!test %! n = (3:8); -%! z = (0:2.5:10).'; z(1)=0.1; +%! z = (0:2.5:10).'; z(1)=0.1; %! %! jt = [[ 9.5185e-06 1.0577e-07 9.6163e-10 7.3975e-12 4.9319e-14 2.9012e-16]; %! [ 1.0392e-01 3.0911e-02 7.3576e-03 1.4630e-03 2.5009e-04 3.7516e-05]; @@ -1209,11 +1208,11 @@ %! [ 1.2705e-01 1.2485e-01 2.2774e-02 -9.1449e-02 -1.8129e-01 -2.7112e-01]; %! [-9.5327e-02 -1.6599e-03 9.3834e-02 1.0488e-01 4.2506e-02 -4.1117e-02]]; %! -%! j = sqrt((pi/2)./z).*besselj(n+1/2,z); -%! y = sqrt((pi/2)./z).*bessely(n+1/2,z); +%! j = sqrt ((pi/2)./z) .* besselj (n+1/2,z); +%! y = sqrt ((pi/2)./z) .* bessely (n+1/2,z); %! -%! assert(jt, j, -5e-5); -%! assert(yt, y, -5e-5); +%! assert (jt, j, -5e-5); +%! assert (yt, y, -5e-5); Table 10.4 - j and y for various integer orders and arguments. @@ -1240,11 +1239,8 @@ %! %! n = [(0:5:20).';30;40;50;100]; %! z = [1,2,5,10,50,100]; -%! j = sqrt((pi/2)./z).*besselj((n+1/2).',z.').'; -%! y = sqrt((pi/2)./z).*bessely((n+1/2).',z.').'; -%! assert(j, jt, -1e-9); -%! assert(y, yt, -1e-9); - - - +%! j = sqrt ((pi/2)./z) .* besselj ((n+1/2).', z.').'; +%! y = sqrt ((pi/2)./z) .* bessely ((n+1/2).', z.').'; +%! assert (j, jt, -1e-9); +%! assert (y, yt, -1e-9); */ diff --git a/src/DLD-FUNCTIONS/betainc.cc b/src/DLD-FUNCTIONS/betainc.cc --- a/src/DLD-FUNCTIONS/betainc.cc +++ b/src/DLD-FUNCTIONS/betainc.cc @@ -283,50 +283,48 @@ } /* - %% test/octave.test/arith/betainc-1.m %!test -%! a=[1, 1.5, 2, 3]; -%! b=[4, 3, 2, 1]; -%! v1=betainc(1,a,b); -%! v2=[1,1,1,1]; +%! a = [1, 1.5, 2, 3]; +%! b = [4, 3, 2, 1]; +%! v1 = betainc (1,a,b); +%! v2 = [1,1,1,1]; %! x = [.2, .4, .6, .8]; -%! v3=betainc(x, a, b); -%! v4 = 1-betainc(1.-x, b, a); -%! assert(v1, v2, sqrt(eps)); -%! assert(v3, v4, sqrt(eps)); +%! v3 = betainc (x, a, b); +%! v4 = 1 - betainc (1.-x, b, a); +%! assert (v1, v2, sqrt (eps)); +%! assert (v3, v4, sqrt (eps)); %% Single precision %!test -%! a=single ([1, 1.5, 2, 3]); -%! b=single ([4, 3, 2, 1]); -%! v1=betainc(1,a,b); -%! v2=single ([1,1,1,1]); +%! a = single ([1, 1.5, 2, 3]); +%! b = single ([4, 3, 2, 1]); +%! v1 = betainc (1,a,b); +%! v2 = single ([1,1,1,1]); %! x = single ([.2, .4, .6, .8]); -%! v3=betainc(x, a, b); -%! v4 = 1-betainc(1.-x, b, a); -%! assert(v1, v2, sqrt(eps ('single'))); -%! assert(v3, v4, sqrt(eps ('single'))); +%! v3 = betainc (x, a, b); +%! v4 = 1 - betainc (1.-x, b, a); +%! assert (v1, v2, sqrt (eps ("single"))); +%! assert (v3, v4, sqrt (eps ("single"))); %% Mixed double/single precision %!test -%! a=single ([1, 1.5, 2, 3]); -%! b=[4, 3, 2, 1]; -%! v1=betainc(1,a,b); -%! v2=single ([1,1,1,1]); +%! a = single ([1, 1.5, 2, 3]); +%! b = [4, 3, 2, 1]; +%! v1 = betainc (1,a,b); +%! v2 = single ([1,1,1,1]); %! x = [.2, .4, .6, .8]; -%! v3=betainc(x, a, b); -%! v4 = 1-betainc(1.-x, b, a); -%! assert(v1, v2, sqrt(eps ('single'))); -%! assert(v3, v4, sqrt(eps ('single'))); +%! v3 = betainc (x, a, b); +%! v4 = 1-betainc (1.-x, b, a); +%! assert (v1, v2, sqrt (eps ('single'))); +%! assert (v3, v4, sqrt (eps ('single'))); %% test/octave.test/arith/betainc-2.m -%!error betainc(); +%!error betainc () %% test/octave.test/arith/betainc-3.m -%!error betainc(1); +%!error betainc> betainc (1) %% test/octave.test/arith/betainc-4.m -%!error betainc(1,2); - +%!error betainc> betainc (1,2) */ diff --git a/src/DLD-FUNCTIONS/bsxfun.cc b/src/DLD-FUNCTIONS/bsxfun.cc --- a/src/DLD-FUNCTIONS/bsxfun.cc +++ b/src/DLD-FUNCTIONS/bsxfun.cc @@ -662,17 +662,17 @@ %! b = mean (a, 1); %! c = mean (a, 2); %! f = @minus; -%!error(bsxfun (f)); -%!error(bsxfun (f, a)); -%!error(bsxfun (a, b)); -%!error(bsxfun (a, b, c)); -%!error(bsxfun (f, a, b, c)); -%!error(bsxfun (f, ones(4, 0), ones(4, 4))) -%!assert(bsxfun (f, ones(4, 0), ones(4, 1)), zeros(4, 0)); -%!assert(bsxfun (f, ones(1, 4), ones(4, 1)), zeros(4, 4)); -%!assert(bsxfun (f, a, b), a - repmat(b, 4, 1)); -%!assert(bsxfun (f, a, c), a - repmat(c, 1, 4)); -%!assert(bsxfun ("minus", ones(1, 4), ones(4, 1)), zeros(4, 4)); +%!error (bsxfun (f)) +%!error (bsxfun (f, a)) +%!error (bsxfun (a, b)) +%!error (bsxfun (a, b, c)) +%!error (bsxfun (f, a, b, c)) +%!error (bsxfun (f, ones (4, 0), ones (4, 4))) +%!assert (bsxfun (f, ones (4, 0), ones (4, 1)), zeros (4, 0)) +%!assert (bsxfun (f, ones (1, 4), ones (4, 1)), zeros (4, 4)) +%!assert (bsxfun (f, a, b), a - repmat (b, 4, 1)) +%!assert (bsxfun (f, a, c), a - repmat (c, 1, 4)) +%!assert (bsxfun ("minus", ones (1, 4), ones (4, 1)), zeros (4, 4)) %!shared a, b, c, f %! a = randn (4, 4); @@ -680,17 +680,17 @@ %! b = mean (a, 1); %! c = mean (a, 2); %! f = @minus; -%!error(bsxfun (f)); -%!error(bsxfun (f, a)); -%!error(bsxfun (a, b)); -%!error(bsxfun (a, b, c)); -%!error(bsxfun (f, a, b, c)); -%!error(bsxfun (f, ones(4, 0), ones(4, 4))) -%!assert(bsxfun (f, ones(4, 0), ones(4, 1)), zeros(4, 0)); -%!assert(bsxfun (f, ones(1, 4), ones(4, 1)), zeros(4, 4)); -%!assert(bsxfun (f, a, b), a - repmat(b, 4, 1)); -%!assert(bsxfun (f, a, c), a - repmat(c, 1, 4)); -%!assert(bsxfun ("minus", ones(1, 4), ones(4, 1)), zeros(4, 4)); +%!error (bsxfun (f)) +%!error (bsxfun (f, a)) +%!error (bsxfun (a, b)) +%!error (bsxfun (a, b, c)) +%!error (bsxfun (f, a, b, c)) +%!error (bsxfun (f, ones (4, 0), ones (4, 4))) +%!assert (bsxfun (f, ones (4, 0), ones (4, 1)), zeros (4, 0)) +%!assert (bsxfun (f, ones (1, 4), ones (4, 1)), zeros (4, 4)) +%!assert (bsxfun (f, a, b), a - repmat (b, 4, 1)) +%!assert (bsxfun (f, a, c), a - repmat (c, 1, 4)) +%!assert (bsxfun ("minus", ones (1, 4), ones (4, 1)), zeros (4, 4)) %!shared a, b, c, f %! a = randn (4, 4); @@ -698,33 +698,33 @@ %! b = mean (a, 1); %! c = mean (a, 2); %! f = @minus; -%!error(bsxfun (f)); -%!error(bsxfun (f, a)); -%!error(bsxfun (a, b)); -%!error(bsxfun (a, b, c)); -%!error(bsxfun (f, a, b, c)); -%!error(bsxfun (f, ones(4, 0), ones(4, 4))) -%!assert(bsxfun (f, ones(4, 0), ones(4, 1)), zeros(4, 0)); -%!assert(bsxfun (f, ones(1, 4), ones(4, 1)), zeros(4, 4)); -%!assert(bsxfun (f, a, b), a - repmat(b, 4, 1)); -%!assert(bsxfun (f, a, c), a - repmat(c, 1, 4)); -%!assert(bsxfun ("minus", ones(1, 4), ones(4, 1)), zeros(4, 4)); +%!error (bsxfun (f)) +%!error (bsxfun (f, a)) +%!error (bsxfun (a, b)) +%!error (bsxfun (a, b, c)) +%!error (bsxfun (f, a, b, c)) +%!error (bsxfun (f, ones (4, 0), ones (4, 4))) +%!assert (bsxfun (f, ones (4, 0), ones (4, 1)), zeros (4, 0)) +%!assert (bsxfun (f, ones (1, 4), ones (4, 1)), zeros (4, 4)) +%!assert (bsxfun (f, a, b), a - repmat (b, 4, 1)) +%!assert (bsxfun (f, a, c), a - repmat (c, 1, 4)) +%!assert (bsxfun ("minus", ones (1, 4), ones (4, 1)), zeros (4, 4)) %!shared a, b, c, f %! a = randn (4, 4); %! b = a (1, :); %! c = a (:, 1); %! f = @(x, y) x == y; -%!error(bsxfun (f)); -%!error(bsxfun (f, a)); -%!error(bsxfun (a, b)); -%!error(bsxfun (a, b, c)); -%!error(bsxfun (f, a, b, c)); -%!error(bsxfun (f, ones(4, 0), ones(4, 4))) -%!assert(bsxfun (f, ones(4, 0), ones(4, 1)), zeros(4, 0, "logical")); -%!assert(bsxfun (f, ones(1, 4), ones(4, 1)), ones(4, 4, "logical")); -%!assert(bsxfun (f, a, b), a == repmat(b, 4, 1)); -%!assert(bsxfun (f, a, c), a == repmat(c, 1, 4)); +%!error (bsxfun (f)) +%!error (bsxfun (f, a)) +%!error (bsxfun (a, b)) +%!error (bsxfun (a, b, c)) +%!error (bsxfun (f, a, b, c)) +%!error (bsxfun (f, ones (4, 0), ones (4, 4))) +%!assert (bsxfun (f, ones (4, 0), ones (4, 1)), zeros (4, 0, "logical")) +%!assert (bsxfun (f, ones (1, 4), ones (4, 1)), ones (4, 4, "logical")) +%!assert (bsxfun (f, a, b), a == repmat (b, 4, 1)) +%!assert (bsxfun (f, a, c), a == repmat (c, 1, 4)) %!shared a, b, c, d, f %! a = randn (4, 4, 4); @@ -732,43 +732,43 @@ %! c = mean (a, 2); %! d = mean (a, 3); %! f = @minus; -%!error(bsxfun (f, ones([4, 0, 4]), ones([4, 4, 4]))); -%!assert(bsxfun (f, ones([4, 0, 4]), ones([4, 1, 4])), zeros([4, 0, 4])); -%!assert(bsxfun (f, ones([4, 4, 0]), ones([4, 1, 1])), zeros([4, 4, 0])); -%!assert(bsxfun (f, ones([1, 4, 4]), ones([4, 1, 4])), zeros([4, 4, 4])); -%!assert(bsxfun (f, ones([4, 4, 1]), ones([4, 1, 4])), zeros([4, 4, 4])); -%!assert(bsxfun (f, ones([4, 1, 4]), ones([1, 4, 4])), zeros([4, 4, 4])); -%!assert(bsxfun (f, ones([4, 1, 4]), ones([1, 4, 1])), zeros([4, 4, 4])); -%!assert(bsxfun (f, a, b), a - repmat(b, [4, 1, 1])); -%!assert(bsxfun (f, a, c), a - repmat(c, [1, 4, 1])); -%!assert(bsxfun (f, a, d), a - repmat(d, [1, 1, 4])); -%!assert(bsxfun ("minus", ones([4, 0, 4]), ones([4, 1, 4])), zeros([4, 0, 4])); +%!error (bsxfun (f, ones ([4, 0, 4]), ones ([4, 4, 4]))) +%!assert (bsxfun (f, ones ([4, 0, 4]), ones ([4, 1, 4])), zeros ([4, 0, 4])) +%!assert (bsxfun (f, ones ([4, 4, 0]), ones ([4, 1, 1])), zeros ([4, 4, 0])) +%!assert (bsxfun (f, ones ([1, 4, 4]), ones ([4, 1, 4])), zeros ([4, 4, 4])) +%!assert (bsxfun (f, ones ([4, 4, 1]), ones ([4, 1, 4])), zeros ([4, 4, 4])) +%!assert (bsxfun (f, ones ([4, 1, 4]), ones ([1, 4, 4])), zeros ([4, 4, 4])) +%!assert (bsxfun (f, ones ([4, 1, 4]), ones ([1, 4, 1])), zeros ([4, 4, 4])) +%!assert (bsxfun (f, a, b), a - repmat (b, [4, 1, 1])) +%!assert (bsxfun (f, a, c), a - repmat (c, [1, 4, 1])) +%!assert (bsxfun (f, a, d), a - repmat (d, [1, 1, 4])) +%!assert (bsxfun ("minus", ones ([4, 0, 4]), ones ([4, 1, 4])), zeros ([4, 0, 4])) -%% The below is a very hard case to treat -%!assert(bsxfun (f, ones([4, 1, 4, 1]), ones([1, 4, 1, 4])), zeros([4, 4, 4, 4])); +%% The test below is a very hard case to treat +%!assert (bsxfun (f, ones ([4, 1, 4, 1]), ones ([1, 4, 1, 4])), zeros ([4, 4, 4, 4])); %!shared a, b, aa, bb %! a = randn (3, 1, 3); %! aa = a(:, ones (1, 3), :, ones (1, 3)); %! b = randn (1, 3, 3, 3); %! bb = b(ones (1, 3), :, :, :); -%!assert (bsxfun (@plus, a, b), aa + bb); -%!assert (bsxfun (@minus, a, b), aa - bb); -%!assert (bsxfun (@times, a, b), aa .* bb); -%!assert (bsxfun (@rdivide, a, b), aa ./ bb); -%!assert (bsxfun (@ldivide, a, b), aa .\ bb); -%!assert (bsxfun (@power, a, b), aa .^ bb); -%!assert (bsxfun (@power, abs (a), b), abs (aa) .^ bb); -%!assert (bsxfun (@eq, round (a), round (b)), round (aa) == round (bb)); -%!assert (bsxfun (@ne, round (a), round (b)), round (aa) != round (bb)); -%!assert (bsxfun (@lt, a, b), aa < bb); -%!assert (bsxfun (@le, a, b), aa <= bb); -%!assert (bsxfun (@gt, a, b), aa > bb); -%!assert (bsxfun (@ge, a, b), aa >= bb); -%!assert (bsxfun (@min, a, b), min (aa, bb)); -%!assert (bsxfun (@max, a, b), max (aa, bb)); -%!assert (bsxfun (@and, a > 0, b > 0), (aa > 0) & (bb > 0)); -%!assert (bsxfun (@or, a > 0, b > 0), (aa > 0) | (bb > 0)); +%!assert (bsxfun (@plus, a, b), aa + bb) +%!assert (bsxfun (@minus, a, b), aa - bb) +%!assert (bsxfun (@times, a, b), aa .* bb) +%!assert (bsxfun (@rdivide, a, b), aa ./ bb) +%!assert (bsxfun (@ldivide, a, b), aa .\ bb) +%!assert (bsxfun (@power, a, b), aa .^ bb) +%!assert (bsxfun (@power, abs (a), b), abs (aa) .^ bb) +%!assert (bsxfun (@eq, round (a), round (b)), round (aa) == round (bb)) +%!assert (bsxfun (@ne, round (a), round (b)), round (aa) != round (bb)) +%!assert (bsxfun (@lt, a, b), aa < bb) +%!assert (bsxfun (@le, a, b), aa <= bb) +%!assert (bsxfun (@gt, a, b), aa > bb) +%!assert (bsxfun (@ge, a, b), aa >= bb) +%!assert (bsxfun (@min, a, b), min (aa, bb)) +%!assert (bsxfun (@max, a, b), max (aa, bb)) +%!assert (bsxfun (@and, a > 0, b > 0), (aa > 0) & (bb > 0)) +%!assert (bsxfun (@or, a > 0, b > 0), (aa > 0) | (bb > 0)) %% Test automatic bsxfun % @@ -779,10 +779,10 @@ %! %! float_types = {@single, @double}; %! int_types = {@int8, @int16, @int32, @int64, \ -%! @uint8, @uint16, @uint32, @uint64}; +%! @uint8, @uint16, @uint32, @uint64}; %! -%! x = rand (3)*10-5; -%! y = rand (3,1)*10-5; +%! x = rand (3) * 10-5; +%! y = rand (3,1) * 10-5; %! %! for i=1:length (funs) %! for j = 1:length(float_types) diff --git a/src/DLD-FUNCTIONS/cellfun.cc b/src/DLD-FUNCTIONS/cellfun.cc --- a/src/DLD-FUNCTIONS/cellfun.cc +++ b/src/DLD-FUNCTIONS/cellfun.cc @@ -712,301 +712,302 @@ /* %!function r = __f11 (x) -%! global __cellfun_test_num_outputs__ +%! global __cellfun_test_num_outputs__; %! __cellfun_test_num_outputs__ = nargout; %! r = x; %!endfunction %!function __f01 (x) -%! global __cellfun_test_num_outputs__ +%! global __cellfun_test_num_outputs__; %! __cellfun_test_num_outputs__ = nargout; %!endfunction %!test -%! global __cellfun_test_num_outputs__ +%! global __cellfun_test_num_outputs__; %! cellfun (@__f11, {1}); -%! assert (__cellfun_test_num_outputs__, 0) +%! assert (__cellfun_test_num_outputs__, 0); %! x = cellfun (@__f11, {1}); -%! assert (__cellfun_test_num_outputs__, 1) +%! assert (__cellfun_test_num_outputs__, 1); %!test -%! global __cellfun_test_num_outputs__ +%! global __cellfun_test_num_outputs__; %! cellfun (@__f01, {1}); -%! assert (__cellfun_test_num_outputs__, 0) +%! assert (__cellfun_test_num_outputs__, 0); %!error x = cellfun (@__f01, {1, 2}); %!test -%! assert (cellfun (@__f11, {1, 2}), [1, 2]) -%! assert (cellfun (@__f11, {1, 2}, 'uniformoutput', false), {1, 2}) +%! assert (cellfun (@__f11, {1, 2}), [1, 2]); +%! assert (cellfun (@__f11, {1, 2}, 'uniformoutput', false), {1, 2}); %!test -%! [a,b] = cellfun (@(x) x, cell (2, 0)); -%! assert (a, zeros (2, 0)); -%! assert (b, zeros (2, 0)); +%! [a,b] = cellfun (@(x) x, cell (2, 0)); +%! assert (a, zeros (2, 0)); +%! assert (b, zeros (2, 0)); %!test -%! [a,b] = cellfun (@(x) x, cell (2, 0), "uniformoutput", false); -%! assert (a, cell (2, 0)); -%! assert (b, cell (2, 0)); +%! [a,b] = cellfun (@(x) x, cell (2, 0), "uniformoutput", false); +%! assert (a, cell (2, 0)); +%! assert (b, cell (2, 0)); %% Test function to check the "Errorhandler" option -%!function [z] = __cellfunerror (S, varargin) +%!function z = __cellfunerror (S, varargin) %! z = S; %!endfunction %% First input argument can be a string, an inline function, %% a function_handle or an anonymous function %!test -%! A = cellfun ("islogical", {true, 0.1, false, i*2}); -%! assert (A, [true, false, true, false]); +%! A = cellfun ("islogical", {true, 0.1, false, i*2}); +%! assert (A, [true, false, true, false]); %!test -%! A = cellfun (inline ("islogical (x)", "x"), {true, 0.1, false, i*2}); -%! assert (A, [true, false, true, false]); +%! A = cellfun (inline ("islogical (x)", "x"), {true, 0.1, false, i*2}); +%! assert (A, [true, false, true, false]); %!test -%! A = cellfun (@islogical, {true, 0.1, false, i*2}); -%! assert (A, [true, false, true, false]); +%! A = cellfun (@islogical, {true, 0.1, false, i*2}); +%! assert (A, [true, false, true, false]); %!test -%! A = cellfun (@(x) islogical(x), {true, 0.1, false, i*2}); -%! assert (A, [true, false, true, false]); +%! A = cellfun (@(x) islogical(x), {true, 0.1, false, i*2}); +%! assert (A, [true, false, true, false]); %% First input argument can be the special string "isreal", %% "isempty", "islogical", "length", "ndims" or "prodofsize" %!test -%! A = cellfun ("isreal", {true, 0.1, {}, i*2, [], "abc"}); -%! assert (A, [true, true, false, false, true, true]); +%! A = cellfun ("isreal", {true, 0.1, {}, i*2, [], "abc"}); +%! assert (A, [true, true, false, false, true, true]); %!test -%! A = cellfun ("isempty", {true, 0.1, false, i*2, [], "abc"}); -%! assert (A, [false, false, false, false, true, false]); +%! A = cellfun ("isempty", {true, 0.1, false, i*2, [], "abc"}); +%! assert (A, [false, false, false, false, true, false]); %!test -%! A = cellfun ("islogical", {true, 0.1, false, i*2, [], "abc"}); -%! assert (A, [true, false, true, false, false, false]); +%! A = cellfun ("islogical", {true, 0.1, false, i*2, [], "abc"}); +%! assert (A, [true, false, true, false, false, false]); %!test -%! A = cellfun ("length", {true, 0.1, false, i*2, [], "abc"}); -%! assert (A, [1, 1, 1, 1, 0, 3]); +%! A = cellfun ("length", {true, 0.1, false, i*2, [], "abc"}); +%! assert (A, [1, 1, 1, 1, 0, 3]); %!test -%! A = cellfun ("ndims", {[1, 2; 3, 4]; (cell (1,2,3,4))}); -%! assert (A, [2; 4]); +%! A = cellfun ("ndims", {[1, 2; 3, 4]; (cell (1,2,3,4))}); +%! assert (A, [2; 4]); %!test -%! A = cellfun ("prodofsize", {[1, 2; 3, 4], (cell (1,2,3,4))}); -%! assert (A, [4, 24]); +%! A = cellfun ("prodofsize", {[1, 2; 3, 4], (cell (1,2,3,4))}); +%! assert (A, [4, 24]); %% Number of input and output arguments may not be limited to one %!test -%! A = cellfun (@(x,y,z) x + y + z, {1, 1, 1}, {2, 2, 2}, {3, 4, 5}); -%! assert (A, [6, 7, 8]); +%! A = cellfun (@(x,y,z) x + y + z, {1, 1, 1}, {2, 2, 2}, {3, 4, 5}); +%! assert (A, [6, 7, 8]); %!test -%! A = cellfun (@(x,y,z) x + y + z, {1, 1, 1}, {2, 2, 2}, {3, 4, 5}, \ -%! "UniformOutput", false); -%! assert (A, {6, 7, 8}); +%! A = cellfun (@(x,y,z) x + y + z, {1, 1, 1}, {2, 2, 2}, {3, 4, 5}, \ +%! "UniformOutput", false); +%! assert (A, {6, 7, 8}); %!test %% Two input arguments of different types -%! A = cellfun (@(x,y) islogical (x) && ischar (y), {false, true}, {"a", 3}); -%! assert (A, [true, false]); +%! A = cellfun (@(x,y) islogical (x) && ischar (y), {false, true}, {"a", 3}); +%! assert (A, [true, false]); %!test %% Pass another variable to the anonymous function -%! y = true; A = cellfun (@(x) islogical (x) && y, {false, 0.3}); -%! assert (A, [true, false]); +%! y = true; +%! A = cellfun (@(x) islogical (x) && y, {false, 0.3}); +%! assert (A, [true, false]); %!test %% Three ouptut arguments of different type -%! [A, B, C] = cellfun (@find, {10, 11; 0, 12}, "UniformOutput", false); -%! assert (isequal (A, {true, true; [], true})); -%! assert (isequal (B, {true, true; [], true})); -%! assert (isequal (C, {10, 11; [], 12})); +%! [A, B, C] = cellfun (@find, {10, 11; 0, 12}, "UniformOutput", false); +%! assert (isequal (A, {true, true; [], true})); +%! assert (isequal (B, {true, true; [], true})); +%! assert (isequal (C, {10, 11; [], 12})); %% Input arguments can be of type cell array of logical %!test -%! A = cellfun (@(x,y) x == y, {false, true}, {true, true}); -%! assert (A, [false, true]); +%! A = cellfun (@(x,y) x == y, {false, true}, {true, true}); +%! assert (A, [false, true]); %!test -%! A = cellfun (@(x,y) x == y, {false; true}, {true; true}, \ -%! "UniformOutput", true); -%! assert (A, [false; true]); +%! A = cellfun (@(x,y) x == y, {false; true}, {true; true}, \ +%! "UniformOutput", true); +%! assert (A, [false; true]); %!test -%! A = cellfun (@(x) x, {false, true; false, true}, "UniformOutput", false); -%! assert (A, {false, true; false, true}); +%! A = cellfun (@(x) x, {false, true; false, true}, "UniformOutput", false); +%! assert (A, {false, true; false, true}); %!test %% Three ouptut arguments of same type -%! [A, B, C] = cellfun (@find, {true, false; false, true}, \ -%! "UniformOutput", false); -%! assert (isequal (A, {true, []; [], true})); -%! assert (isequal (B, {true, []; [], true})); -%! assert (isequal (C, {true, []; [], true})); +%! [A, B, C] = cellfun (@find, {true, false; false, true}, \ +%! "UniformOutput", false); +%! assert (isequal (A, {true, []; [], true})); +%! assert (isequal (B, {true, []; [], true})); +%! assert (isequal (C, {true, []; [], true})); %!test -%! A = cellfun (@(x,y) cell2str (x,y), {true}, {true}, \ -%! "ErrorHandler", @__cellfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); +%! A = cellfun (@(x,y) cell2str (x,y), {true}, {true}, \ +%! "ErrorHandler", @__cellfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); %!test %% Overwriting setting of "UniformOutput" true -%! A = cellfun (@(x,y) cell2str (x,y), {true}, {true}, \ -%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); +%! A = cellfun (@(x,y) cell2str (x,y), {true}, {true}, \ +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); %% Input arguments can be of type cell array of numeric %!test -%! A = cellfun (@(x,y) x>y, {1.1, 4.2}, {3.1, 2+3*i}); -%! assert (A, [false, true]); +%! A = cellfun (@(x,y) x>y, {1.1, 4.2}, {3.1, 2+3*i}); +%! assert (A, [false, true]); %!test -%! A = cellfun (@(x,y) x>y, {1.1, 4.2; 2, 4}, {3.1, 2; 2, 4+2*i}, \ -%! "UniformOutput", true); -%! assert (A, [false, true; false, false]); +%! A = cellfun (@(x,y) x>y, {1.1, 4.2; 2, 4}, {3.1, 2; 2, 4+2*i}, \ +%! "UniformOutput", true); +%! assert (A, [false, true; false, false]); %!test -%! A = cellfun (@(x,y) x:y, {1.1, 4}, {3.1, 6}, "UniformOutput", false); -%! assert (isequal (A{1}, [1.1, 2.1, 3.1])); -%! assert (isequal (A{2}, [4, 5, 6])); +%! A = cellfun (@(x,y) x:y, {1.1, 4}, {3.1, 6}, "UniformOutput", false); +%! assert (isequal (A{1}, [1.1, 2.1, 3.1])); +%! assert (isequal (A{2}, [4, 5, 6])); %!test %% Three ouptut arguments of different type -%! [A, B, C] = cellfun (@find, {10, 11; 0, 12}, "UniformOutput", false); -%! assert (isequal (A, {true, true; [], true})); -%! assert (isequal (B, {true, true; [], true})); -%! assert (isequal (C, {10, 11; [], 12})); +%! [A, B, C] = cellfun (@find, {10, 11; 0, 12}, "UniformOutput", false); +%! assert (isequal (A, {true, true; [], true})); +%! assert (isequal (B, {true, true; [], true})); +%! assert (isequal (C, {10, 11; [], 12})); %!test -%! A = cellfun (@(x,y) cell2str(x,y), {1.1, 4}, {3.1, 6}, \ -%! "ErrorHandler", @__cellfunerror); -%! B = isfield (A(1), "message") && isfield (A(1), "index"); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = cellfun (@(x,y) cell2str(x,y), {1.1, 4}, {3.1, 6}, \ +%! "ErrorHandler", @__cellfunerror); +%! B = isfield (A(1), "message") && isfield (A(1), "index"); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %!test %% Overwriting setting of "UniformOutput" true -%! A = cellfun (@(x,y) cell2str(x,y), {1.1, 4}, {3.1, 6}, \ -%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); -%! B = isfield (A(1), "message") && isfield (A(1), "index"); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = cellfun (@(x,y) cell2str(x,y), {1.1, 4}, {3.1, 6}, \ +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); +%! B = isfield (A(1), "message") && isfield (A(1), "index"); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %% Input arguments can be of type cell arrays of character or strings %!error %% "UniformOutput" false should be used -%! A = cellfun (@(x,y) x>y, {"ad", "c", "ghi"}, {"cc", "d", "fgh"}); +%! A = cellfun (@(x,y) x>y, {"ad", "c", "ghi"}, {"cc", "d", "fgh"}); %!test -%! A = cellfun (@(x,y) x>y, {"a"; "f"}, {"c"; "d"}, "UniformOutput", true); -%! assert (A, [false; true]); +%! A = cellfun (@(x,y) x>y, {"a"; "f"}, {"c"; "d"}, "UniformOutput", true); +%! assert (A, [false; true]); %!test -%! A = cellfun (@(x,y) x:y, {"a", "d"}, {"c", "f"}, "UniformOutput", false); -%! assert (A, {"abc", "def"}); +%! A = cellfun (@(x,y) x:y, {"a", "d"}, {"c", "f"}, "UniformOutput", false); +%! assert (A, {"abc", "def"}); %!test -%! A = cellfun (@(x,y) cell2str(x,y), {"a", "d"}, {"c", "f"}, \ -%! "ErrorHandler", @__cellfunerror); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = cellfun (@(x,y) cell2str(x,y), {"a", "d"}, {"c", "f"}, \ +%! "ErrorHandler", @__cellfunerror); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %!test %% Overwriting setting of "UniformOutput" true -%! A = cellfun (@(x,y) cell2str(x,y), {"a", "d"}, {"c", "f"}, \ -%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = cellfun (@(x,y) cell2str(x,y), {"a", "d"}, {"c", "f"}, \ +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %% Structures cannot be handled by cellfun %!error -%! vst1.a = 1.1; vst1.b = 4.2; vst2.a = 3.1; vst2.b = 2; -%! A = cellfun (@(x,y) (x.a < y.a) && (x.b > y.b), vst1, vst2); +%! vst1.a = 1.1; vst1.b = 4.2; vst2.a = 3.1; vst2.b = 2; +%! A = cellfun (@(x,y) (x.a < y.a) && (x.b > y.b), vst1, vst2); %% Input arguments can be of type cell array of cell arrays %!test -%! A = cellfun (@(x,y) x{1} < y{1}, {{1.1}, {4.2}}, {{3.1}, {2}}); -%! assert (A, [1, 0], 1e-16); +%! A = cellfun (@(x,y) x{1} < y{1}, {{1.1}, {4.2}}, {{3.1}, {2}}); +%! assert (A, [1, 0], 1e-16); %!test -%! A = cellfun (@(x,y) x{1} < y{1}, {{1.1}; {4.2}}, {{3.1}; {2}}, \ -%! "UniformOutput", true); -%! assert (A, [1; 0], 1e-16); +%! A = cellfun (@(x,y) x{1} < y{1}, {{1.1}; {4.2}}, {{3.1}; {2}}, \ +%! "UniformOutput", true); +%! assert (A, [1; 0], 1e-16); %!test -%! A = cellfun (@(x,y) x{1} < y{1}, {{1.1}, {4.2}}, {{3.1}, {2}}, \ -%! "UniformOutput", false); -%! assert (A, {true, false}); +%! A = cellfun (@(x,y) x{1} < y{1}, {{1.1}, {4.2}}, {{3.1}, {2}}, \ +%! "UniformOutput", false); +%! assert (A, {true, false}); %!test -%! A = cellfun (@(x,y) mat2str(x,y), {{1.1}, {4.2}}, {{3.1}, {2}}, \ -%! "ErrorHandler", @__cellfunerror); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = cellfun (@(x,y) mat2str(x,y), {{1.1}, {4.2}}, {{3.1}, {2}}, \ +%! "ErrorHandler", @__cellfunerror); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %!test %% Overwriting setting of "UniformOutput" true -%! A = cellfun (@(x,y) mat2str(x,y), {{1.1}, {4.2}}, {{3.1}, {2}}, \ -%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = cellfun (@(x,y) mat2str(x,y), {{1.1}, {4.2}}, {{3.1}, {2}}, \ +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %% Input arguments can be of type cell array of structure arrays %!test -%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); -%! A = cellfun (@(x,y) (x.a == y.a) && (x.b < y.b), {a}, {b}); -%! assert (A, true); +%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); +%! A = cellfun (@(x,y) (x.a == y.a) && (x.b < y.b), {a}, {b}); +%! assert (A, true); %!test -%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); -%! A = cellfun (@(x,y) (x.a == y.a) && (x.b < y.b) , {a}, {b}, \ -%! "UniformOutput", true); -%! assert (A, true); +%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); +%! A = cellfun (@(x,y) (x.a == y.a) && (x.b < y.b) , {a}, {b}, \ +%! "UniformOutput", true); +%! assert (A, true); %!test -%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); -%! A = cellfun (@(x,y) (x.a == y.a) && (x.b < y.b) , {a}, {b}, \ -%! "UniformOutput", false); -%! assert (A, {true}); +%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); +%! A = cellfun (@(x,y) (x.a == y.a) && (x.b < y.b) , {a}, {b}, \ +%! "UniformOutput", false); +%! assert (A, {true}); %!test -%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); -%! A = cellfun (@(x,y) cell2str (x.a, y.a), {a}, {b}, \ -%! "ErrorHandler", @__cellfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); +%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); +%! A = cellfun (@(x,y) cell2str (x.a, y.a), {a}, {b}, \ +%! "ErrorHandler", @__cellfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); %!test %% Overwriting setting of "UniformOutput" true -%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); -%! A = cellfun (@(x,y) cell2str (x.a, y.a), {a}, {b}, \ -%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); +%! a = struct ("a", 1, "b", 2); b = struct ("a", 1, "b", 3); +%! A = cellfun (@(x,y) cell2str (x.a, y.a), {a}, {b}, \ +%! "UniformOutput", true, "ErrorHandler", @__cellfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); %% A lot of other tests -%!error(cellfun(1)) -%!error(cellfun('isclass',1)) -%!error(cellfun('size',1)) -%!error(cellfun(@sin,{[]},'BadParam',false)) -%!error(cellfun(@sin,{[]},'UniformOuput')) -%!error(cellfun(@sin,{[]},'ErrorHandler')) -%!assert(cellfun(@sin,{0,1}),sin([0,1])) -%!assert(cellfun(inline('sin(x)'),{0,1}),sin([0,1])) -%!assert(cellfun('sin',{0,1}),sin([0,1])) -%!assert(cellfun('isempty',{1,[]}),[false,true]) -%!assert(cellfun('islogical',{false,pi}),[true,false]) -%!assert(cellfun('isreal',{1i,1}),[false,true]) -%!assert(cellfun('length',{zeros(2,2),1}),[2,1]) -%!assert(cellfun('prodofsize',{zeros(2,2),1}),[4,1]) -%!assert(cellfun('ndims',{zeros([2,2,2]),1}),[3,2]) -%!assert(cellfun('isclass',{zeros([2,2,2]),'test'},'double'),[true,false]) -%!assert(cellfun('size',{zeros([1,2,3]),1},1),[1,1]) -%!assert(cellfun('size',{zeros([1,2,3]),1},2),[2,1]) -%!assert(cellfun('size',{zeros([1,2,3]),1},3),[3,1]) -%!assert(cellfun(@atan2,{1,1},{1,2}),[atan2(1,1),atan2(1,2)]) -%!assert(cellfun(@atan2,{1,1},{1,2},'UniformOutput',false),{atan2(1,1),atan2(1,2)}) -%!assert(cellfun(@sin,{1,2;3,4}),sin([1,2;3,4])) -%!assert(cellfun(@atan2,{1,1;1,1},{1,2;1,2}),atan2([1,1;1,1],[1,2;1,2])) -%!error(cellfun(@factorial,{-1,3})) -%!assert(cellfun(@factorial,{-1,3},'ErrorHandler',@(x,y) NaN),[NaN,6]) +%!assert (cellfun (@sin, {0,1}), sin ([0,1])) +%!assert (cellfun (inline ("sin (x)"), {0,1}), sin ([0,1])) +%!assert (cellfun ("sin", {0,1}), sin ([0,1])) +%!assert (cellfun ("isempty", {1,[]}), [false,true]) +%!assert (cellfun ("islogical", {false,pi}), [true,false]) +%!assert (cellfun ("isreal", {1i,1}), [false,true]) +%!assert (cellfun ("length", {zeros(2,2),1}), [2,1]) +%!assert (cellfun ("prodofsize", {zeros(2,2),1}), [4,1]) +%!assert (cellfun ("ndims", {zeros([2,2,2]),1}), [3,2]) +%!assert (cellfun ("isclass", {zeros([2,2,2]),"test"}, "double"), [true,false]) +%!assert (cellfun ("size", {zeros([1,2,3]),1}, 1), [1,1]) +%!assert (cellfun ("size", {zeros([1,2,3]),1}, 2), [2,1]) +%!assert (cellfun ("size", {zeros([1,2,3]),1}, 3), [3,1]) +%!assert (cellfun (@atan2, {1,1}, {1,2}), [atan2(1,1), atan2(1,2)]) +%!assert (cellfun (@atan2, {1,1}, {1,2},"UniformOutput", false), {atan2(1,1), atan2(1,2)}) +%!assert (cellfun (@sin, {1,2;3,4}), sin ([1,2;3,4])) +%!assert (cellfun (@atan2, {1,1;1,1}, {1,2;1,2}), atan2 ([1,1;1,1],[1,2;1,2])) +%!error cellfun (@factorial, {-1,3}) +%!assert (cellfun (@factorial,{-1,3},"ErrorHandler",@(x,y) NaN), [NaN,6]) %!test -%! [a,b,c]=cellfun(@fileparts,{fullfile("a","b","c.d"),fullfile("e","f","g.h")},'UniformOutput',false); -%! assert(a,{fullfile("a","b"),fullfile("e","f")}) -%! assert(b,{'c','g'}) -%! assert(c,{'.d','.h'}) +%! [a,b,c] = cellfun (@fileparts, {fullfile("a","b","c.d"), fullfile("e","f","g.h")}, "UniformOutput", false); +%! assert (a, {fullfile("a","b"), fullfile("e","f")}); +%! assert (b, {"c", "g"}); +%! assert (c, {".d", ".h"}); +%!error cellfun (1) +%!error cellfun ("isclass", 1) +%!error cellfun ("size", 1) +%!error cellfun (@sin, {[]}, "BadParam", false) +%!error cellfun (@sin, {[]}, "UniformOuput") +%!error cellfun (@sin, {[]}, "ErrorHandler") */ // Arrayfun was originally a .m file written by Bill Denney and Jaroslav @@ -1436,214 +1437,218 @@ /* %!function r = __f11 (x) -%! global __arrayfun_test_num_outputs__ +%! global __arrayfun_test_num_outputs__; %! __arrayfun_test_num_outputs__ = nargout; %! r = x; %!endfunction %!function __f01 (x) -%! global __arrayfun_test_num_outputs__ +%! global __arrayfun_test_num_outputs__; %! __arrayfun_test_num_outputs__ = nargout; %!endfunction %!test -%! global __arrayfun_test_num_outputs__ +%! global __arrayfun_test_num_outputs__; %! arrayfun (@__f11, {1}); -%! assert (__arrayfun_test_num_outputs__, 0) +%! assert (__arrayfun_test_num_outputs__, 0); %! x = arrayfun (@__f11, {1}); -%! assert (__arrayfun_test_num_outputs__, 1) +%! assert (__arrayfun_test_num_outputs__, 1); %!test -%! global __arrayfun_test_num_outputs__ +%! global __arrayfun_test_num_outputs__; %! arrayfun (@__f01, {1}); -%! assert (__arrayfun_test_num_outputs__, 0) +%! assert (__arrayfun_test_num_outputs__, 0); %!error x = arrayfun (@__f01, [1, 2]); %!test -%! assert (arrayfun (@__f11, [1, 2]), [1, 2]) -%! assert (arrayfun (@__f11, [1, 2], 'uniformoutput', false), {1, 2}); -%! assert (arrayfun (@__f11, {1, 2}), {1, 2}) -%! assert (arrayfun (@__f11, {1, 2}, 'uniformoutput', false), {{1}, {2}}); +%! assert (arrayfun (@__f11, [1, 2]), [1, 2]); +%! assert (arrayfun (@__f11, [1, 2], "uniformoutput", false), {1, 2}); +%! assert (arrayfun (@__f11, {1, 2}), {1, 2}); +%! assert (arrayfun (@__f11, {1, 2}, "uniformoutput", false), {{1}, {2}}); -%!assert (arrayfun (@ones, 1, [2,3], 'uniformoutput', false), {[1,1], [1,1,1]}); +%!assert (arrayfun (@ones, 1, [2,3], "uniformoutput", false), {[1,1], [1,1,1]}) %% Test function to check the "Errorhandler" option -%!function [z] = __arrayfunerror (S, varargin) -%! z = S; +%!function z = __arrayfunerror (S, varargin) +%! z = S; %!endfunction %% First input argument can be a string, an inline function, a %% function_handle or an anonymous function %!test -%! arrayfun (@isequal, [false, true], [true, true]); %% No output argument +%! arrayfun (@isequal, [false, true], [true, true]); %% No output argument %!error -%! arrayfun (@isequal); %% One or less input arguments +%! arrayfun (@isequal); %% One or less input arguments %!test -%! A = arrayfun ("isequal", [false, true], [true, true]); -%! assert (A, [false, true]); +%! A = arrayfun ("isequal", [false, true], [true, true]); +%! assert (A, [false, true]); %!test -%! A = arrayfun (inline ("(x == y)", "x", "y"), [false, true], [true, true]); -%! assert (A, [false, true]); +%! A = arrayfun (inline ("(x == y)", "x", "y"), [false, true], [true, true]); +%! assert (A, [false, true]); %!test -%! A = arrayfun (@isequal, [false, true], [true, true]); -%! assert (A, [false, true]); +%! A = arrayfun (@isequal, [false, true], [true, true]); +%! assert (A, [false, true]); %!test -%! A = arrayfun (@(x,y) isequal(x,y), [false, true], [true, true]); -%! assert (A, [false, true]); +%! A = arrayfun (@(x,y) isequal(x,y), [false, true], [true, true]); +%! assert (A, [false, true]); %% Number of input and output arguments may be greater than one %#!test -%! A = arrayfun (@(x) islogical (x), false); -%! assert (A, true); +%! A = arrayfun (@(x) islogical (x), false); +%! assert (A, true); %!test -%! A = arrayfun (@(x,y,z) x + y + z, [1, 1, 1], [2, 2, 2], [3, 4, 5]); -%! assert (A, [6, 7, 8], 1e-16); +%! A = arrayfun (@(x,y,z) x + y + z, [1, 1, 1], [2, 2, 2], [3, 4, 5]); +%! assert (A, [6, 7, 8], 1e-16); %!test %% Two input arguments of different types -%! A = arrayfun (@(x,y) islogical (x) && ischar (y), false, "a"); -%! assert (A, true); +%! A = arrayfun (@(x,y) islogical (x) && ischar (y), false, "a"); +%! assert (A, true); %!test %% Pass another variable to the anonymous function -%! y = true; A = arrayfun (@(x) islogical (x && y), false); -%! assert (A, true); +%! y = true; +%! A = arrayfun (@(x) islogical (x && y), false); +%! assert (A, true); %!test %% Three ouptut arguments of different type -%! [A, B, C] = arrayfun (@find, [10, 11; 0, 12], "UniformOutput", false); -%! assert (isequal (A, {true, true; [], true})); -%! assert (isequal (B, {true, true; [], true})); -%! assert (isequal (C, {10, 11; [], 12})); +%! [A, B, C] = arrayfun (@find, [10, 11; 0, 12], "UniformOutput", false); +%! assert (isequal (A, {true, true; [], true})); +%! assert (isequal (B, {true, true; [], true})); +%! assert (isequal (C, {10, 11; [], 12})); %% Input arguments can be of type logical %!test -%! A = arrayfun (@(x,y) x == y, [false, true], [true, true]); -%! assert (A, [false, true]); +%! A = arrayfun (@(x,y) x == y, [false, true], [true, true]); +%! assert (A, [false, true]); %!test -%! A = arrayfun (@(x,y) x == y, [false; true], [true; true], "UniformOutput", true); -%! assert (A, [false; true]); +%! A = arrayfun (@(x,y) x == y, [false; true], [true; true], "UniformOutput", true); +%! assert (A, [false; true]); %!test -%! A = arrayfun (@(x) x, [false, true, false, true], "UniformOutput", false); -%! assert (A, {false, true, false, true}); +%! A = arrayfun (@(x) x, [false, true, false, true], "UniformOutput", false); +%! assert (A, {false, true, false, true}); %!test %% Three ouptut arguments of same type -%! [A, B, C] = arrayfun (@find, [true, false; false, true], "UniformOutput", false); -%! assert (isequal (A, {true, []; [], true})); -%! assert (isequal (B, {true, []; [], true})); -%! assert (isequal (C, {true, []; [], true})); +%! [A, B, C] = arrayfun (@find, [true, false; false, true], "UniformOutput", false); +%! assert (isequal (A, {true, []; [], true})); +%! assert (isequal (B, {true, []; [], true})); +%! assert (isequal (C, {true, []; [], true})); %!test -%! A = arrayfun (@(x,y) array2str (x,y), true, true, "ErrorHandler", @__arrayfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); +%! A = arrayfun (@(x,y) array2str (x,y), true, true, \ +%! "ErrorHandler", @__arrayfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); %!test %% Overwriting setting of "UniformOutput" true -%! A = arrayfun (@(x,y) array2str (x,y), true, true, \ -%! "UniformOutput", true, "ErrorHandler", @__arrayfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); +%! A = arrayfun (@(x,y) array2str (x,y), true, true, "UniformOutput", true, \ +%! "ErrorHandler", @__arrayfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); %% Input arguments can be of type numeric %!test -%! A = arrayfun (@(x,y) x>y, [1.1, 4.2], [3.1, 2+3*i]); -%! assert (A, [false, true]); +%! A = arrayfun (@(x,y) x>y, [1.1, 4.2], [3.1, 2+3*i]); +%! assert (A, [false, true]); %!test -%! A = arrayfun (@(x,y) x>y, [1.1, 4.2; 2, 4], [3.1, 2; 2, 4+2*i], "UniformOutput", true); -%! assert (A, [false, true; false, false]); +%! A = arrayfun (@(x,y) x>y, [1.1, 4.2; 2, 4], [3.1, 2; 2, 4+2*i], "UniformOutput", true); +%! assert (A, [false, true; false, false]); %!test -%! A = arrayfun (@(x,y) x:y, [1.1, 4], [3.1, 6], "UniformOutput", false); -%! assert (isequal (A{1}, [1.1, 2.1, 3.1])); -%! assert (isequal (A{2}, [4, 5, 6])); +%! A = arrayfun (@(x,y) x:y, [1.1, 4], [3.1, 6], "UniformOutput", false); +%! assert (isequal (A{1}, [1.1, 2.1, 3.1])); +%! assert (isequal (A{2}, [4, 5, 6])); %!test %% Three ouptut arguments of different type -%! [A, B, C] = arrayfun (@find, [10, 11; 0, 12], "UniformOutput", false); -%! assert (isequal (A, {true, true; [], true})); -%! assert (isequal (B, {true, true; [], true})); -%! assert (isequal (C, {10, 11; [], 12})); +%! [A, B, C] = arrayfun (@find, [10, 11; 0, 12], "UniformOutput", false); +%! assert (isequal (A, {true, true; [], true})); +%! assert (isequal (B, {true, true; [], true})); +%! assert (isequal (C, {10, 11; [], 12})); %!test -%! A = arrayfun (@(x,y) array2str(x,y), {1.1, 4}, {3.1, 6}, "ErrorHandler", @__arrayfunerror); -%! B = isfield (A(1), "message") && isfield (A(1), "index"); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = arrayfun (@(x,y) array2str(x,y), {1.1, 4}, {3.1, 6}, \ +%! "ErrorHandler", @__arrayfunerror); +%! B = isfield (A(1), "message") && isfield (A(1), "index"); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %!test %% Overwriting setting of "UniformOutput" true -%! A = arrayfun (@(x,y) array2str(x,y), {1.1, 4}, {3.1, 6}, \ -%! "UniformOutput", true, "ErrorHandler", @__arrayfunerror); -%! B = isfield (A(1), "message") && isfield (A(1), "index"); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = arrayfun (@(x,y) array2str(x,y), {1.1, 4}, {3.1, 6}, \ +%! "UniformOutput", true, "ErrorHandler", @__arrayfunerror); +%! B = isfield (A(1), "message") && isfield (A(1), "index"); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %% Input arguments can be of type character or strings %!test -%! A = arrayfun (@(x,y) x>y, ["ad", "c", "ghi"], ["cc", "d", "fgh"]); -%! assert (A, [false, true, false, true, true, true]); +%! A = arrayfun (@(x,y) x>y, ["ad", "c", "ghi"], ["cc", "d", "fgh"]); +%! assert (A, [false, true, false, true, true, true]); %!test -%! A = arrayfun (@(x,y) x>y, ["a"; "f"], ["c"; "d"], "UniformOutput", true); -%! assert (A, [false; true]); +%! A = arrayfun (@(x,y) x>y, ["a"; "f"], ["c"; "d"], "UniformOutput", true); +%! assert (A, [false; true]); %!test -%! A = arrayfun (@(x,y) x:y, ["a", "d"], ["c", "f"], "UniformOutput", false); -%! assert (A, {"abc", "def"}); -%! %#!test -%! A = arrayfun (@(x,y) cell2str(x,y), ["a", "d"], ["c", "f"], "ErrorHandler", @__arrayfunerror); -%! B = isfield (A(1), "identifier") && isfield (A(1), "message") && isfield (A(1), "index"); -%! assert (B, true); +%! A = arrayfun (@(x,y) x:y, ["a", "d"], ["c", "f"], "UniformOutput", false); +%! assert (A, {"abc", "def"}); +%!test +%! A = arrayfun (@(x,y) cell2str(x,y), ["a", "d"], ["c", "f"], \ +%! "ErrorHandler", @__arrayfunerror); +%! B = isfield (A(1), "identifier") && isfield (A(1), "message") && isfield (A(1), "index"); +%! assert (B, true); %% Input arguments can be of type structure %!test -%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); -%! A = arrayfun (@(x,y) (x.a < y.a) && (x.b > y.b), a, b); -%! assert (A, true); +%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); +%! A = arrayfun (@(x,y) (x.a < y.a) && (x.b > y.b), a, b); +%! assert (A, true); %!test -%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); -%! A = arrayfun (@(x,y) (x.a < y.a) && (x.b > y.b), a, b, "UniformOutput", true); -%! assert (A, true); +%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); +%! A = arrayfun (@(x,y) (x.a < y.a) && (x.b > y.b), a, b, "UniformOutput", true); +%! assert (A, true); %!test -%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); -%! A = arrayfun (@(x,y) x.a:y.a, a, b, "UniformOutput", false); -%! assert (isequal (A, {[1.1, 2.1, 3.1]})); +%! a = struct ("a", 1.1, "b", 4.2); b = struct ("a", 3.1, "b", 2); +%! A = arrayfun (@(x,y) x.a:y.a, a, b, "UniformOutput", false); +%! assert (isequal (A, {[1.1, 2.1, 3.1]})); %!test -%! A = arrayfun (@(x) mat2str(x), "a", "ErrorHandler", @__arrayfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); +%! A = arrayfun (@(x) mat2str(x), "a", "ErrorHandler", @__arrayfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); %!test %% Overwriting setting of "UniformOutput" true -%! A = arrayfun (@(x) mat2str(x), "a", "UniformOutput", true, \ -%! "ErrorHandler", @__arrayfunerror); -%! assert (isfield (A, "identifier"), true); -%! assert (isfield (A, "message"), true); -%! assert (isfield (A, "index"), true); -%! assert (isempty (A.message), false); -%! assert (A.index, 1); +%! A = arrayfun (@(x) mat2str(x), "a", "UniformOutput", true, \ +%! "ErrorHandler", @__arrayfunerror); +%! assert (isfield (A, "identifier"), true); +%! assert (isfield (A, "message"), true); +%! assert (isfield (A, "index"), true); +%! assert (isempty (A.message), false); +%! assert (A.index, 1); %% Input arguments can be of type cell array %!test -%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1, 4.2}, {3.1, 2}); -%! assert (A, [true, false]); +%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1, 4.2}, {3.1, 2}); +%! assert (A, [true, false]); %!test -%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1; 4.2}, {3.1; 2}, "UniformOutput", true); -%! assert (A, [true; false]); +%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1; 4.2}, {3.1; 2}, "UniformOutput", true); +%! assert (A, [true; false]); %!test -%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1, 4.2}, {3.1, 2}, "UniformOutput", false); -%! assert (A, {true, false}); +%! A = arrayfun (@(x,y) x{1} < y{1}, {1.1, 4.2}, {3.1, 2}, "UniformOutput", false); +%! assert (A, {true, false}); %!test -%! A = arrayfun (@(x,y) num2str(x,y), {1.1, 4.2}, {3.1, 2}, "ErrorHandler", @__arrayfunerror); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = arrayfun (@(x,y) num2str(x,y), {1.1, 4.2}, {3.1, 2}, "ErrorHandler", @__arrayfunerror); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); %!test -%! A = arrayfun (@(x,y) num2str(x,y), {1.1, 4.2}, {3.1, 2}, \ -%! "UniformOutput", true, "ErrorHandler", @__arrayfunerror); -%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); -%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); -%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); -%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); -%! assert ([A(1).index, A(2).index], [1, 2]); +%! A = arrayfun (@(x,y) num2str(x,y), {1.1, 4.2}, {3.1, 2}, \ +%! "UniformOutput", true, "ErrorHandler", @__arrayfunerror); +%! assert ([(isfield (A(1), "identifier")), (isfield (A(2), "identifier"))], [true, true]); +%! assert ([(isfield (A(1), "message")), (isfield (A(2), "message"))], [true, true]); +%! assert ([(isfield (A(1), "index")), (isfield (A(2), "index"))], [true, true]); +%! assert ([(isempty (A(1).message)), (isempty (A(2).message))], [false, false]); +%! assert ([A(1).index, A(2).index], [1, 2]); */ static void @@ -1904,11 +1909,9 @@ } /* - -%!assert(num2cell([1,2;3,4]),{1,2;3,4}) -%!assert(num2cell([1,2;3,4],1),{[1;3],[2;4]}) -%!assert(num2cell([1,2;3,4],2),{[1,2];[3,4]}) - +%!assert (num2cell ([1,2;3,4]), {1,2;3,4}) +%!assert (num2cell ([1,2;3,4], 1), {[1;3],[2;4]}) +%!assert (num2cell ([1,2;3,4], 2), {[1,2];[3,4]}) */ static bool @@ -2252,18 +2255,16 @@ } /* +%!test +%! x = reshape (1:20, 5, 4); +%! c = mat2cell (x, [3,2], [3,1]); +%! assert (c, {[1,6,11;2,7,12;3,8,13],[16;17;18];[4,9,14;5,10,15],[19;20]}); %!test -%! x = reshape(1:20,5,4); -%! c = mat2cell(x,[3,2],[3,1]); -%! assert(c,{[1,6,11;2,7,12;3,8,13],[16;17;18];[4,9,14;5,10,15],[19;20]}) - -%!test -%! x = 'abcdefghij'; -%! c = mat2cell(x,1,[0,4,2,0,4,0]); -%! empty1by0str = resize('',1,0); -%! assert(c,{empty1by0str,'abcd','ef',empty1by0str,'ghij',empty1by0str}) - +%! x = "abcdefghij"; +%! c = mat2cell (x, 1, [0,4,2,0,4,0]); +%! empty1by0str = resize ("", 1, 0); +%! assert (c, {empty1by0str,"abcd","ef",empty1by0str,"ghij",empty1by0str}); */ // FIXME: it would be nice to allow ranges being handled without a conversion. diff --git a/src/DLD-FUNCTIONS/chol.cc b/src/DLD-FUNCTIONS/chol.cc --- a/src/DLD-FUNCTIONS/chol.cc +++ b/src/DLD-FUNCTIONS/chol.cc @@ -371,16 +371,14 @@ } /* - -%!assert(chol ([2, 1; 1, 1]), [sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)], sqrt (eps)); -%!assert(chol (single([2, 1; 1, 1])), single([sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)]), sqrt (eps('single'))); +%!assert (chol ([2, 1; 1, 1]), [sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)], sqrt (eps)) +%!assert (chol (single([2, 1; 1, 1])), single([sqrt(2), 1/sqrt(2); 0, 1/sqrt(2)]), sqrt (eps ("single"))) -%!error chol ([1, 2; 3, 4]); -%!error chol ([1, 2; 3, 4; 5, 6]); -%!error chol (); -%!error chol (1, 2); - - */ +%!error chol ([1, 2; 3, 4]) +%!error chol ([1, 2; 3, 4; 5, 6]) +%!error chol () +%!error chol (1, 2) +*/ DEFUN_DLD (cholinv, args, , "-*- texinfo -*-\n\ @@ -513,20 +511,18 @@ } /* - %!shared A, Ainv %! A = [2,0.2;0.2,1]; -%! Ainv = inv(A); +%! Ainv = inv (A); %!test -%! Ainv1 = cholinv(A); -%! assert (norm(Ainv-Ainv1),0,1e-10) +%! Ainv1 = cholinv (A); +%! assert (norm (Ainv-Ainv1), 0, 1e-10); %!testif HAVE_CHOLMOD -%! Ainv2 = inv(sparse(A)); -%! assert (norm(Ainv-Ainv2),0,1e-10) +%! Ainv2 = inv (sparse (A)); +%! assert (norm (Ainv-Ainv2), 0, 1e-10); %!testif HAVE_CHOLMOD -%! Ainv3 = cholinv(sparse(A)); -%! assert (norm(Ainv-Ainv3),0,1e-10) - +%! Ainv3 = cholinv (sparse (A)); +%! assert (norm (Ainv-Ainv3), 0, 1e-10); */ DEFUN_DLD (chol2inv, args, , @@ -786,59 +782,45 @@ %! 0.83760 + 0.68977i ; %! 0.39160 + 0.90378i ]; - +%!test +%! R = chol (A); +%! R1 = cholupdate (R, u); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - R'*R - u*u', Inf) < 1e1*eps); +%! +%! R1 = cholupdate (R1, u, "-"); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1 - R, Inf) < 1e1*eps); %!test -%! R = chol(A); -%! -%! R1 = cholupdate(R,u); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - R'*R - u*u',Inf) < 1e1*eps) -%! -%! R1 = cholupdate(R1,u,"-"); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1 - R,Inf) < 1e1*eps) +%! R = chol (Ac); +%! R1 = cholupdate (R, uc); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - R'*R - uc*uc', Inf) < 1e1*eps); %! -%!test -%! R = chol(Ac); -%! -%! R1 = cholupdate(R,uc); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - R'*R - uc*uc',Inf) < 1e1*eps) -%! -%! R1 = cholupdate(R1,uc,"-"); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1 - R,Inf) < 1e1*eps) +%! R1 = cholupdate (R1, uc, "-"); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1 - R, Inf) < 1e1*eps); %!test -%! R = chol(single(A)); -%! -%! R1 = cholupdate(R,single(u)); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - R'*R - single(u*u'),Inf) < 1e1*eps('single')) -%! -%! R1 = cholupdate(R1,single(u),"-"); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1 - R,Inf) < 2e1*eps('single')) +%! R = chol (single (A)); +%! R1 = cholupdate (R, single (u)); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - R'*R - single (u*u'), Inf) < 1e1*eps ("single")); %! +%! R1 = cholupdate (R1, single (u), "-"); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); + %!test -%! R = chol(single(Ac)); -%! -%! R1 = cholupdate(R,single(uc)); +%! R = chol (single (Ac)); +%! R1 = cholupdate (R, single (uc)); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - R'*R - single (uc*uc'), Inf) < 1e1*eps ("single")); %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - R'*R - single(uc*uc'),Inf) < 1e1*eps('single')) -%! -%! R1 = cholupdate(R1,single(uc),"-"); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1 - R,Inf) < 2e1*eps('single')) +%! R1 = cholupdate (R1, single (uc), "-"); +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1 - R, Inf) < 2e1*eps ("single")); */ DEFUN_DLD (cholinsert, args, nargout, @@ -972,14 +954,15 @@ %! -0.13825 ; %! 0.45266 ]; %! -%! R = chol(A); +%! R = chol (A); %! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert(R,j,u2); A1 = R1'*R1; +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(A1(p,p) - A,Inf) < 1e1*eps) -%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps); + %!test %! u2 = [ 0.35080 + 0.04298i; %! 0.63930 + 0.23778i; @@ -987,14 +970,14 @@ %! -0.13825 + 0.19879i; %! 0.45266 + 0.50020i]; %! -%! R = chol(Ac); +%! R = chol (Ac); %! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert(R,j,u2); A1 = R1'*R1; +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(A1(p,p) - Ac,Inf) < 1e1*eps) -%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (A1(p,p) - Ac, Inf) < 1e1*eps); %!test %! u2 = single ([ 0.35080 ; @@ -1005,12 +988,13 @@ %! %! R = chol(single(A)); %! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert(R,j,u2); A1 = R1'*R1; +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(A1(p,p) - A,Inf) < 1e1*eps('single')) -%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (A1(p,p) - A, Inf) < 1e1*eps ("single")); + %!test %! u2 = single ([ 0.35080 + 0.04298i; %! 0.63930 + 0.23778i; @@ -1018,55 +1002,55 @@ %! -0.13825 + 0.19879i; %! 0.45266 + 0.50020i]); %! -%! R = chol(single(Ac)); +%! R = chol (single (Ac)); %! -%! j = 3; p = [1:j-1, j+1:5]; -%! R1 = cholinsert(R,j,u2); A1 = R1'*R1; +%! j = 3; p = [1:j-1, j+1:5]; +%! R1 = cholinsert (R, j, u2); +%! A1 = R1'*R1; %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(A1(p,p) - single(Ac),Inf) < 2e1*eps('single')) -%! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (A1(p,p) - single (Ac), Inf) < 2e1*eps ("single")); %!test -%! cu = chol (triu (A), 'upper'); -%! cl = chol (tril (A), 'lower'); -%! assert (cu, cl', eps) -%! +%! cu = chol (triu (A), "upper"); +%! cl = chol (tril (A), "lower"); +%! assert (cu, cl', eps); + %!test %! cca = chol (Ac); %! -%! ccal = chol (Ac, 'lower'); -%! ccal2 = chol (tril (Ac), 'lower'); +%! ccal = chol (Ac, "lower"); +%! ccal2 = chol (tril (Ac), "lower"); %! -%! ccau = chol (Ac, 'upper'); -%! ccau2 = chol (triu (Ac), 'upper'); +%! ccau = chol (Ac, "upper"); +%! ccau2 = chol (triu (Ac), "upper"); %! -%! assert (cca'*cca, Ac, eps) -%! assert (ccau'*ccau, Ac, eps) -%! assert (ccau2'*ccau2, Ac, eps) +%! assert (cca'*cca, Ac, eps); +%! assert (ccau'*ccau, Ac, eps); +%! assert (ccau2'*ccau2, Ac, eps); %! -%! assert (cca, ccal', eps) -%! assert (cca, ccau, eps) -%! assert (cca, ccal2', eps) -%! assert (cca, ccau2, eps) -%! +%! assert (cca, ccal', eps); +%! assert (cca, ccau, eps); +%! assert (cca, ccal2', eps); +%! assert (cca, ccau2, eps); + %!test %! cca = chol (single (Ac)); %! -%! ccal = chol (single (Ac), 'lower'); -%! ccal2 = chol (tril (single (Ac)), 'lower'); +%! ccal = chol (single (Ac), "lower"); +%! ccal2 = chol (tril (single (Ac)), "lower"); %! -%! ccau = chol (single (Ac), 'upper'); -%! ccau2 = chol (triu (single (Ac)), 'upper'); +%! ccau = chol (single (Ac), "upper"); +%! ccau2 = chol (triu (single (Ac)), "upper"); %! -%! assert (cca'*cca, single (Ac), eps ('single')) -%! assert (ccau'*ccau, single (Ac), eps ('single')) -%! assert (ccau2'*ccau2, single (Ac), eps ('single')) +%! assert (cca'*cca, single (Ac), eps ("single")); +%! assert (ccau'*ccau, single (Ac), eps ("single")); +%! assert (ccau2'*ccau2, single (Ac), eps ("single")); %! -%! assert (cca, ccal', eps ('single')) -%! assert (cca, ccau, eps ('single')) -%! assert (cca, ccal2', eps ('single')) -%! assert (cca, ccau2, eps ('single')) +%! assert (cca, ccal', eps ("single")); +%! assert (cca, ccau, eps ("single")); +%! assert (cca, ccal2', eps ("single")); +%! assert (cca, ccau2, eps ("single")); %!test %! a = [12, 2, 3, 4; @@ -1083,21 +1067,20 @@ %! %! cca = chol (ca); %! -%! ccal = chol (ca, 'lower'); -%! ccal2 = chol (tril (ca), 'lower'); +%! ccal = chol (ca, "lower"); +%! ccal2 = chol (tril (ca), "lower"); %! -%! ccau = chol (ca, 'upper'); -%! ccau2 = chol (triu (ca), 'upper'); +%! ccau = chol (ca, "upper"); +%! ccau2 = chol (triu (ca), "upper"); %! -%! assert (cca'*cca, ca, 16*eps) -%! assert (ccau'*ccau, ca, 16*eps) -%! assert (ccau2'*ccau2, ca, 16*eps) +%! assert (cca'*cca, ca, 16*eps); +%! assert (ccau'*ccau, ca, 16*eps); +%! assert (ccau2'*ccau2, ca, 16*eps); %! -%! assert (cca, ccal', 16*eps) -%! assert (cca, ccau, 16*eps) -%! assert (cca, ccal2', 16*eps) -%! assert (cca, ccau2, 16*eps) - +%! assert (cca, ccal', 16*eps); +%! assert (cca, ccau, 16*eps); +%! assert (cca, ccal2', 16*eps); +%! assert (cca, ccau2, 16*eps); */ DEFUN_DLD (choldelete, args, , @@ -1199,38 +1182,38 @@ %!test %! R = chol(A); %! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete(R,j); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - A(p,p),Inf) < 1e1*eps) +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); %! -%!test -%! R = chol(Ac); -%! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete(R,j); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - Ac(p,p),Inf) < 1e1*eps) +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); %!test -%! R = chol(single(A)); +%! R = chol (Ac); +%! +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); %! -%! j = 3; p = [1:j-1,j+1:4]; -%! R1 = choldelete(R,j); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); + +%!test +%! R = chol (single (A)); %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - single(A(p,p)),Inf) < 1e1*eps('single')) +%! j = 3; p = [1:j-1,j+1:4]; +%! R1 = choldelete (R, j); %! +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); + %!test %! R = chol(single(Ac)); %! -%! j = 3; p = [1:j-1,j+1:4]; +%! j = 3; p = [1:j-1,j+1:4]; %! R1 = choldelete(R,j); %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - single(Ac(p,p)),Inf) < 1e1*eps('single')) +%! assert (norm (triu (R1)-R1, Inf), single (0)); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); */ DEFUN_DLD (cholshift, args, , @@ -1338,62 +1321,62 @@ /* %!test -%! R = chol(A); +%! R = chol (A); %! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift(R,i,j); +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - A(p,p),Inf) < 1e1*eps) +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - A(p,p), Inf) < 1e1*eps); %! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift(R,i,j); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - A(p,p),Inf) < 1e1*eps) +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); %! +%! assert (norm(triu(R1)-R1, Inf), 0); +%! assert (norm(R1'*R1 - A(p,p), Inf) < 1e1*eps); + %!test -%! R = chol(Ac); +%! R = chol (Ac); %! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift(R,i,j); +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - Ac(p,p),Inf) < 1e1*eps) +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); %! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift(R,i,j); +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - Ac(p,p),Inf) < 1e1*eps) +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - Ac(p,p), Inf) < 1e1*eps); %!test -%! R = chol(single(A)); +%! R = chol (single (A)); +%! +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); +%! +%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; +%! R1 = cholshift (R, i, j); %! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift(R,i,j); +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (A(p,p)), Inf) < 1e1*eps ("single")); + +%!test +%! R = chol (single (Ac)); %! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - single(A(p,p)),Inf) < 1e1*eps('single')) +%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; +%! R1 = cholshift (R, i, j); +%! +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); %! %! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift(R,i,j); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - single(A(p,p)),Inf) < 1e1*eps('single')) -%! -%!test -%! R = chol(single(Ac)); +%! R1 = cholshift (R, i, j); %! -%! i = 1; j = 3; p = [1:i-1, shift(i:j,-1), j+1:4]; -%! R1 = cholshift(R,i,j); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - single(Ac(p,p)),Inf) < 1e1*eps('single')) -%! -%! j = 1; i = 3; p = [1:j-1, shift(j:i,+1), i+1:4]; -%! R1 = cholshift(R,i,j); -%! -%! assert(norm(triu(R1)-R1,Inf) == 0) -%! assert(norm(R1'*R1 - single(Ac(p,p)),Inf) < 1e1*eps('single')) +%! assert (norm (triu (R1)-R1, Inf), 0); +%! assert (norm (R1'*R1 - single (Ac(p,p)), Inf) < 1e1*eps ("single")); */ diff --git a/src/DLD-FUNCTIONS/conv2.cc b/src/DLD-FUNCTIONS/conv2.cc --- a/src/DLD-FUNCTIONS/conv2.cc +++ b/src/DLD-FUNCTIONS/conv2.cc @@ -260,10 +260,10 @@ %!shared %% Test cases from Bug #34893 -%!assert (conv2 ([1:5;1:5], [1:2], 'same'), [4 7 10 13 10; 4 7 10 13 10]) -%!assert (conv2 ([1:5;1:5]', [1:2]', 'same'), [4 7 10 13 10; 4 7 10 13 10]') -%!#assert (conv2 ([1:5;1:5], [1:2], 'valid'), [4 7 10 13; 4 7 10 13]) -%!assert (conv2 ([1:5;1:5]', [1:2]', 'valid'), [4 7 10 13; 4 7 10 13]') +%!assert (conv2 ([1:5;1:5], [1:2], "same"), [4 7 10 13 10; 4 7 10 13 10]) +%!assert (conv2 ([1:5;1:5]', [1:2]', "same"), [4 7 10 13 10; 4 7 10 13 10]') +%!#assert (conv2 ([1:5;1:5], [1:2], "valid"), [4 7 10 13; 4 7 10 13]) +%!assert (conv2 ([1:5;1:5]', [1:2]', "valid"), [4 7 10 13; 4 7 10 13]') %% Test input validation %!error conv2 () @@ -272,7 +272,6 @@ %% Test alternate calling form which should be 2 vectors and a matrix %!error conv2 (ones (2), 1, 1) %!error conv2 (1, ones (2), 1) - */ DEFUN_DLD (convn, args, , diff --git a/src/DLD-FUNCTIONS/convhulln.cc b/src/DLD-FUNCTIONS/convhulln.cc --- a/src/DLD-FUNCTIONS/convhulln.cc +++ b/src/DLD-FUNCTIONS/convhulln.cc @@ -295,7 +295,7 @@ %! assert (h, [1 2 4; 1 2 6; 1 4 8; 1 5 6; 1 5 8; 2 3 4; 2 3 7; 2 6 7; 3 4 7; 4 7 8; 5 6 7; 5 7 8]); %! assert (v, 1, 10*eps); %! [h2, v2] = convhulln (cube); % Test defaut option = "Qt" -%! assert (size (h2), size (h)) +%! assert (size (h2), size (h)); %! h2 = sortrows (sort (h2, 2), [1:3]); %! assert (h2, h); %! assert (v2, v, 10*eps); diff --git a/src/DLD-FUNCTIONS/dassl.cc b/src/DLD-FUNCTIONS/dassl.cc --- a/src/DLD-FUNCTIONS/dassl.cc +++ b/src/DLD-FUNCTIONS/dassl.cc @@ -482,25 +482,24 @@ } /* - -%% dassl-1.m -%% -%% Test dassl() function -%% -%% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) -%% Comalco Research and Technology -%% 20 May 1998 -%% -%% Problem -%% -%% y1' = -y2, y1(0) = 1 -%% y2' = y1, y2(0) = 0 -%% -%% Solution -%% -%% y1(t) = cos(t) -%% y2(t) = sin(t) - +## dassl-1.m +## +## Test dassl() function +## +## Author: David Billinghurst (David.Billinghurst@riotinto.com.au) +## Comalco Research and Technology +## 20 May 1998 +## +## Problem +## +## y1' = -y2, y1(0) = 1 +## y2' = y1, y2(0) = 0 +## +## Solution +## +## y1(t) = cos(t) +## y2(t) = sin(t) +## %!function res = __f (x, xdot, t) %! res = [xdot(1)+x(2); xdot(2)-x(1)]; %!endfunction @@ -513,34 +512,33 @@ %! %! tol = 100 * dassl_options ("relative tolerance"); %! -%! %! [x, xdot] = dassl ("__f", x0, xdot0, t); %! %! y = [cos(t), sin(t)]; %! -%! assert(all (all (abs (x - y) < tol))); +%! assert (x, y, tol); -%% dassl-2.m -%% -%% Test dassl() function -%% -%% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) -%% Comalco Research and Technology -%% 20 May 1998 -%% -%% Based on SLATEC quick check for DASSL by Linda Petzold -%% -%% Problem -%% -%% x1' + 10*x1 = 0, x1(0) = 1 -%% x1 + x2 = 1, x2(0) = 0 -%% -%% -%% Solution -%% -%% x1(t) = exp(-10*t) -%% x2(t) = 1 - x(1) - +## dassl-2.m +## +## Test dassl() function +## +## Author: David Billinghurst (David.Billinghurst@riotinto.com.au) +## Comalco Research and Technology +## 20 May 1998 +## +## Based on SLATEC quick check for DASSL by Linda Petzold +## +## Problem +## +## x1' + 10*x1 = 0, x1(0) = 1 +## x1 + x2 = 1, x2(0) = 0 +## +## +## Solution +## +## x1(t) = exp(-10*t) +## x2(t) = 1 - x(1) +## %!function res = __f (x, xdot, t) %! res = [xdot(1)+10*x(1); x(1)+x(2)-1]; %!endfunction @@ -553,17 +551,15 @@ %! %! tol = 500 * dassl_options ("relative tolerance"); %! -%! %! [x, xdot] = dassl ("__f", x0, xdot0, t); %! %! y = [exp(-10*t), 1-exp(-10*t)]; %! -%! assert(all (all (abs (x - y) < tol))); +%! assert (x, y, tol); %!test %! dassl_options ("absolute tolerance", eps); -%! assert(dassl_options ("absolute tolerance") == eps); +%! assert (dassl_options ("absolute tolerance") == eps); -%!error dassl_options ("foo", 1, 2); - +%!error dassl_options ("foo", 1, 2) */ diff --git a/src/DLD-FUNCTIONS/det.cc b/src/DLD-FUNCTIONS/det.cc --- a/src/DLD-FUNCTIONS/det.cc +++ b/src/DLD-FUNCTIONS/det.cc @@ -245,11 +245,9 @@ } /* - -%!assert(det ([1, 2; 3, 4]), -2, 10 * eps); -%!assert(det (single([1, 2; 3, 4])), single(-2), 10 * eps ('single')); -%!error det (); -%!error det (1, 2); -%!error det ([1, 2; 3, 4; 5, 6]); - +%!assert (det ([1, 2; 3, 4]), -2, 10*eps) +%!assert (det (single ([1, 2; 3, 4])), single (-2), 10*eps ("single")) +%!error det () +%!error det (1, 2) +%!error det ([1, 2; 3, 4; 5, 6]) */ diff --git a/src/DLD-FUNCTIONS/dlmread.cc b/src/DLD-FUNCTIONS/dlmread.cc --- a/src/DLD-FUNCTIONS/dlmread.cc +++ b/src/DLD-FUNCTIONS/dlmread.cc @@ -480,21 +480,20 @@ } /* - %!shared file %! file = tmpnam (); %! fid = fopen (file, "wt"); %! fwrite (fid, "1, 2, 3\n4, 5, 6\n7, 8, 9\n10, 11, 12"); %! fclose (fid); -%!assert (dlmread (file), [1, 2, 3; 4, 5, 6; 7, 8, 9;10, 11, 12]); -%!assert (dlmread (file, ","), [1, 2, 3; 4, 5, 6; 7, 8, 9; 10, 11, 12]); -%!assert (dlmread (file, ",", [1, 0, 2, 1]), [4, 5; 7, 8]); -%!assert (dlmread (file, ",", "B1..C2"), [2, 3; 5, 6]); -%!assert (dlmread (file, ",", "B1:C2"), [2, 3; 5, 6]); -%!assert (dlmread (file, ",", "..C2"), [1, 2, 3; 4, 5, 6]); -%!assert (dlmread (file, ",", 0, 1), [2, 3; 5, 6; 8, 9; 11, 12]); -%!assert (dlmread (file, ",", "B1.."), [2, 3; 5, 6; 8, 9; 11, 12]); +%!assert (dlmread (file), [1, 2, 3; 4, 5, 6; 7, 8, 9;10, 11, 12]) +%!assert (dlmread (file, ","), [1, 2, 3; 4, 5, 6; 7, 8, 9; 10, 11, 12]) +%!assert (dlmread (file, ",", [1, 0, 2, 1]), [4, 5; 7, 8]) +%!assert (dlmread (file, ",", "B1..C2"), [2, 3; 5, 6]) +%!assert (dlmread (file, ",", "B1:C2"), [2, 3; 5, 6]) +%!assert (dlmread (file, ",", "..C2"), [1, 2, 3; 4, 5, 6]) +%!assert (dlmread (file, ",", 0, 1), [2, 3; 5, 6; 8, 9; 11, 12]) +%!assert (dlmread (file, ",", "B1.."), [2, 3; 5, 6; 8, 9; 11, 12]) %!error (dlmread (file, ",", [0 1])) %!test @@ -506,17 +505,16 @@ %! fwrite (fid, "1, 2, 3\n4+4i, 5, 6\n7, 8, 9\n10, 11, 12"); %! fclose (fid); -%!assert (dlmread (file), [1, 2, 3; 4 + 4i, 5, 6; 7, 8, 9; 10, 11, 12]); -%!assert (dlmread (file, ","), [1, 2, 3; 4 + 4i, 5, 6; 7, 8, 9; 10, 11, 12]); -%!assert (dlmread (file, ",", [1, 0, 2, 1]), [4 + 4i, 5; 7, 8]); -%!assert (dlmread (file, ",", "A2..B3"), [4 + 4i, 5; 7, 8]); -%!assert (dlmread (file, ",", "A2:B3"), [4 + 4i, 5; 7, 8]); -%!assert (dlmread (file, ",", "..B3"), [1, 2; 4 + 4i, 5; 7, 8]); -%!assert (dlmread (file, ",", 1, 0), [4 + 4i, 5, 6; 7, 8, 9; 10, 11, 12]); -%!assert (dlmread (file, ",", "A2.."), [4 + 4i, 5, 6; 7, 8, 9; 10, 11, 12]); +%!assert (dlmread (file), [1, 2, 3; 4 + 4i, 5, 6; 7, 8, 9; 10, 11, 12]) +%!assert (dlmread (file, ","), [1, 2, 3; 4 + 4i, 5, 6; 7, 8, 9; 10, 11, 12]) +%!assert (dlmread (file, ",", [1, 0, 2, 1]), [4 + 4i, 5; 7, 8]) +%!assert (dlmread (file, ",", "A2..B3"), [4 + 4i, 5; 7, 8]) +%!assert (dlmread (file, ",", "A2:B3"), [4 + 4i, 5; 7, 8]) +%!assert (dlmread (file, ",", "..B3"), [1, 2; 4 + 4i, 5; 7, 8]) +%!assert (dlmread (file, ",", 1, 0), [4 + 4i, 5, 6; 7, 8, 9; 10, 11, 12]) +%!assert (dlmread (file, ",", "A2.."), [4 + 4i, 5, 6; 7, 8, 9; 10, 11, 12]) %!error (dlmread (file, ",", [0 1])) %!test %! unlink (file); - */ diff --git a/src/DLD-FUNCTIONS/dmperm.cc b/src/DLD-FUNCTIONS/dmperm.cc --- a/src/DLD-FUNCTIONS/dmperm.cc +++ b/src/DLD-FUNCTIONS/dmperm.cc @@ -172,20 +172,19 @@ } /* - %!testif HAVE_CXSPARSE -%! n=20; -%! a=speye(n,n);a=a(randperm(n),:); -%! assert(a(dmperm(a),:),speye(n)) +%! n = 20; +%! a = speye (n,n); +%! a = a(randperm (n),:); +%! assert (a(dmperm (a),:), speye (n)); %!testif HAVE_CXSPARSE -%! n=20; -%! d=0.2; -%! a=tril(sprandn(n,n,d),-1)+speye(n,n); -%! a=a(randperm(n),randperm(n)); -%! [p,q,r,s]=dmperm(a); -%! assert(tril(a(p,q),-1),sparse(n,n)) - +%! n = 20; +%! d = 0.2; +%! a = tril (sprandn (n,n,d), -1) + speye (n,n); +%! a = a(randperm (n), randperm (n)); +%! [p,q,r,s] = dmperm (a); +%! assert (tril (a(p,q), -1), sparse (n, n)); */ DEFUN_DLD (sprank, args, nargout, @@ -221,11 +220,10 @@ } /* - -%!error(sprank(1,2)); +%!testif HAVE_CXSPARSE +%! assert (sprank (speye (20)), 20) %!testif HAVE_CXSPARSE -%! assert(sprank(speye(20)), 20) -%!testif HAVE_CXSPARSE -%! assert(sprank([1,0,2,0;2,0,4,0]),2) +%! assert (sprank ([1,0,2,0;2,0,4,0]), 2) +%!error sprank (1,2) */ diff --git a/src/DLD-FUNCTIONS/dot.cc b/src/DLD-FUNCTIONS/dot.cc --- a/src/DLD-FUNCTIONS/dot.cc +++ b/src/DLD-FUNCTIONS/dot.cc @@ -237,18 +237,16 @@ } /* - -%! assert(dot ([1, 2], [2, 3]), 11); +%!assert (dot ([1, 2], [2, 3]), 8) %!test %! x = [2, 1; 2, 1]; %! y = [-0.5, 2; 0.5, -2]; -%! assert(dot (x, y), [0 0]); +%! assert (dot (x, y), [0 0]); %!test -%! x = [ 1+i, 3-i; 1-i, 3-i]; -%! assert(dot (x, x), [4, 20]); - +%! x = [1+i, 3-i; 1-i, 3-i]; +%! assert (dot (x, x), [4, 20]); */ DEFUN_DLD (blkmm, args, , @@ -357,12 +355,10 @@ } /* - %!test %! x(:,:,1) = [1 2; 3 4]; %! x(:,:,2) = [1 1; 1 1]; %! z(:,:,1) = [7 10; 15 22]; %! z(:,:,2) = [2 2; 2 2]; -%! assert(blkmm (x,x),z); - +%! assert (blkmm (x,x), z); */ diff --git a/src/DLD-FUNCTIONS/eig.cc b/src/DLD-FUNCTIONS/eig.cc --- a/src/DLD-FUNCTIONS/eig.cc +++ b/src/DLD-FUNCTIONS/eig.cc @@ -254,83 +254,81 @@ } /* - -%!assert(eig ([1, 2; 2, 1]), [-1; 3], sqrt (eps)); +%!assert (eig ([1, 2; 2, 1]), [-1; 3], sqrt (eps)) %!test %! [v, d] = eig ([1, 2; 2, 1]); %! x = 1 / sqrt (2); -%! assert(d, [-1, 0; 0, 3], sqrt (eps)); -%! assert(v, [-x, x; x, x], sqrt (eps)); +%! assert (d, [-1, 0; 0, 3], sqrt (eps)); +%! assert (v, [-x, x; x, x], sqrt (eps)); -%!assert(eig (single ([1, 2; 2, 1])), single([-1; 3]), sqrt (eps('single'))); +%!assert (eig (single ([1, 2; 2, 1])), single ([-1; 3]), sqrt (eps ("single"))) %!test -%! [v, d] = eig (single([1, 2; 2, 1])); -%! x = single(1 / sqrt (2)); -%! assert(d, single([-1, 0; 0, 3]), sqrt (eps('single'))); -%! assert(v, [-x, x; x, x], sqrt (eps('single'))); +%! [v, d] = eig (single ([1, 2; 2, 1])); +%! x = single (1 / sqrt (2)); +%! assert (d, single ([-1, 0; 0, 3]), sqrt (eps ("single"))); +%! assert (v, [-x, x; x, x], sqrt (eps ("single"))); %!test -%! A = [1, 2; -1, 1]; B = [3, 3; 1, 2]; +%! A = [1, 2; -1, 1]; B = [3, 3; 1, 2]; %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); %!test -%! A = single([1, 2; -1, 1]); B = single([3, 3; 1, 2]); +%! A = single ([1, 2; -1, 1]); B = single ([3, 3; 1, 2]); %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps('single'))); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps('single'))); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps ("single"))); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps ("single"))); %!test -%! A = [1, 2; 2, 1]; B = [3, -2; -2, 3]; +%! A = [1, 2; 2, 1]; B = [3, -2; -2, 3]; %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); %!test -%! A = single([1, 2; 2, 1]); B = single([3, -2; -2, 3]); +%! A = single ([1, 2; 2, 1]); B = single ([3, -2; -2, 3]); %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps('single'))); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps('single'))); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps ("single"))); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps ("single"))); %!test -%! A = [1+3i, 2+i; 2-i, 1+3i]; B = [5+9i, 2+i; 2-i, 5+9i]; +%! A = [1+3i, 2+i; 2-i, 1+3i]; B = [5+9i, 2+i; 2-i, 5+9i]; %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); %!test -%! A = single([1+3i, 2+i; 2-i, 1+3i]); B = single([5+9i, 2+i; 2-i, 5+9i]); +%! A = single ([1+3i, 2+i; 2-i, 1+3i]); B = single ([5+9i, 2+i; 2-i, 5+9i]); %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps('single'))); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps('single'))); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps ("single"))); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps ("single"))); %!test -%! A = [1+3i, 2+3i; 3-8i, 8+3i]; B = [8+i, 3+i; 4-9i, 3+i]; +%! A = [1+3i, 2+3i; 3-8i, 8+3i]; B = [8+i, 3+i; 4-9i, 3+i]; %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); %!test -%! A = single([1+3i, 2+3i; 3-8i, 8+3i]); B = single([8+i, 3+i; 4-9i, 3+i]); +%! A = single ([1+3i, 2+3i; 3-8i, 8+3i]); B = single ([8+i, 3+i; 4-9i, 3+i]); %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps('single'))); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps('single'))); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps ("single"))); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps ("single"))); %!test -%! A = [1, 2; 3, 8]; B = [8, 3; 4, 3]; +%! A = [1, 2; 3, 8]; B = [8, 3; 4, 3]; %! [v, d] = eig (A, B); -%! assert(A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); -%! assert(A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); +%! assert (A * v(:, 1), d(1, 1) * B * v(:, 1), sqrt (eps)); +%! assert (A * v(:, 2), d(2, 2) * B * v(:, 2), sqrt (eps)); -%!error eig (); -%!error eig ([1, 2; 3, 4], [4, 3; 2, 1], 1); -%!error eig ([1, 2; 3, 4], 2); -%!error eig ([1, 2; 3, 4; 5, 6]); -%!error eig ("abcd"); -%!error eig ([1 2 ; 2 3], "abcd"); -%!error eig (false, [1 2 ; 2 3]); - +%!error eig () +%!error eig ([1, 2; 3, 4], [4, 3; 2, 1], 1) +%!error eig ([1, 2; 3, 4], 2) +%!error eig ([1, 2; 3, 4; 5, 6]) +%!error eig ("abcd") +%!error eig ([1 2 ; 2 3], "abcd") +%!error eig (false, [1 2 ; 2 3]) */ diff --git a/src/DLD-FUNCTIONS/eigs.cc b/src/DLD-FUNCTIONS/eigs.cc --- a/src/DLD-FUNCTIONS/eigs.cc +++ b/src/DLD-FUNCTIONS/eigs.cc @@ -769,764 +769,752 @@ /* #### SPARSE MATRIX VERSIONS #### */ /* - -%% Real positive definite tests, n must be even +## Real positive definite tests, n must be even %!shared n, k, A, d0, d2 %! n = 20; %! k = 4; -%! A = sparse([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)]); +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)]); %! d0 = eig (A); %! d2 = sort (d0); -%! [~, idx] = sort (abs(d0)); +%! [~, idx] = sort (abs (d0)); %! d0 = d0(idx); -%! rand("state", 42); % initialize generator to make eigs behavior reproducible +%! rand ("state", 42); # initialize generator to make eigs behavior reproducible %!testif HAVE_ARPACK %! d1 = eigs (A, k); %! assert (d1, d0(end:-1:(end-k+1)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A,k+1); -%! assert (d1, d0(end:-1:(end-k)),1e-11); +%! d1 = eigs (A, k+1); +%! assert (d1, d0(end:-1:(end-k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lm'); +%! d1 = eigs (A, k, "lm"); %! assert (d1, d0(end:-1:(end-k+1)), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 'sm'); +%! d1 = eigs (A, k, "sm"); %! assert (d1, d0(k:-1:1), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'la'); +%! d1 = eigs (A, k, "la"); %! assert (d1, d2(end:-1:(end-k+1)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sa'); +%! d1 = eigs (A, k, "sa"); %! assert (d1, d2(1:k), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'be'); +%! d1 = eigs (A, k, "be"); %! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k+1, 'be'); +%! d1 = eigs (A, k+1, "be"); %! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK %! d1 = eigs (A, k, 4.1); -%! [~,idx0] = sort (abs(d0 - 4.1)); -%! [~,idx1] = sort (abs(d1 - 4.1)); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); %! assert (d1(idx1), d0(idx0(1:k)), 1e-11); %!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs(A, speye(n), k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (eigs(A,k,4.1), eigs(A,speye(n),k,4.1), 1e-11); +%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, speye(n), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, speye(n)(q,q), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB=true; -%! d1 = eigs(A, speye(n), k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, speye(n)(q,q), k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (eigs(A,k,4.1), eigs(A,speye(n),k,4.1), 1e-11); +%! assert (eigs (A, k, 4.1), eigs (A, speye (n), k, 4.1), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A * x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 'lm', opts); +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); %! assert (d1, d0(end:-1:(end-k+1)), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 'sm', opts); +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); %! assert (d1, d0(k:-1:1), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye(n)) \ x; -%! opts.issym = 1; opts.isreal = 1; +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 1; opts.isreal = 1; %! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (d1, eigs(A,k,4.1), 1e-11); +%! assert (d1, eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK %! AA = speye (10); %! fn = @(x) AA * x; -%! opts.issym = 1; opts.isreal = 1; -%! assert (eigs (fn, 10, AA, 3, 'lm', opts), [1; 1; 1],10*eps); +%! opts.issym = 1; opts.isreal = 1; +%! assert (eigs (fn, 10, AA, 3, "lm", opts), [1; 1; 1], 10*eps); %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs(A, k, 'sm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'la'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "la"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sa'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sa"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'be'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "be"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor - */ /* - -%% Real unsymmetric tests +## Real unsymmetric tests %!shared n, k, A, d0 %! n = 20; %! k = 4; -%! A = sparse([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)]); +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)]); %! d0 = eig (A); -%! [~, idx] = sort (abs(d0)); +%! [~, idx] = sort (abs (d0)); %! d0 = d0(idx); -%! rand("state", 42); % initialize generator to make eigs behavior reproducible +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible %!testif HAVE_ARPACK %! d1 = eigs (A, k); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A,k+1); -%! assert (abs(d1), abs(d0(end:-1:(end-k))),1e-11); +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 'sm'); -%! assert (abs(d1), abs(d0(1:k)), 1e-11); +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lr'); -%! [~, idx] = sort (real(d0)); +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (d0)); %! d2 = d0(idx); -%! assert (real(d1), real(d2(end:-1:(end-k+1))), 1e-11); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sr'); -%! [~, idx] = sort (real(abs(d0))); +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); %! d2 = d0(idx); -%! assert (real(d1), real(d2(1:k)), 1e-11); +%! assert (real (d1), real (d2(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'li'); -%! [~, idx] = sort (imag(abs(d0))); +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); %! d2 = d0(idx); -%! assert (sort(imag(d1)), sort(imag(d2(end:-1:(end-k+1)))), 1e-11); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'si'); -%! [~, idx] = sort (imag(abs(d0))); +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); %! d2 = d0(idx); -%! assert (sort(imag(d1)), sort(imag(d2(1:k))), 1e-11); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK %! d1 = eigs (A, k, 4.1); -%! [~,idx0] = sort (abs(d0 - 4.1)); -%! [~,idx1] = sort (abs(d1 - 4.1)); -%! assert (abs(d1(idx1)), abs(d0(idx0(1:k))), 1e-11); -%! assert (sort(imag(d1(idx1))), sort(imag(d0(idx0(1:k)))), 1e-11); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); %!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs(A, speye(n), k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, speye(n), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, speye(n)(q,q), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB=true; -%! d1 = eigs(A, speye(n), k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, speye(n)(q,q), k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (abs(eigs(A,k,4.1)), abs(eigs(A,speye(n),k,4.1)), 1e-11); +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (sort(imag(eigs(A,k,4.1))), sort(imag(eigs(A,speye(n),k,4.1))), 1e-11); +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 'sm', opts); -%! assert (abs(d1), d0(1:k), 1e-11); +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye(n)) \ x; -%! opts.issym = 0; opts.isreal = 1; +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 1; %! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs(A, k, 'sm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lr'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sr'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'li'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'si'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor - */ /* - -%% Complex hermitian tests +## Complex hermitian tests %!shared n, k, A, d0 %! n = 20; %! k = 4; -%! A = sparse([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)]); +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)]); %! d0 = eig (A); -%! [~, idx] = sort (abs(d0)); +%! [~, idx] = sort (abs (d0)); %! d0 = d0(idx); -%! rand("state", 42); % initialize generator to make eigs behavior reproducible +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible %!testif HAVE_ARPACK %! d1 = eigs (A, k); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A,k+1); -%! assert (abs(d1), abs(d0(end:-1:(end-k))),1e-11); +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! d1 = eigs (A, k, 'sm'); -%! assert (abs(d1), abs(d0(1:k)), 1e-11); +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lr'); -%! [~, idx] = sort (real(abs(d0))); +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (abs (d0))); %! d2 = d0(idx); -%! assert (real(d1), real(d2(end:-1:(end-k+1))), 1e-11); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sr'); -%! [~, idx] = sort (real(abs(d0))); +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); %! d2 = d0(idx); -%! assert (real(d1), real(d2(1:k)), 1e-11); +%! assert (real (d1), real (d2(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'li'); -%! [~, idx] = sort (imag(abs(d0))); +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); %! d2 = d0(idx); -%! assert (sort(imag(d1)), sort(imag(d2(end:-1:(end-k+1)))), 1e-11); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'si'); -%! [~, idx] = sort (imag(abs(d0))); +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); %! d2 = d0(idx); -%! assert (sort(imag(d1)), sort(imag(d2(1:k))), 1e-11); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK %! d1 = eigs (A, k, 4.1); -%! [~,idx0] = sort (abs(d0 - 4.1)); -%! [~,idx1] = sort (abs(d1 - 4.1)); -%! assert (abs(d1(idx1)), abs(d0(idx0(1:k))), 1e-11); -%! assert (sort(imag(d1(idx1))), sort(imag(d0(idx0(1:k)))), 1e-11); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); %!testif HAVE_ARPACK, HAVE_CHOLMOD -%! d1 = eigs(A, speye(n), k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, speye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, speye(n), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, speye(n)(q,q), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB=true; -%! d1 = eigs(A, speye(n), k, 4.1, opts); -%! assert (abs(abs(d1)), abs(eigs(A,k,4.1)), 1e-11); -%! assert (sort(imag(abs(d1))), sort(imag(eigs(A,k,4.1))), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, speye (n), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, speye(n)(q,q), k, 4.1, opts); -%! assert (abs(abs(d1)), abs(eigs(A,k,4.1)), 1e-11); -%! assert (sort(imag(abs(d1))), sort(imag(eigs(A,k,4.1))), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, speye (n)(q,q), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (abs(eigs(A,k,4.1)), abs(eigs(A,speye(n),k,4.1)), 1e-11); +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, speye (n), k, 4.1)), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! assert (sort(imag(eigs(A,k,4.1))), sort(imag(eigs(A,speye(n),k,4.1))), 1e-11); +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, speye (n), k, 4.1))), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, 'sm', opts); -%! assert (abs(d1), d0(1:k), 1e-11); +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); %!testif HAVE_ARPACK, HAVE_UMFPACK -%! fn = @(x) (A - 4.1 * eye(n)) \ x; -%! opts.issym = 0; opts.isreal = 0; +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 0; %! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK, HAVE_UMFPACK -%! [v1,d1] = eigs(A, k, 'sm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lr'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sr'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'li'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'si'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*speye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*speye (n))*v1(:,i))), 0, 1e-11); %! endfor - */ /* #### FULL MATRIX VERSIONS #### */ /* - -%% Real positive definite tests, n must be even +## Real positive definite tests, n must be even %!shared n, k, A, d0, d2 %! n = 20; %! k = 4; -%! A = full(sparse([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)])); +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),4*ones(1,n),ones(1,n-2)])); %! d0 = eig (A); %! d2 = sort (d0); -%! [~, idx] = sort (abs(d0)); +%! [~, idx] = sort (abs (d0)); %! d0 = d0(idx); -%! rand("state", 42); % initialize generator to make eigs behavior reproducible +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible %!testif HAVE_ARPACK %! d1 = eigs (A, k); %! assert (d1, d0(end:-1:(end-k+1)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A,k+1); +%! d1 = eigs (A, k+1); %! assert (d1, d0(end:-1:(end-k)),1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lm'); +%! d1 = eigs (A, k, "lm"); %! assert (d1, d0(end:-1:(end-k+1)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sm'); +%! d1 = eigs (A, k, "sm"); %! assert (d1, d0(k:-1:1), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'la'); +%! d1 = eigs (A, k, "la"); %! assert (d1, d2(end:-1:(end-k+1)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sa'); +%! d1 = eigs (A, k, "sa"); %! assert (d1, d2(1:k), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'be'); +%! d1 = eigs (A, k, "be"); %! assert (d1, d2([1:floor(k/2), (end - ceil(k/2) + 1):end]), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k+1, 'be'); +%! d1 = eigs (A, k+1, "be"); %! assert (d1, d2([1:floor((k+1)/2), (end - ceil((k+1)/2) + 1):end]), 1e-11); %!testif HAVE_ARPACK %! d1 = eigs (A, k, 4.1); -%! [~,idx0] = sort (abs(d0 - 4.1)); -%! [~,idx1] = sort (abs(d1 - 4.1)); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); %! assert (d1(idx1), d0(idx0(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs(A, eye(n), k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! assert (eigs(A,k,4.1), eigs(A,eye(n),k,4.1), 1e-11); +%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, eye(n), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, eye(n)(q,q), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, eye(n), k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, eye(n)(q,q), k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! assert (eigs(A,k,4.1), eigs(A,eye(n),k,4.1), 1e-11); +%! assert (eigs (A, k, 4.1), eigs (A, eye (n), k, 4.1), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A * x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 'lm', opts); +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); %! assert (d1, d0(end:-1:(end-k+1)), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A \ x; -%! opts.issym = 1; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 'sm', opts); +%! opts.issym = 1; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); %! assert (d1, d0(k:-1:1), 1e-11); %!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye(n)) \ x; -%! opts.issym = 1; opts.isreal = 1; +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 1; opts.isreal = 1; %! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (d1, eigs(A,k,4.1), 1e-11); +%! assert (d1, eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'la'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "la"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sa'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sa"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'be'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "be"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor - */ /* - -%% Real unsymmetric tests +## Real unsymmetric tests %!shared n, k, A, d0 %! n = 20; %! k = 4; -%! A = full(sparse([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)])); +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),1:n,-ones(1,n-2)])); %! d0 = eig (A); -%! [~, idx] = sort (abs(d0)); +%! [~, idx] = sort (abs (d0)); %! d0 = d0(idx); -%! rand("state", 42); % initialize generator to make eigs behavior reproducible +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible %!testif HAVE_ARPACK %! d1 = eigs (A, k); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A,k+1); -%! assert (abs(d1), abs(d0(end:-1:(end-k))),1e-11); +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sm'); -%! assert (abs(d1), abs(d0(1:k)), 1e-11); +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lr'); -%! [~, idx] = sort (real(d0)); +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (d0)); %! d2 = d0(idx); -%! assert (real(d1), real(d2(end:-1:(end-k+1))), 1e-11); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sr'); -%! [~, idx] = sort (real(abs(d0))); +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); %! d2 = d0(idx); -%! assert (real(d1), real(d2(1:k)), 1e-11); +%! assert (real (d1), real (d2(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'li'); -%! [~, idx] = sort (imag(abs(d0))); +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); %! d2 = d0(idx); -%! assert (sort(imag(d1)), sort(imag(d2(end:-1:(end-k+1)))), 1e-11); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'si'); -%! [~, idx] = sort (imag(abs(d0))); +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); %! d2 = d0(idx); -%! assert (sort(imag(d1)), sort(imag(d2(1:k))), 1e-11); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); %!testif HAVE_ARPACK %! d1 = eigs (A, k, 4.1); -%! [~,idx0] = sort (abs(d0 - 4.1)); -%! [~,idx1] = sort (abs(d1 - 4.1)); -%! assert (abs(d1(idx1)), abs(d0(idx0(1:k))), 1e-11); -%! assert (sort(imag(d1(idx1))), sort(imag(d0(idx0(1:k)))), 1e-11); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs(A, eye(n), k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, eye(n), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, eye(n)(q,q), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, eye(n), k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, eye(n)(q,q), k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! assert (abs(eigs(A,k,4.1)), abs(eigs(A,eye(n),k,4.1)), 1e-11); +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); %!testif HAVE_ARPACK -%! assert (sort(imag(eigs(A,k,4.1))), sort(imag(eigs(A,eye(n),k,4.1))), 1e-11); +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 1; -%! d1 = eigs (fn, n, k, 'sm', opts); -%! assert (abs(d1), d0(1:k), 1e-11); +%! opts.issym = 0; opts.isreal = 1; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); %!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye(n)) \ x; -%! opts.issym = 0; opts.isreal = 1; +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 1; %! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lr'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sr'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'li'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'si'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor - */ /* - -%% Complex hermitian tests +## Complex hermitian tests %!shared n, k, A, d0 %! n = 20; %! k = 4; -%! A = full(sparse([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)])); +%! A = full (sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[1i*ones(1,n-2),4*ones(1,n),-1i*ones(1,n-2)])); %! d0 = eig (A); -%! [~, idx] = sort (abs(d0)); +%! [~, idx] = sort (abs (d0)); %! d0 = d0(idx); -%! rand("state", 42); % initialize generator to make eigs behavior reproducible +%! rand ("state", 42); % initialize generator to make eigs behavior reproducible %!testif HAVE_ARPACK %! d1 = eigs (A, k); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A,k+1); -%! assert (abs(d1), abs(d0(end:-1:(end-k))),1e-11); +%! d1 = eigs (A, k+1); +%! assert (abs (d1), abs (d0(end:-1:(end-k))),1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sm'); -%! assert (abs(d1), abs(d0(1:k)), 1e-11); +%! d1 = eigs (A, k, "sm"); +%! assert (abs (d1), abs (d0(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'lr'); -%! [~, idx] = sort (real(abs(d0))); +%! d1 = eigs (A, k, "lr"); +%! [~, idx] = sort (real (abs (d0))); %! d2 = d0(idx); -%! assert (real(d1), real(d2(end:-1:(end-k+1))), 1e-11); +%! assert (real (d1), real (d2(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'sr'); -%! [~, idx] = sort (real(abs(d0))); +%! d1 = eigs (A, k, "sr"); +%! [~, idx] = sort (real (abs (d0))); %! d2 = d0(idx); -%! assert (real(d1), real(d2(1:k)), 1e-11); +%! assert (real (d1), real (d2(1:k)), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'li'); -%! [~, idx] = sort (imag(abs(d0))); +%! d1 = eigs (A, k, "li"); +%! [~, idx] = sort (imag (abs (d0))); %! d2 = d0(idx); -%! assert (sort(imag(d1)), sort(imag(d2(end:-1:(end-k+1)))), 1e-11); +%! assert (sort (imag (d1)), sort (imag (d2(end:-1:(end-k+1)))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs (A, k, 'si'); -%! [~, idx] = sort (imag(abs(d0))); +%! d1 = eigs (A, k, "si"); +%! [~, idx] = sort (imag (abs (d0))); %! d2 = d0(idx); -%! assert (sort(imag(d1)), sort(imag(d2(1:k))), 1e-11); +%! assert (sort (imag (d1)), sort (imag (d2(1:k))), 1e-11); %!testif HAVE_ARPACK %! d1 = eigs (A, k, 4.1); -%! [~,idx0] = sort (abs(d0 - 4.1)); -%! [~,idx1] = sort (abs(d1 - 4.1)); -%! assert (abs(d1(idx1)), abs(d0(idx0(1:k))), 1e-11); -%! assert (sort(imag(d1(idx1))), sort(imag(d0(idx0(1:k)))), 1e-11); +%! [~, idx0] = sort (abs (d0 - 4.1)); +%! [~, idx1] = sort (abs (d1 - 4.1)); +%! assert (abs (d1(idx1)), abs (d0(idx0(1:k))), 1e-11); +%! assert (sort (imag (d1(idx1))), sort (imag (d0(idx0(1:k)))), 1e-11); %!testif HAVE_ARPACK -%! d1 = eigs(A, eye(n), k, 'lm'); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! d1 = eigs (A, eye (n), k, "lm"); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, eye(n), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, eye(n)(q,q), k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; -%! d1 = eigs(A, eye(n), k, 4.1, opts); -%! assert (abs(abs(d1)), abs(eigs(A,k,4.1)), 1e-11); -%! assert (sort(imag(abs(d1))), sort(imag(eigs(A,k,4.1))), 1e-11); +%! opts.cholB = true; +%! d1 = eigs (A, eye (n), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); %!testif HAVE_ARPACK -%! opts.cholB=true; +%! opts.cholB = true; %! q = [2:n,1]; -%! opts.permB=q; -%! d1 = eigs(A, eye(n)(q,q), k, 4.1, opts); -%! assert (abs(abs(d1)), abs(eigs(A,k,4.1)), 1e-11); -%! assert (sort(imag(abs(d1))), sort(imag(eigs(A,k,4.1))), 1e-11); +%! opts.permB = q; +%! d1 = eigs (A, eye (n)(q,q), k, 4.1, opts); +%! assert (abs (abs (d1)), abs (eigs (A, k, 4.1)), 1e-11); +%! assert (sort (imag (abs (d1))), sort (imag (eigs (A, k, 4.1))), 1e-11); %!testif HAVE_ARPACK -%! assert (abs(eigs(A,k,4.1)), abs(eigs(A,eye(n),k,4.1)), 1e-11); +%! assert (abs (eigs (A, k, 4.1)), abs (eigs (A, eye (n), k, 4.1)), 1e-11); %!testif HAVE_ARPACK -%! assert (sort(imag(eigs(A,k,4.1))), sort(imag(eigs(A,eye(n),k,4.1))), 1e-11); +%! assert (sort (imag (eigs (A, k, 4.1))), sort (imag (eigs (A, eye (n), k, 4.1))), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A * x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, 'lm', opts); -%! assert (abs(d1), abs(d0(end:-1:(end-k+1))), 1e-11); +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "lm", opts); +%! assert (abs (d1), abs (d0(end:-1:(end-k+1))), 1e-11); %!testif HAVE_ARPACK %! fn = @(x) A \ x; -%! opts.issym = 0; opts.isreal = 0; -%! d1 = eigs (fn, n, k, 'sm', opts); -%! assert (abs(d1), d0(1:k), 1e-11); +%! opts.issym = 0; opts.isreal = 0; +%! d1 = eigs (fn, n, k, "sm", opts); +%! assert (abs (d1), d0(1:k), 1e-11); %!testif HAVE_ARPACK -%! fn = @(x) (A - 4.1 * eye(n)) \ x; -%! opts.issym = 0; opts.isreal = 0; +%! fn = @(x) (A - 4.1 * eye (n)) \ x; +%! opts.issym = 0; opts.isreal = 0; %! d1 = eigs (fn, n, k, 4.1, opts); -%! assert (abs(d1), eigs(A,k,4.1), 1e-11); +%! assert (abs (d1), eigs (A, k, 4.1), 1e-11); %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sm'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sm"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'lr'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "lr"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'sr'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "sr"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'li'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "li"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor %!testif HAVE_ARPACK -%! [v1,d1] = eigs(A, k, 'si'); -%! d1 = diag(d1); +%! [v1,d1] = eigs (A, k, "si"); +%! d1 = diag (d1); %! for i=1:k -%! assert(max(abs((A - d1(i)*eye(n))*v1(:,i))),0.,1e-11) +%! assert (max (abs ((A - d1(i)*eye (n))*v1(:,i))), 0, 1e-11); %! endfor - */ diff --git a/src/DLD-FUNCTIONS/fft.cc b/src/DLD-FUNCTIONS/fft.cc --- a/src/DLD-FUNCTIONS/fft.cc +++ b/src/DLD-FUNCTIONS/fft.cc @@ -177,24 +177,23 @@ } /* +%!assert (fft ([]), []) +%!assert (fft (zeros (10,0)), zeros (10,0)) +%!assert (fft (zeros (0,10)), zeros (0,10)) +%!assert (fft (0), 0) +%!assert (fft (1), 1) +%!assert (fft (ones (2,2)), [2,2; 0,0]) +%!assert (fft (eye (2,2)), [1,1; 1,-1]) -%!error(fft()) -%!assert(fft([]), []) -%!assert(fft(zeros(10,0)), zeros(10,0)) -%!assert(fft(zeros(0,10)), zeros(0,10)) -%!assert(fft(0), 0) -%!assert(fft(1), 1) -%!assert(fft(ones(2,2)), [2,2; 0,0]) -%!assert(fft(eye(2,2)), [1,1; 1,-1]) +%!assert (fft (single ([])), single ([])) +%!assert (fft (zeros (10,0,"single")), zeros (10,0,"single")) +%!assert (fft (zeros (0,10,"single")), zeros (0,10,"single")) +%!assert (fft (single (0)), single (0)) +%!assert (fft (single (1)), single (1)) +%!assert (fft (ones (2,2,"single")), single ([2,2; 0,0])) +%!assert (fft (eye (2,2,"single")), single ([1,1; 1,-1])) -%!assert(fft(single([])), single([])) -%!assert(fft(zeros(10,0,'single')), zeros(10,0,'single')) -%!assert(fft(zeros(0,10,'single')), zeros(0,10,'single')) -%!assert(fft(single(0)), single(0)) -%!assert(fft(single(1)), single(1)) -%!assert(fft(ones(2,2,'single')), single([2,2; 0,0])) -%!assert(fft(eye(2,2,'single')), single([1,1; 1,-1])) - +%!error (fft ()) */ @@ -256,67 +255,65 @@ } /* +%% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) +%% Comalco Research and Technology +%% 02 May 2000 +%!test +%! N = 64; +%! n = 4; +%! t = 2*pi*(0:1:N-1)/N; +%! s = cos (n*t); +%! S = fft (s); +%! +%! answer = zeros (size (t)); +%! answer(n+1) = N/2; +%! answer(N-n+1) = N/2; +%! +%! assert (S, answer, 4*N*eps); %% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) %% Comalco Research and Technology %% 02 May 2000 %!test -%! N=64; -%! n=4; +%! N = 64; +%! n = 7; %! t = 2*pi*(0:1:N-1)/N; -%! s = cos(n*t); -%! S = fft(s); -%! -%! answer = zeros (size(t)); -%! answer(n+1) = N/2; -%! answer(N-n+1) = N/2; -%! -%! assert(S, answer, 4*N*eps); - -%% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) -%% Comalco Research and Technology -%% 02 May 2000 -%!test -%! N=64; -%! n=7; -%! t = 2*pi*(0:1:N-1)/N; -%! s = cos(n*t); +%! s = cos (n*t); %! %! S = zeros (size(t)); %! S(n+1) = N/2; %! S(N-n+1) = N/2; %! -%! assert(ifft(S), s, 4*N*eps); +%! assert (ifft (S), s, 4*N*eps); %% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) %% Comalco Research and Technology %% 02 May 2000 %!test -%! N=64; -%! n=4; +%! N = 64; +%! n = 4; %! t = single (2*pi*(0:1:N-1)/N); -%! s = cos(n*t); -%! S = fft(s); +%! s = cos (n*t); +%! S = fft (s); %! -%! answer = zeros (size(t),'single'); +%! answer = zeros (size (t), "single"); %! answer(n+1) = N/2; %! answer(N-n+1) = N/2; %! -%! assert(S, answer, 4*N*eps('single')); +%! assert (S, answer, 4*N*eps ("single")); %% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) %% Comalco Research and Technology %% 02 May 2000 %!test -%! N=64; -%! n=7; +%! N = 64; +%! n = 7; %! t = 2*pi*(0:1:N-1)/N; -%! s = cos(n*t); +%! s = cos (n*t); %! -%! S = zeros (size(t),'single'); +%! S = zeros (size (t), "single"); %! S(n+1) = N/2; %! S(N-n+1) = N/2; %! -%! assert(ifft(S), s, 4*N*eps('single')); - +%! assert (ifft (S), s, 4*N*eps ("single")); */ diff --git a/src/DLD-FUNCTIONS/fft2.cc b/src/DLD-FUNCTIONS/fft2.cc --- a/src/DLD-FUNCTIONS/fft2.cc +++ b/src/DLD-FUNCTIONS/fft2.cc @@ -209,88 +209,86 @@ } /* +%% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) +%% Comalco Research and Technology +%% 02 May 2000 +%!test +%! M = 16; +%! N = 8; +%! +%! m = 5; +%! n = 3; +%! +%! x = 2*pi*(0:1:M-1)/M; +%! y = 2*pi*(0:1:N-1)/N; +%! sx = cos (m*x); +%! sy = sin (n*y); +%! s = kron (sx',sy); +%! S = fft2 (s); +%! answer = kron (fft (sx)', fft (sy)); +%! assert (S, answer, 4*M*N*eps); %% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) %% Comalco Research and Technology %% 02 May 2000 %!test -%! M=16; -%! N=8; -%! -%! m=5; -%! n=3; +%! M = 12; +%! N = 7; %! -%! x = 2*pi*(0:1:M-1)/M; -%! y = 2*pi*(0:1:N-1)/N; -%! sx = cos(m*x); -%! sy = sin(n*y); -%! s=kron(sx',sy); -%! S = fft2(s); -%! answer = kron(fft(sx)',fft(sy)); -%! assert(S, answer, 4*M*N*eps); - -%% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) -%% Comalco Research and Technology -%% 02 May 2000 -%!test -%! M=12; -%! N=7; -%! -%! m=3; -%! n=2; +%! m = 3; +%! n = 2; %! %! x = 2*pi*(0:1:M-1)/M; %! y = 2*pi*(0:1:N-1)/N; %! -%! sx = cos(m*x); -%! sy = cos(n*y); +%! sx = cos (m*x); +%! sy = cos (n*y); %! -%! S = kron(fft(sx)',fft(sy)); -%! answer=kron(sx',sy); -%! s = ifft2(S); +%! S = kron (fft (sx)', fft (sy)); +%! answer = kron (sx', sy); +%! s = ifft2 (S); %! -%! assert(s, answer, 30*eps); +%! assert (s, answer, 30*eps); %% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) %% Comalco Research and Technology %% 02 May 2000 %!test -%! M=16; -%! N=8; +%! M = 16; +%! N = 8; %! -%! m=5; -%! n=3; +%! m = 5; +%! n = 3; %! %! x = 2*pi*(0:1:M-1)/M; %! y = 2*pi*(0:1:N-1)/N; -%! sx = single(cos(m*x)); -%! sy = single(sin(n*y)); -%! s=kron(sx',sy); -%! S = fft2(s); -%! answer = kron(fft(sx)',fft(sy)); -%! assert(S, answer, 4*M*N*eps('single')); +%! sx = single (cos (m*x)); +%! sy = single (sin (n*y)); +%! s = kron (sx', sy); +%! S = fft2 (s); +%! answer = kron (fft (sx)', fft (sy)); +%! assert (S, answer, 4*M*N*eps ("single")); %% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) %% Comalco Research and Technology %% 02 May 2000 %!test -%! M=12; -%! N=7; +%! M = 12; +%! N = 7; %! -%! m=3; -%! n=2; +%! m = 3; +%! n = 2; %! -%! x = single(2*pi*(0:1:M-1)/M); -%! y = single(2*pi*(0:1:N-1)/N); +%! x = single (2*pi*(0:1:M-1)/M); +%! y = single (2*pi*(0:1:N-1)/N); %! -%! sx = cos(m*x); -%! sy = cos(n*y); +%! sx = cos (m*x); +%! sy = cos (n*y); %! -%! S = kron(fft(sx)',fft(sy)); -%! answer=kron(sx',sy); -%! s = ifft2(S); +%! S = kron (fft (sx)', fft (sy)); +%! answer = kron (sx', sy); +%! s = ifft2 (S); %! -%! assert(s, answer, 30*eps('single')); - +%! assert (s, answer, 30*eps ("single")); */ diff --git a/src/DLD-FUNCTIONS/filter.cc b/src/DLD-FUNCTIONS/filter.cc --- a/src/DLD-FUNCTIONS/filter.cc +++ b/src/DLD-FUNCTIONS/filter.cc @@ -661,73 +661,76 @@ /* %!shared a, b, x, r %!test -%! a = [1 1]; -%! b = [1 1]; -%! x = zeros (1,10); x(1) = 1; -%! assert(filter(b, [1], x ), [1 1 0 0 0 0 0 0 0 0]); -%! assert(filter(b, [1], x.'), [1 1 0 0 0 0 0 0 0 0].'); -%! assert(filter(b.', [1], x ), [1 1 0 0 0 0 0 0 0 0] ); -%! assert(filter(b.', [1], x.'), [1 1 0 0 0 0 0 0 0 0].'); -%! assert(filter([1], a, x ), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1] ); -%! assert(filter([1], a, x.'), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1].'); -%! assert(filter([1], a.', x ), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1] ); -%! assert(filter([1], a.', x.'), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1].'); -%! assert(filter(b, a, x ), [1 0 0 0 0 0 0 0 0 0] ); -%! assert(filter(b.', a, x ), [1 0 0 0 0 0 0 0 0 0] ); -%! assert(filter(b, a.', x ), [1 0 0 0 0 0 0 0 0 0] ); -%! assert(filter(b.', a, x ), [1 0 0 0 0 0 0 0 0 0] ); -%! assert(filter(b, a, x.'), [1 0 0 0 0 0 0 0 0 0].'); -%! assert(filter(b.', a, x.'), [1 0 0 0 0 0 0 0 0 0].'); -%! assert(filter(b, a.', x.'), [1 0 0 0 0 0 0 0 0 0].'); -%! assert(filter(b.', a, x.'), [1 0 0 0 0 0 0 0 0 0].'); -%! +%! a = [1 1]; +%! b = [1 1]; +%! x = zeros (1,10); x(1) = 1; +%! assert (filter (b, [1], x ), [1 1 0 0 0 0 0 0 0 0]); +%! assert (filter (b, [1], x.'), [1 1 0 0 0 0 0 0 0 0].'); +%! assert (filter (b.', [1], x ), [1 1 0 0 0 0 0 0 0 0] ); +%! assert (filter (b.', [1], x.'), [1 1 0 0 0 0 0 0 0 0].'); +%! assert (filter ([1], a, x ), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1] ); +%! assert (filter ([1], a, x.'), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1].'); +%! assert (filter ([1], a.', x ), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1] ); +%! assert (filter ([1], a.', x.'), [+1 -1 +1 -1 +1 -1 +1 -1 +1 -1].'); +%! assert (filter (b, a, x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert (filter (b.', a, x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert (filter (b, a.', x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert (filter (b.', a, x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert (filter (b, a, x.'), [1 0 0 0 0 0 0 0 0 0].'); +%! assert (filter (b.', a, x.'), [1 0 0 0 0 0 0 0 0 0].'); +%! assert (filter (b, a.', x.'), [1 0 0 0 0 0 0 0 0 0].'); +%! assert (filter (b.', a, x.'), [1 0 0 0 0 0 0 0 0 0].'); + %!test -%! r = sqrt(1/2)*(1+i); -%! a = a*r; -%! b = b*r; -%! assert(filter(b, [1], x ), r*[1 1 0 0 0 0 0 0 0 0] ); -%! assert(filter(b, [1], r*x ), r*r*[1 1 0 0 0 0 0 0 0 0] ); -%! assert(filter(b, [1], x.' ), r*[1 1 0 0 0 0 0 0 0 0].' ); -%! assert(filter(b, a, x ), [1 0 0 0 0 0 0 0 0 0] ); -%! assert(filter(b, a, r*x ), r*[1 0 0 0 0 0 0 0 0 0] ); -%! +%! r = sqrt (1/2) * (1+i); +%! a = a*r; +%! b = b*r; +%! assert (filter (b, [1], x ), r*[1 1 0 0 0 0 0 0 0 0] ); +%! assert (filter (b, [1], r*x ), r*r*[1 1 0 0 0 0 0 0 0 0] ); +%! assert (filter (b, [1], x.' ), r*[1 1 0 0 0 0 0 0 0 0].' ); +%! assert (filter (b, a, x ), [1 0 0 0 0 0 0 0 0 0] ); +%! assert (filter (b, a, r*x ), r*[1 0 0 0 0 0 0 0 0 0] ); + %!shared a, b, x, y, so %!test -%! a = [1,1]; b = [1,1]; -%! x = zeros (1,10); x(1) = 1; -%! [y, so] = filter (b, [1], x, [-1]); -%! assert(y, [0 1 0 0 0 0 0 0 0 0]); -%! assert(so,0); -%! +%! a = [1,1]; +%! b = [1,1]; +%! x = zeros (1,10); x(1) = 1; +%! [y, so] = filter (b, [1], x, [-1]); +%! assert (y, [0 1 0 0 0 0 0 0 0 0]); +%! assert (so, 0); + %!test -%! x = zeros (10,3); x(1,1)=-1; x(1,2)=1; -%! y0 = zeros (10,3); y0(1:2,1)=-1; y0(1:2,2)=1; -%! y = filter (b, [1], x); -%! assert(y,y0); -%! +%! x = zeros (10,3); x(1,1) = -1; x(1,2) = 1; +%! y0 = zeros (10,3); y0(1:2,1) = -1; y0(1:2,2) = 1; +%! y = filter (b, [1], x); +%! assert (y, y0); + %!test -%! a = [1,1]; b=[1,1]; -%! x = zeros (4,4,2); x(1,1:4,1) = +1; x(1,1:4,2) = -1; -%! y0 = zeros (4,4,2); y0(1:2,1:4,1) = +1; y0(1:2,1:4,2) = -1; -%! y = filter (b, [1], x); -%! assert(y, y0); -%! -%!assert(filter (1, ones(10,1)/10, []), []); -%!assert(filter (1, ones(10,1)/10, zeros(0,10)), zeros(0,10)); -%!assert(filter (1, ones(10,1)/10, single (1:5)), repmat (single (10), 1, 5)); +%! a = [1,1]; +%! b=[1,1]; +%! x = zeros (4,4,2); x(1,1:4,1) = +1; x(1,1:4,2) = -1; +%! y0 = zeros (4,4,2); y0(1:2,1:4,1) = +1; y0(1:2,1:4,2) = -1; +%! y = filter (b, [1], x); +%! assert (y, y0); + +%!assert (filter (1, ones(10,1)/10, []), []) +%!assert (filter (1, ones(10,1)/10, zeros(0,10)), zeros(0,10)) +%!assert (filter (1, ones(10,1)/10, single (1:5)), repmat (single (10), 1, 5)) + %% Test using initial conditions -%!assert(filter([1, 1, 1], [1, 1], [1 2], [1, 1]), [2 2]); -%!assert(filter([1, 1, 1], [1, 1], [1 2], [1, 1]'), [2 2]); -%!assert(filter([1, 3], [1], [1 2; 3 4; 5 6], [4, 5]), [5 7; 6 10; 14 18]); -%!error (filter([1, 3], [1], [1 2; 3 4; 5 6], [4, 5]')); -%!assert(filter([1, 3, 2], [1], [1 2; 3 4; 5 6], [1 0 0; 1 0 0], 2), [2 6; 3 13; 5 21]); -%% Test of DIM parameter +%!assert (filter ([1, 1, 1], [1, 1], [1 2], [1, 1]), [2 2]) +%!assert (filter ([1, 1, 1], [1, 1], [1 2], [1, 1]'), [2 2]) +%!assert (filter ([1, 3], [1], [1 2; 3 4; 5 6], [4, 5]), [5 7; 6 10; 14 18]) +%!error (filter ([1, 3], [1], [1 2; 3 4; 5 6], [4, 5]')) +%!assert (filter ([1, 3, 2], [1], [1 2; 3 4; 5 6], [1 0 0; 1 0 0], 2), [2 6; 3 13; 5 21]) + +## Test of DIM parameter %!test %! x = ones (2, 1, 3, 4); %! x(1,1,:,:) = [1 2 3 4; 5 6 7 8; 9 10 11 12]; %! y0 = [1 1 6 2 15 3 2 1 8 2 18 3 3 1 10 2 21 3 4 1 12 2 24 3]; %! y0 = reshape (y0, size (x)); -%! y = filter([1 1 1], 1, x, [], 3); +%! y = filter ([1 1 1], 1, x, [], 3); %! assert (y, y0); - */ diff --git a/src/DLD-FUNCTIONS/find.cc b/src/DLD-FUNCTIONS/find.cc --- a/src/DLD-FUNCTIONS/find.cc +++ b/src/DLD-FUNCTIONS/find.cc @@ -570,28 +570,28 @@ } /* -%!assert(find (char ([0, 97])), 2); -%!assert(find ([1, 0, 1, 0, 1]), [1, 3, 5]); -%!assert(find ([1; 0; 3; 0; 1]), [1; 3; 5]); -%!assert(find ([0, 0, 2; 0, 3, 0; -1, 0, 0]), [3; 5; 7]); +%!assert (find (char ([0, 97])), 2) +%!assert (find ([1, 0, 1, 0, 1]), [1, 3, 5]) +%!assert (find ([1; 0; 3; 0; 1]), [1; 3; 5]) +%!assert (find ([0, 0, 2; 0, 3, 0; -1, 0, 0]), [3; 5; 7]) %!test %! [i, j, v] = find ([0, 0, 2; 0, 3, 0; -1, 0, 0]); %! -%! assert(i, [3; 2; 1]); -%! assert(j, [1; 2; 3]); -%! assert(v, [-1; 3; 2]); +%! assert (i, [3; 2; 1]); +%! assert (j, [1; 2; 3]); +%! assert (v, [-1; 3; 2]); -%!assert(find (single([1, 0, 1, 0, 1])), [1, 3, 5]); -%!assert(find (single([1; 0; 3; 0; 1])), [1; 3; 5]); -%!assert(find (single([0, 0, 2; 0, 3, 0; -1, 0, 0])), [3; 5; 7]); +%!assert (find (single ([1, 0, 1, 0, 1])), [1, 3, 5]) +%!assert (find (single ([1; 0; 3; 0; 1])), [1; 3; 5]) +%!assert (find (single ([0, 0, 2; 0, 3, 0; -1, 0, 0])), [3; 5; 7]) %!test -%! [i, j, v] = find (single([0, 0, 2; 0, 3, 0; -1, 0, 0])); +%! [i, j, v] = find (single ([0, 0, 2; 0, 3, 0; -1, 0, 0])); %! -%! assert(i, [3; 2; 1]); -%! assert(j, [1; 2; 3]); -%! assert(v, single([-1; 3; 2])); +%! assert (i, [3; 2; 1]); +%! assert (j, [1; 2; 3]); +%! assert (v, single ([-1; 3; 2])); %!test %! pcol = [5 1 4 3 2]; @@ -617,6 +617,5 @@ %!assert (find ([2 0 1 0 5 0], Inf), [1, 3, 5]) %!assert (find ([2 0 1 0 5 0], Inf, "last"), [1, 3, 5]) -%!error find (); - +%!error find () */ diff --git a/src/DLD-FUNCTIONS/gammainc.cc b/src/DLD-FUNCTIONS/gammainc.cc --- a/src/DLD-FUNCTIONS/gammainc.cc +++ b/src/DLD-FUNCTIONS/gammainc.cc @@ -208,23 +208,23 @@ } /* - %!test %! a = [.5 .5 .5 .5 .5]; %! x = [0 1 2 3 4]; -%! v1 = sqrt(pi)*erf(x)./gamma(a); -%! v3 = gammainc(x.*x,a); -%! assert(v1, v3, sqrt(eps)); +%! v1 = sqrt (pi)*erf (x)./gamma (a); +%! v3 = gammainc (x.*x, a); +%! assert (v1, v3, sqrt (eps)); -%!assert (gammainc(0:4,0.5,"upper"), 1-gammainc(0:4,0.5),1e-10) +%!assert (gammainc (0:4,0.5, "upper"), 1-gammainc (0:4,0.5), 1e-10) %!test %! a = single ([.5 .5 .5 .5 .5]); -%! x = single([0 1 2 3 4]); -%! v1 = sqrt(pi('single'))*erf(x)./gamma(a); -%! v3 = gammainc(x.*x,a); -%! assert(v1, v3, sqrt(eps('single'))); +%! x = single ([0 1 2 3 4]); +%! v1 = sqrt (pi ("single"))*erf (x)./gamma (a); +%! v3 = gammainc (x.*x, a); +%! assert (v1, v3, sqrt (eps ("single"))); -%!assert (gammainc(single(0:4),single(0.5),"upper"), single(1)-gammainc(single(0:4),single(0.5)),single(1e-7)) - +%!assert (gammainc (single (0:4), single (0.5), "upper"), +%! single (1)-gammainc (single (0:4), single (0.5)), +%! single (1e-7)) */ diff --git a/src/DLD-FUNCTIONS/gcd.cc b/src/DLD-FUNCTIONS/gcd.cc --- a/src/DLD-FUNCTIONS/gcd.cc +++ b/src/DLD-FUNCTIONS/gcd.cc @@ -515,16 +515,14 @@ } /* +%!assert (gcd (200, 300, 50, 35), 5) +%!assert (gcd (int16 (200), int16 (300), int16 (50), int16 (35)), int16 (5)) +%!assert (gcd (uint64 (200), uint64 (300), uint64 (50), uint64 (35)), uint64 (5)) +%!assert (gcd (18-i, -29+3i), -3-4i) -%!assert(gcd (200, 300, 50, 35), 5) -%!assert(gcd (int16(200), int16(300), int16(50), int16(35)), int16(5)) -%!assert(gcd (uint64(200), uint64(300), uint64(50), uint64(35)), uint64(5)) -%!assert(gcd (18-i, -29+3i), -3-4i) - -%!error gcd (); +%!error gcd () %!test %! s.a = 1; -%! fail("gcd (s)"); - +%! fail ("gcd (s)"); */ diff --git a/src/DLD-FUNCTIONS/givens.cc b/src/DLD-FUNCTIONS/givens.cc --- a/src/DLD-FUNCTIONS/givens.cc +++ b/src/DLD-FUNCTIONS/givens.cc @@ -205,11 +205,10 @@ } /* +%!assert (givens (1,1), [1, 1; -1, 1] / sqrt (2), 2*eps) +%!assert (givens (1,0), eye (2)) +%!assert (givens (0,1), [0, 1; -1 0]) -%!assert (givens (1,1), [1, 1; -1, 1]/sqrt(2), 2*eps); -%!assert (givens (1,0), eye(2)); -%!assert (givens (0,1), [0, 1; -1 0]); -%!error givens(1); -%!error givens() - +%!error givens () +%!error givens (1) */ diff --git a/src/DLD-FUNCTIONS/hess.cc b/src/DLD-FUNCTIONS/hess.cc --- a/src/DLD-FUNCTIONS/hess.cc +++ b/src/DLD-FUNCTIONS/hess.cc @@ -173,19 +173,17 @@ } /* - %!test %! a = [1, 2, 3; 5, 4, 6; 8, 7, 9]; %! [p, h] = hess (a); -%! assert(p * h * p', a, sqrt(eps)); +%! assert (p * h * p', a, sqrt (eps)); %!test -%! a = single([1, 2, 3; 5, 4, 6; 8, 7, 9]); +%! a = single ([1, 2, 3; 5, 4, 6; 8, 7, 9]); %! [p, h] = hess (a); -%! assert(p * h * p', a, sqrt(eps ('single'))); +%! assert (p * h * p', a, sqrt (eps ("single"))); -%!error hess (); -%!error hess ([1, 2; 3, 4], 2); -%!error hess ([1, 2; 3, 4; 5, 6]); - +%!error hess () +%!error hess ([1, 2; 3, 4], 2) +%!error hess ([1, 2; 3, 4; 5, 6]) */ diff --git a/src/DLD-FUNCTIONS/hex2num.cc b/src/DLD-FUNCTIONS/hex2num.cc --- a/src/DLD-FUNCTIONS/hex2num.cc +++ b/src/DLD-FUNCTIONS/hex2num.cc @@ -119,7 +119,7 @@ } /* -%!assert (hex2num(['c00';'bff';'000';'3ff';'400']),[-2:2]') +%!assert (hex2num (["c00";"bff";"000";"3ff";"400"]), [-2:2]') */ DEFUN_DLD (num2hex, args, , @@ -188,5 +188,5 @@ } /* -%!assert (num2hex (-2:2),['c000000000000000';'bff0000000000000';'0000000000000000';'3ff0000000000000';'4000000000000000']) +%!assert (num2hex (-2:2), ["c000000000000000";"bff0000000000000";"0000000000000000";"3ff0000000000000";"4000000000000000"]) */ diff --git a/src/DLD-FUNCTIONS/inv.cc b/src/DLD-FUNCTIONS/inv.cc --- a/src/DLD-FUNCTIONS/inv.cc +++ b/src/DLD-FUNCTIONS/inv.cc @@ -224,15 +224,13 @@ } /* - -%!assert(inv ([1, 2; 3, 4]), [-2, 1; 1.5, -0.5], sqrt (eps)) -%!assert(inv (single([1, 2; 3, 4])), single([-2, 1; 1.5, -0.5]), sqrt (eps ('single'))) +%!assert (inv ([1, 2; 3, 4]), [-2, 1; 1.5, -0.5], sqrt (eps)) +%!assert (inv (single ([1, 2; 3, 4])), single ([-2, 1; 1.5, -0.5]), sqrt (eps ("single"))) -%!error inv (); -%!error inv ([1, 2; 3, 4], 2); -%!error inv ([1, 2; 3, 4; 5, 6]); - - */ +%!error inv () +%!error inv ([1, 2; 3, 4], 2) +%!error inv ([1, 2; 3, 4; 5, 6]) +*/ // FIXME -- this should really be done with an alias, but // alias_builtin() won't do the right thing if we are actually using diff --git a/src/DLD-FUNCTIONS/kron.cc b/src/DLD-FUNCTIONS/kron.cc --- a/src/DLD-FUNCTIONS/kron.cc +++ b/src/DLD-FUNCTIONS/kron.cc @@ -162,7 +162,6 @@ return c; } - template octave_value do_kron (const octave_value& a, const octave_value& b) @@ -183,12 +182,18 @@ if (b.is_diag_matrix () && a.rows () == a.columns () && b.rows () == b.columns ()) { - octave_value_list tmp; - tmp(0) = a.diag (); - tmp(1) = b.diag (); - tmp = dispatch_kron (tmp, 1); - if (tmp.length () == 1) - retval = tmp(0).diag (); + // We have two diagonal matrices, the product of those will be + // another diagonal matrix. To do that efficiently, extract + // the diagonals as vectors and compute the product. That + // will be another vector, which we then use to construct a + // diagonal matrix object. Note that this will fail if our + // digaonal matrix object is modified to allow the non-zero + // values to be stored off of the principal diagonal (i.e., if + // diag ([1,2], 3) is modified to return a diagonal matrix + // object instead of a full matrix object). + + octave_value tmp = dispatch_kron (a.diag (), b.diag ()); + retval = tmp.diag (); } else if (a.is_single_type () || b.is_single_type ()) { @@ -289,10 +294,9 @@ /* - %!test -%! x = ones(2); -%! assert( kron (x, x), ones (4)); +%! x = ones (2); +%! assert (kron (x, x), ones (4)); %!shared x, y, z %! x = [1, 2]; @@ -302,4 +306,16 @@ %!assert (kron (x, y, z), kron (kron (x, y), z)) %!assert (kron (x, y, z), kron (x, kron (y, z))) +%!assert (kron (diag ([1, 2]), diag ([3, 4])), diag ([3, 4, 6, 8])) + +%% Test for two diag matrices. See the comments above in +%% dispatch_kron for this case. +%% +%!test +%! expected = zeros (16, 16); +%! expected (1, 11) = 3; +%! expected (2, 12) = 4; +%! expected (5, 15) = 6; +%! expected (6, 16) = 8; +%! assert (kron (diag ([1, 2], 2), diag ([3, 4], 2)), expected) */ diff --git a/src/DLD-FUNCTIONS/lookup.cc b/src/DLD-FUNCTIONS/lookup.cc --- a/src/DLD-FUNCTIONS/lookup.cc +++ b/src/DLD-FUNCTIONS/lookup.cc @@ -373,25 +373,25 @@ } /* -%!assert (lookup(1:3, 0.5), 0) # value before table -%!assert (lookup(1:3, 3.5), 3) # value after table error -%!assert (lookup(1:3, 1.5), 1) # value within table error -%!assert (lookup(1:3, [3,2,1]), [3,2,1]) -%!assert (lookup([1:4]', [1.2, 3.5]'), [1, 3]'); -%!assert (lookup([1:4], [1.2, 3.5]'), [1, 3]'); -%!assert (lookup([1:4]', [1.2, 3.5]), [1, 3]); -%!assert (lookup([1:4], [1.2, 3.5]), [1, 3]); -%!assert (lookup(1:3, [3, 2, 1]), [3, 2, 1]); -%!assert (lookup([3:-1:1], [3.5, 3, 1.2, 2.5, 2.5]), [0, 1, 2, 1, 1]) -%!assert (isempty(lookup([1:3], []))) -%!assert (isempty(lookup([1:3]', []))) -%!assert (lookup(1:3, [1, 2; 3, 0.5]), [1, 2; 3, 0]); -%!assert (lookup(1:4, [1, 1.2; 3, 2.5], "m"), [1, 0; 3, 0]); -%!assert (lookup(4:-1:1, [1, 1.2; 3, 2.5], "m"), [4, 0; 2, 0]); -%!assert (lookup(1:4, [1, 1.2; 3, 2.5], "b"), logical ([1, 0; 3, 0])); -%!assert (lookup(4:-1:1, [1, 1.2; 3, 2.5], "b"), logical ([4, 0; 2, 0])); +%!assert (lookup (1:3, 0.5), 0) # value before table +%!assert (lookup (1:3, 3.5), 3) # value after table error +%!assert (lookup (1:3, 1.5), 1) # value within table error +%!assert (lookup (1:3, [3,2,1]), [3,2,1]) +%!assert (lookup ([1:4]', [1.2, 3.5]'), [1, 3]') +%!assert (lookup ([1:4], [1.2, 3.5]'), [1, 3]') +%!assert (lookup ([1:4]', [1.2, 3.5]), [1, 3]) +%!assert (lookup ([1:4], [1.2, 3.5]), [1, 3]) +%!assert (lookup (1:3, [3, 2, 1]), [3, 2, 1]) +%!assert (lookup ([3:-1:1], [3.5, 3, 1.2, 2.5, 2.5]), [0, 1, 2, 1, 1]) +%!assert (isempty (lookup ([1:3], []))) +%!assert (isempty (lookup ([1:3]', []))) +%!assert (lookup (1:3, [1, 2; 3, 0.5]), [1, 2; 3, 0]) +%!assert (lookup (1:4, [1, 1.2; 3, 2.5], "m"), [1, 0; 3, 0]) +%!assert (lookup (4:-1:1, [1, 1.2; 3, 2.5], "m"), [4, 0; 2, 0]) +%!assert (lookup (1:4, [1, 1.2; 3, 2.5], "b"), logical ([1, 0; 3, 0])) +%!assert (lookup (4:-1:1, [1, 1.2; 3, 2.5], "b"), logical ([4, 0; 2, 0])) %! -%!assert (lookup({"apple","lemon","orange"}, {"banana","kiwi"; "ananas","mango"}), [1,1;0,2]) -%!assert (lookup({"apple","lemon","orange"}, "potato"), 3) -%!assert (lookup({"orange","lemon","apple"}, "potato"), 0) +%!assert (lookup ({"apple","lemon","orange"}, {"banana","kiwi"; "ananas","mango"}), [1,1;0,2]) +%!assert (lookup ({"apple","lemon","orange"}, "potato"), 3) +%!assert (lookup ({"orange","lemon","apple"}, "potato"), 0) */ diff --git a/src/DLD-FUNCTIONS/lsode.cc b/src/DLD-FUNCTIONS/lsode.cc --- a/src/DLD-FUNCTIONS/lsode.cc +++ b/src/DLD-FUNCTIONS/lsode.cc @@ -475,25 +475,27 @@ /* -%% dassl-1.m -%% -%% Test lsode() function -%% -%% Author: David Billinghurst (David.Billinghurst@riotinto.com.au) -%% Comalco Research and Technology -%% 20 May 1998 -%% -%% Problem -%% -%% y1' = -y2, y1(0) = 1 -%% y2' = y1, y2(0) = 0 -%% -%% Solution -%% -%% y1(t) = cos(t) -%% y2(t) = sin(t) +## dassl-1.m +## +## Test lsode() function +## +## Author: David Billinghurst (David.Billinghurst@riotinto.com.au) +## Comalco Research and Technology +## 20 May 1998 +## +## Problem +## +## y1' = -y2, y1(0) = 1 +## y2' = y1, y2(0) = 0 +## +## Solution +## +## y1(t) = cos(t) +## y2(t) = sin(t) +## %!function xdot = __f (x, t) %! xdot = [-x(2); x(1)]; +%!endfunction %!test %! %! x0 = [1; 0]; @@ -502,15 +504,15 @@ %! %! tol = 500 * lsode_options ("relative tolerance"); %! -%! %! x = lsode ("__f", x0, t); %! %! y = [cos(t), sin(t)]; %! -%! assert(all (all (abs (x - y) < tol))); +%! assert (x, y, tol); %!function xdotdot = __f (x, t) %! xdotdot = [x(2); -x(1)]; +%!endfunction %!test %! %! x0 = [1; 0]; @@ -521,10 +523,11 @@ %! %! y = [1, 0; 1, 0]; %! -%! assert(all (all (abs (x - y) < tol))); +%! assert (x, y, tol); %!function xdot = __f (x, t) %! xdot = x; +%!endfunction %!test %! %! x0 = 1; @@ -535,12 +538,11 @@ %! %! y = [1; e]; %! -%! assert(all (all (abs (x - y) < tol))); +%! assert (x, y, tol); %!test %! lsode_options ("absolute tolerance", eps); -%! assert(lsode_options ("absolute tolerance") == eps); +%! assert (lsode_options ("absolute tolerance") == eps); -%!error lsode_options ("foo", 1, 2); - +%!error lsode_options ("foo", 1, 2) */ diff --git a/src/DLD-FUNCTIONS/lu.cc b/src/DLD-FUNCTIONS/lu.cc --- a/src/DLD-FUNCTIONS/lu.cc +++ b/src/DLD-FUNCTIONS/lu.cc @@ -529,61 +529,59 @@ } /* - %!assert(lu ([1, 2; 3, 4]), [3, 4; 1/3, 2/3], eps); %!test %! [l, u] = lu ([1, 2; 3, 4]); -%! assert(l, [1/3, 1; 1, 0], sqrt (eps)); -%! assert(u, [3, 4; 0, 2/3], sqrt (eps)); +%! assert (l, [1/3, 1; 1, 0], sqrt (eps)); +%! assert (u, [3, 4; 0, 2/3], sqrt (eps)); %!test %! [l, u, p] = lu ([1, 2; 3, 4]); -%! assert(l, [1, 0; 1/3, 1], sqrt (eps)); -%! assert(u, [3, 4; 0, 2/3], sqrt (eps)); -%! assert(p(:,:), [0, 1; 1, 0], sqrt (eps)); +%! assert (l, [1, 0; 1/3, 1], sqrt (eps)); +%! assert (u, [3, 4; 0, 2/3], sqrt (eps)); +%! assert (p(:,:), [0, 1; 1, 0], sqrt (eps)); %!test -%! [l, u, p] = lu ([1, 2; 3, 4],'vector'); -%! assert(l, [1, 0; 1/3, 1], sqrt (eps)); -%! assert(u, [3, 4; 0, 2/3], sqrt (eps)); -%! assert(p, [2;1], sqrt (eps)); +%! [l, u, p] = lu ([1, 2; 3, 4], "vector"); +%! assert (l, [1, 0; 1/3, 1], sqrt (eps)); +%! assert (u, [3, 4; 0, 2/3], sqrt (eps)); +%! assert (p, [2;1], sqrt (eps)); %!test -%! [l u p] = lu ([1, 2; 3, 4; 5, 6]); -%! assert(l, [1, 0; 1/5, 1; 3/5, 1/2], sqrt (eps)); -%! assert(u, [5, 6; 0, 4/5], sqrt (eps)); -%! assert(p(:,:), [0, 0, 1; 1, 0, 0; 0 1 0], sqrt (eps)); +%! [l, u, p] = lu ([1, 2; 3, 4; 5, 6]); +%! assert (l, [1, 0; 1/5, 1; 3/5, 1/2], sqrt (eps)); +%! assert (u, [5, 6; 0, 4/5], sqrt (eps)); +%! assert (p(:,:), [0, 0, 1; 1, 0, 0; 0 1 0], sqrt (eps)); -%!assert(lu (single([1, 2; 3, 4])), single([3, 4; 1/3, 2/3]), eps('single')); +%!assert (lu (single ([1, 2; 3, 4])), single ([3, 4; 1/3, 2/3]), eps ("single")) %!test -%! [l, u] = lu (single([1, 2; 3, 4])); -%! assert(l, single([1/3, 1; 1, 0]), sqrt (eps('single'))); -%! assert(u, single([3, 4; 0, 2/3]), sqrt (eps('single'))); +%! [l, u] = lu (single ([1, 2; 3, 4])); +%! assert (l, single ([1/3, 1; 1, 0]), sqrt (eps ("single"))); +%! assert (u, single ([3, 4; 0, 2/3]), sqrt (eps ("single"))); %!test -%! [l, u, p] = lu (single([1, 2; 3, 4])); -%! assert(l, single([1, 0; 1/3, 1]), sqrt (eps('single'))); -%! assert(u, single([3, 4; 0, 2/3]), sqrt (eps('single'))); -%! assert(p(:,:), single([0, 1; 1, 0]), sqrt (eps('single'))); +%! [l, u, p] = lu (single ([1, 2; 3, 4])); +%! assert (l, single ([1, 0; 1/3, 1]), sqrt (eps ("single"))); +%! assert (u, single ([3, 4; 0, 2/3]), sqrt (eps ("single"))); +%! assert (p(:,:), single ([0, 1; 1, 0]), sqrt (eps ("single"))); %!test -%! [l, u, p] = lu (single([1, 2; 3, 4]),'vector'); -%! assert(l, single([1, 0; 1/3, 1]), sqrt (eps('single'))); -%! assert(u, single([3, 4; 0, 2/3]), sqrt (eps('single'))); -%! assert(p, single([2;1]), sqrt (eps('single'))); +%! [l, u, p] = lu (single ([1, 2; 3, 4]), "vector"); +%! assert (l, single ([1, 0; 1/3, 1]), sqrt (eps ("single"))); +%! assert (u, single ([3, 4; 0, 2/3]), sqrt (eps ("single"))); +%! assert (p, single ([2;1]), sqrt (eps ("single"))); %!test -%! [l u p] = lu (single([1, 2; 3, 4; 5, 6])); -%! assert(l, single([1, 0; 1/5, 1; 3/5, 1/2]), sqrt (eps('single'))); -%! assert(u, single([5, 6; 0, 4/5]), sqrt (eps('single'))); -%! assert(p(:,:), single([0, 0, 1; 1, 0, 0; 0 1 0]), sqrt (eps('single'))); +%! [l u p] = lu (single ([1, 2; 3, 4; 5, 6])); +%! assert (l, single ([1, 0; 1/5, 1; 3/5, 1/2]), sqrt (eps ("single"))); +%! assert (u, single ([5, 6; 0, 4/5]), sqrt (eps ("single"))); +%! assert (p(:,:), single ([0, 0, 1; 1, 0, 0; 0 1 0]), sqrt (eps ("single"))); -%!error lu (); -%!error lu ([1, 2; 3, 4], 2); - - */ +%!error lu () +%!error lu ([1, 2; 3, 4], 2) +*/ static bool check_lu_dims (const octave_value& l, const octave_value& u, @@ -785,75 +783,75 @@ %! 0.43167 ]; %! %! Ac = [0.620405 + 0.956953i 0.480013 + 0.048806i 0.402627 + 0.338171i; -%! 0.589077 + 0.658457i 0.013205 + 0.279323i 0.229284 + 0.721929i; -%! 0.092758 + 0.345687i 0.928679 + 0.241052i 0.764536 + 0.832406i; -%! 0.912098 + 0.721024i 0.049018 + 0.269452i 0.730029 + 0.796517i; -%! 0.112849 + 0.603871i 0.486352 + 0.142337i 0.355646 + 0.151496i ]; +%! 0.589077 + 0.658457i 0.013205 + 0.279323i 0.229284 + 0.721929i; +%! 0.092758 + 0.345687i 0.928679 + 0.241052i 0.764536 + 0.832406i; +%! 0.912098 + 0.721024i 0.049018 + 0.269452i 0.730029 + 0.796517i; +%! 0.112849 + 0.603871i 0.486352 + 0.142337i 0.355646 + 0.151496i ]; %! %! uc = [0.20351 + 0.05401i; -%! 0.13141 + 0.43708i; -%! 0.29808 + 0.08789i; -%! 0.69821 + 0.38844i; -%! 0.74871 + 0.25821i ]; +%! 0.13141 + 0.43708i; +%! 0.29808 + 0.08789i; +%! 0.69821 + 0.38844i; +%! 0.74871 + 0.25821i ]; %! %! vc = [0.85839 + 0.29468i; -%! 0.20820 + 0.93090i; -%! 0.86184 + 0.34689i ]; +%! 0.20820 + 0.93090i; +%! 0.86184 + 0.34689i ]; %! %!testif HAVE_QRUPDATE_LUU -%! [L,U,P] = lu(A); -%! [L,U] = luupdate(L,U,P*u,v); -%! assert(norm(vec(tril(L)-L),Inf) == 0) -%! assert(norm(vec(triu(U)-U),Inf) == 0) -%! assert(norm(vec(P'*L*U - A - u*v.'),Inf) < norm(A)*1e1*eps) +%! [L,U,P] = lu (A); +%! [L,U] = luupdate (L,U,P*u,v); +%! assert (norm (vec (tril (L)-L), Inf) == 0); +%! assert (norm (vec (triu (U)-U), Inf) == 0); +%! assert (norm (vec (P'*L*U - A - u*v.'), Inf) < norm (A)*1e1*eps); %! %!testif HAVE_QRUPDATE_LUU -%! [L,U,P] = lu(Ac); -%! [L,U] = luupdate(L,U,P*uc,vc); -%! assert(norm(vec(tril(L)-L),Inf) == 0) -%! assert(norm(vec(triu(U)-U),Inf) == 0) -%! assert(norm(vec(P'*L*U - Ac - uc*vc.'),Inf) < norm(Ac)*1e1*eps) +%! [L,U,P] = lu (Ac); +%! [L,U] = luupdate (L,U,P*uc,vc); +%! assert (norm (vec (tril (L)-L), Inf) == 0); +%! assert (norm (vec (triu (U)-U), Inf) == 0); +%! assert (norm (vec (P'*L*U - Ac - uc*vc.'), Inf) < norm (Ac)*1e1*eps); %!testif HAVE_QRUPDATE_LUU -%! [L,U,P] = lu(single(A)); -%! [L,U] = luupdate(L,U,P*single(u),single(v)); -%! assert(norm(vec(tril(L)-L),Inf) == 0) -%! assert(norm(vec(triu(U)-U),Inf) == 0) -%! assert(norm(vec(P'*L*U - single(A) - single(u)*single(v).'),Inf) < norm(single(A))*1e1*eps('single')) +%! [L,U,P] = lu (single (A)); +%! [L,U] = luupdate (L,U,P*single (u), single (v)); +%! assert (norm (vec (tril (L)-L), Inf) == 0); +%! assert (norm (vec (triu (U)-U), Inf) == 0); +%! assert (norm (vec (P'*L*U - single (A) - single (u)*single (v).'), Inf) < norm (single (A))*1e1*eps ("single")); %! %!testif HAVE_QRUPDATE_LUU -%! [L,U,P] = lu(single(Ac)); -%! [L,U] = luupdate(L,U,P*single(uc),single(vc)); -%! assert(norm(vec(tril(L)-L),Inf) == 0) -%! assert(norm(vec(triu(U)-U),Inf) == 0) -%! assert(norm(vec(P'*L*U - single(Ac) - single(uc)*single(vc).'),Inf) < norm(single(Ac))*1e1*eps('single')) +%! [L,U,P] = lu (single (Ac)); +%! [L,U] = luupdate (L,U,P*single (uc),single (vc)); +%! assert (norm (vec (tril (L)-L), Inf) == 0); +%! assert (norm (vec (triu (U)-U), Inf) == 0); +%! assert (norm (vec (P'*L*U - single (Ac) - single (uc)*single (vc).'), Inf) < norm (single (Ac))*1e1*eps ("single")); %!testif HAVE_QRUPDATE_LUU -%! [L,U,P] = lu(A); -%! [L,U,P] = luupdate(L,U,P,u,v); -%! assert(norm(vec(tril(L)-L),Inf) == 0) -%! assert(norm(vec(triu(U)-U),Inf) == 0) -%! assert(norm(vec(P'*L*U - A - u*v.'),Inf) < norm(A)*1e1*eps) +%! [L,U,P] = lu (A); +%! [L,U,P] = luupdate (L,U,P,u,v); +%! assert (norm (vec (tril (L)-L), Inf) == 0); +%! assert (norm (vec (triu (U)-U), Inf) == 0); +%! assert (norm (vec (P'*L*U - A - u*v.'), Inf) < norm (A)*1e1*eps); %! %!testif HAVE_QRUPDATE_LUU -%! [L,U,P] = lu(Ac); -%! [L,U,P] = luupdate(L,U,P,uc,vc); -%! assert(norm(vec(tril(L)-L),Inf) == 0) -%! assert(norm(vec(triu(U)-U),Inf) == 0) -%! assert(norm(vec(P'*L*U - Ac - uc*vc.'),Inf) < norm(Ac)*1e1*eps) +%! [L,U,P] = lu (Ac); +%! [L,U,P] = luupdate (L,U,P,uc,vc); +%! assert (norm (vec (tril (L)-L), Inf) == 0); +%! assert (norm (vec (triu (U)-U), Inf) == 0); +%! assert (norm (vec (P'*L*U - Ac - uc*vc.'), Inf) < norm (Ac)*1e1*eps); %!testif HAVE_QRUPDATE_LUU -%! [L,U,P] = lu(single(A)); -%! [L,U,P] = luupdate(L,U,P,single(u),single(v)); -%! assert(norm(vec(tril(L)-L),Inf) == 0) -%! assert(norm(vec(triu(U)-U),Inf) == 0) -%! assert(norm(vec(P'*L*U - single(A) - single(u)*single(v).'),Inf) < norm(single(A))*1e1*eps('single')) +%! [L,U,P] = lu (single (A)); +%! [L,U,P] = luupdate (L,U,P,single (u),single (v)); +%! assert (norm (vec (tril (L)-L), Inf) == 0); +%! assert (norm (vec (triu (U)-U), Inf) == 0); +%! assert (norm (vec (P'*L*U - single (A) - single (u)*single (v).'), Inf) < norm (single (A))*1e1*eps ("single")); %! %!testif HAVE_QRUPDATE_LUU -%! [L,U,P] = lu(single(Ac)); -%! [L,U,P] = luupdate(L,U,P,single(uc),single(vc)); -%! assert(norm(vec(tril(L)-L),Inf) == 0) -%! assert(norm(vec(triu(U)-U),Inf) == 0) -%! assert(norm(vec(P'*L*U - single(Ac) - single(uc)*single(vc).'),Inf) < norm(single(Ac))*1e1*eps('single')) +%! [L,U,P] = lu (single (Ac)); +%! [L,U,P] = luupdate (L,U,P,single (uc),single (vc)); +%! assert (norm (vec (tril (L)-L), Inf) == 0); +%! assert (norm (vec (triu (U)-U), Inf) == 0); +%! assert (norm (vec (P'*L*U - single (Ac) - single (uc)*single (vc).'), Inf) < norm (single (Ac))*1e1*eps ("single")); */ diff --git a/src/DLD-FUNCTIONS/luinc.cc b/src/DLD-FUNCTIONS/luinc.cc --- a/src/DLD-FUNCTIONS/luinc.cc +++ b/src/DLD-FUNCTIONS/luinc.cc @@ -365,21 +365,19 @@ } /* +%!testif HAVE_UMFPACK +%! a = sparse ([1,2,0,0;0,1,2,0;1e-14,0,3,0;0,0,0,1]); +%! [l,u] = luinc (a, 1e-10); +%! assert (l*u, sparse ([1,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]), 1e-10); +%! opts.droptol = 1e-10; +%! [l,u] = luinc (a, opts); +%! assert (l*u, sparse ([1,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]), 1e-10); %!testif HAVE_UMFPACK -%! a=sparse([1,2,0,0;0,1,2,0;1e-14,0,3,0;0,0,0,1]); -%! [l,u]=luinc(a,1e-10); -%! assert(l*u, sparse([1,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]),1e-10); -%! opts.droptol=1e-10; -%! [l,u]=luinc(a,opts); -%! assert(l*u, sparse([1,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]),1e-10); - -%!testif HAVE_UMFPACK -%! a=sparse([1i,2,0,0;0,1,2,0;1e-14,0,3,0;0,0,0,1]); -%! [l,u]=luinc(a,1e-10); -%! assert(l*u, sparse([1i,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]),1e-10); -%! opts.droptol=1e-10; -%! [l,u]=luinc(a,opts); -%! assert(l*u, sparse([1i,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]),1e-10); - +%! a = sparse ([1i,2,0,0;0,1,2,0;1e-14,0,3,0;0,0,0,1]); +%! [l,u] = luinc (a, 1e-10); +%! assert (l*u, sparse ([1i,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]), 1e-10); +%! opts.droptol = 1e-10; +%! [l,u] = luinc (a, opts); +%! assert (l*u, sparse ([1i,2,0,0;0,1,2,0;0,0,3,0;0,0,0,1]), 1e-10); */ diff --git a/src/DLD-FUNCTIONS/matrix_type.cc b/src/DLD-FUNCTIONS/matrix_type.cc --- a/src/DLD-FUNCTIONS/matrix_type.cc +++ b/src/DLD-FUNCTIONS/matrix_type.cc @@ -508,110 +508,114 @@ } /* - -## FIXME +## FIXME: ## Disable tests for lower under-determined and upper over-determined ## matrices as this detection is disabled in MatrixType due to issues ## of non minimum norm solution being found. -%!assert(matrix_type(speye(10,10)),"Diagonal"); -%!assert(matrix_type(speye(10,10)([2:10,1],:)),"Permuted Diagonal"); -%!assert(matrix_type([[speye(10,10);sparse(1,10)],[1;sparse(9,1);1]]),"Upper"); -%!assert(matrix_type([[speye(10,10);sparse(1,10)],[1;sparse(9,1);1]](:,[2,1,3:11])),"Permuted Upper"); -%!assert(matrix_type([speye(10,10),sparse(10,1);1,sparse(1,9),1]),"Lower"); -%!assert(matrix_type([speye(10,10),sparse(10,1);1,sparse(1,9),1]([2,1,3:11],:)),"Permuted Lower"); -%!test -%! bnd=spparms("bandden"); -%! spparms("bandden",0.5); -%! a = spdiags(rand(10,3)-0.5,[-1,0,1],10,10); -%! assert(matrix_type(a),"Tridiagonal"); -%! assert(matrix_type(a'+a+2*speye(10)),"Tridiagonal Positive Definite"); -%! spparms("bandden",bnd); -%!test -%! bnd=spparms("bandden"); -%! spparms("bandden",0.5); -%! a = spdiags(randn(10,4),[-2:1],10,10); -%! assert(matrix_type(a),"Banded"); -%! assert(matrix_type(a'*a),"Banded Positive Definite"); -%! spparms("bandden",bnd); -%!test -%! a=[speye(10,10),[sparse(9,1);1];-1,sparse(1,9),1]; -%! assert(matrix_type(a),"Full"); -%! assert(matrix_type(a'*a),"Positive Definite"); -%!assert(matrix_type(speye(10,11)),"Diagonal"); -%!assert(matrix_type(speye(10,11)([2:10,1],:)),"Permuted Diagonal"); -%!assert(matrix_type(speye(11,10)),"Diagonal"); -%!assert(matrix_type(speye(11,10)([2:11,1],:)),"Permuted Diagonal"); -%#!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1,1];sparse(9,2);[1,1]]]),"Upper"); -%#!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1,1];sparse(9,2);[1,1]]](:,[2,1,3:12])),"Permuted Upper"); -%!assert(matrix_type([speye(11,9),[1;sparse(8,1);1;0]]),"Upper"); -%!assert(matrix_type([speye(11,9),[1;sparse(8,1);1;0]](:,[2,1,3:10])),"Permuted Upper"); -%#!assert(matrix_type([speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]),"Lower"); -%#!assert(matrix_type([speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]([2,1,3:12],:)),"Permuted Lower"); -%!assert(matrix_type([speye(9,11);[1,sparse(1,8),1,0]]),"Lower"); -%!assert(matrix_type([speye(9,11);[1,sparse(1,8),1,0]]([2,1,3:10],:)),"Permuted Lower"); -%!assert(matrix_type(spdiags(randn(10,4),[-2:1],10,9)),"Rectangular") +%!assert (matrix_type (speye (10,10)), "Diagonal") +%!assert (matrix_type (speye (10,10)([2:10,1],:)), "Permuted Diagonal") +%!assert (matrix_type ([[speye(10,10);sparse(1,10)],[1;sparse(9,1);1]]), "Upper") +%!assert (matrix_type ([[speye(10,10);sparse(1,10)],[1;sparse(9,1);1]](:,[2,1,3:11])), "Permuted Upper") +%!assert (matrix_type ([speye(10,10),sparse(10,1);1,sparse(1,9),1]), "Lower") +%!assert (matrix_type ([speye(10,10),sparse(10,1);1,sparse(1,9),1]([2,1,3:11],:)), "Permuted Lower") -%!assert(matrix_type(1i*speye(10,10)),"Diagonal"); -%!assert(matrix_type(1i*speye(10,10)([2:10,1],:)),"Permuted Diagonal"); -%!assert(matrix_type([[speye(10,10);sparse(1,10)],[1i;sparse(9,1);1]]),"Upper"); -%!assert(matrix_type([[speye(10,10);sparse(1,10)],[1i;sparse(9,1);1]](:,[2,1,3:11])),"Permuted Upper"); -%!assert(matrix_type([speye(10,10),sparse(10,1);1i,sparse(1,9),1]),"Lower"); -%!assert(matrix_type([speye(10,10),sparse(10,1);1i,sparse(1,9),1]([2,1,3:11],:)),"Permuted Lower"); %!test -%! bnd=spparms("bandden"); -%! spparms("bandden",0.5); -%! assert(matrix_type(spdiags(1i*randn(10,3),[-1,0,1],10,10)),"Tridiagonal"); -%! a = 1i*(rand(9,1)-0.5);a=[[a;0],ones(10,1),[0;-a]]; -%! assert(matrix_type(spdiags(a,[-1,0,1],10,10)),"Tridiagonal Positive Definite"); -%! spparms("bandden",bnd); +%! bnd = spparms ("bandden"); +%! spparms ("bandden", 0.5); +%! a = spdiags (rand (10,3)-0.5,[-1,0,1],10,10); +%! assert (matrix_type (a), "Tridiagonal"); +%! assert (matrix_type (a'+a+2*speye (10)), "Tridiagonal Positive Definite"); +%! spparms ("bandden", bnd); +%!test +%! bnd=spparms ("bandden"); +%! spparms ("bandden", 0.5); +%! a = spdiags (randn (10,4),[-2:1],10,10); +%! assert (matrix_type (a), "Banded"); +%! assert (matrix_type (a'*a), "Banded Positive Definite"); +%! spparms ("bandden", bnd); %!test -%! bnd=spparms("bandden"); -%! spparms("bandden",0.5); -%! assert(matrix_type(spdiags(1i*randn(10,4),[-2:1],10,10)),"Banded"); -%! a = 1i*(rand(9,2)-0.5);a=[[a;[0,0]],ones(10,1),[[0;-a(:,2)],[0;0;-a(1:8,1)]]]; -%! assert(matrix_type(spdiags(a,[-2:2],10,10)),"Banded Positive Definite"); -%! spparms("bandden",bnd); -%!test -%! a=[speye(10,10),[sparse(9,1);1i];-1,sparse(1,9),1]; -%! assert(matrix_type(a),"Full"); -%! assert(matrix_type(a'*a),"Positive Definite"); -%!assert(matrix_type(1i*speye(10,11)),"Diagonal"); -%!assert(matrix_type(1i*speye(10,11)([2:10,1],:)),"Permuted Diagonal"); -%!assert(matrix_type(1i*speye(11,10)),"Diagonal"); -%!assert(matrix_type(1i*speye(11,10)([2:11,1],:)),"Permuted Diagonal"); -%#!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1i,1i];sparse(9,2);[1i,1i]]]),"Upper"); -%#!assert(matrix_type([[speye(10,10);sparse(1,10)],[[1i,1i];sparse(9,2);[1i,1i]]](:,[2,1,3:12])),"Permuted Upper"); -%!assert(matrix_type([speye(11,9),[1i;sparse(8,1);1i;0]]),"Upper"); -%!assert(matrix_type([speye(11,9),[1i;sparse(8,1);1i;0]](:,[2,1,3:10])),"Permuted Upper"); -%#!assert(matrix_type([speye(10,10),sparse(10,1);[1i;1i],sparse(2,9),[1i;1i]]),"Lower"); -%#!assert(matrix_type([speye(10,10),sparse(10,1);[1i;1i],sparse(2,9),[1i;1i]]([2,1,3:12],:)),"Permuted Lower"); -%!assert(matrix_type([speye(9,11);[1i,sparse(1,8),1i,0]]),"Lower"); -%!assert(matrix_type([speye(9,11);[1i,sparse(1,8),1i,0]]([2,1,3:10],:)),"Permuted Lower"); -%!assert(matrix_type(1i*spdiags(randn(10,4),[-2:1],10,9)),"Rectangular") +%! a = [speye(10,10),[sparse(9,1);1];-1,sparse(1,9),1]; +%! assert (matrix_type (a), "Full"); +%! assert (matrix_type (a'*a), "Positive Definite"); + +%!assert (matrix_type (speye (10,11)), "Diagonal") +%!assert (matrix_type (speye (10,11)([2:10,1],:)), "Permuted Diagonal") +%!assert (matrix_type (speye (11,10)), "Diagonal") +%!assert (matrix_type (speye (11,10)([2:11,1],:)), "Permuted Diagonal") +%#!assert (matrix_type ([[speye(10,10);sparse(1,10)],[[1,1];sparse(9,2);[1,1]]]), "Upper") +%#!assert (matrix_type ([[speye(10,10);sparse(1,10)],[[1,1];sparse(9,2);[1,1]]](:,[2,1,3:12])), "Permuted Upper") +%!assert (matrix_type ([speye(11,9),[1;sparse(8,1);1;0]]), "Upper") +%!assert (matrix_type ([speye(11,9),[1;sparse(8,1);1;0]](:,[2,1,3:10])), "Permuted Upper") +%#!assert (matrix_type ([speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]), "Lower") +%#!assert (matrix_type ([speye(10,10),sparse(10,1);[1;1],sparse(2,9),[1;1]]([2,1,3:12],:)), "Permuted Lower") +%!assert (matrix_type ([speye(9,11);[1,sparse(1,8),1,0]]), "Lower") +%!assert (matrix_type ([speye(9,11);[1,sparse(1,8),1,0]]([2,1,3:10],:)), "Permuted Lower") +%!assert (matrix_type (spdiags (randn (10,4),[-2:1],10,9)), "Rectangular") + +%!assert (matrix_type (1i*speye (10,10)), "Diagonal") +%!assert (matrix_type (1i*speye (10,10)([2:10,1],:)), "Permuted Diagonal") +%!assert (matrix_type ([[speye(10,10);sparse(1,10)],[1i;sparse(9,1);1]]), "Upper") +%!assert (matrix_type ([[speye(10,10);sparse(1,10)],[1i;sparse(9,1);1]](:,[2,1,3:11])), "Permuted Upper") +%!assert (matrix_type ([speye(10,10),sparse(10,1);1i,sparse(1,9),1]), "Lower") +%!assert (matrix_type ([speye(10,10),sparse(10,1);1i,sparse(1,9),1]([2,1,3:11],:)), "Permuted Lower") %!test -%! a = matrix_type(spdiags(randn(10,3),[-1,0,1],10,10),"Singular"); -%! assert(matrix_type(a),"Singular"); - -%!assert(matrix_type(triu(ones(10,10))),"Upper"); -%!assert(matrix_type(triu(ones(10,10),-1)),"Full"); -%!assert(matrix_type(tril(ones(10,10))),"Lower"); -%!assert(matrix_type(tril(ones(10,10),1)),"Full"); -%!assert(matrix_type(10*eye(10,10) + ones(10,10)), "Positive Definite"); -%!assert(matrix_type(ones(11,10)),"Rectangular") +%! bnd = spparms ("bandden"); +%! spparms ("bandden", 0.5); +%! assert (matrix_type (spdiags (1i*randn (10,3),[-1,0,1],10,10)), "Tridiagonal"); +%! a = 1i*(rand (9,1)-0.5); +%! a = [[a;0],ones(10,1),[0;-a]]; +%! assert (matrix_type (spdiags (a,[-1,0,1],10,10)), "Tridiagonal Positive Definite"); +%! spparms ("bandden", bnd); +%!test +%! bnd = spparms ("bandden"); +%! spparms ("bandden", 0.5); +%! assert (matrix_type (spdiags (1i*randn (10,4),[-2:1],10,10)), "Banded"); +%! a = 1i*(rand (9,2)-0.5); +%! a = [[a;[0,0]],ones(10,1),[[0;-a(:,2)],[0;0;-a(1:8,1)]]]; +%! assert (matrix_type (spdiags (a,[-2:2],10,10)), "Banded Positive Definite"); +%! spparms ("bandden", bnd); %!test -%! a = matrix_type(ones(10,10),"Singular"); -%! assert(matrix_type(a),"Singular"); +%! a = [speye(10,10),[sparse(9,1);1i];-1,sparse(1,9),1]; +%! assert (matrix_type (a), "Full"); +%! assert (matrix_type (a'*a), "Positive Definite"); + +%!assert (matrix_type (1i*speye (10,11)), "Diagonal") +%!assert (matrix_type (1i*speye (10,11)([2:10,1],:)), "Permuted Diagonal") +%!assert (matrix_type (1i*speye (11,10)), "Diagonal") +%!assert (matrix_type (1i*speye (11,10)([2:11,1],:)), "Permuted Diagonal") +%#!assert (matrix_type ([[speye(10,10);sparse(1,10)],[[1i,1i];sparse(9,2);[1i,1i]]]), "Upper") +%#!assert (matrix_type ([[speye(10,10);sparse(1,10)],[[1i,1i];sparse(9,2);[1i,1i]]](:,[2,1,3:12])), "Permuted Upper") +%!assert (matrix_type ([speye(11,9),[1i;sparse(8,1);1i;0]]), "Upper") +%!assert (matrix_type ([speye(11,9),[1i;sparse(8,1);1i;0]](:,[2,1,3:10])), "Permuted Upper") +%#!assert (matrix_type ([speye(10,10),sparse(10,1);[1i;1i],sparse(2,9),[1i;1i]]), "Lower") +%#!assert (matrix_type ([speye(10,10),sparse(10,1);[1i;1i],sparse(2,9),[1i;1i]]([2,1,3:12],:)), "Permuted Lower") +%!assert (matrix_type ([speye(9,11);[1i,sparse(1,8),1i,0]]), "Lower") +%!assert (matrix_type ([speye(9,11);[1i,sparse(1,8),1i,0]]([2,1,3:10],:)), "Permuted Lower") +%!assert (matrix_type (1i*spdiags(randn(10,4),[-2:1],10,9)), "Rectangular") -%!assert(matrix_type(triu(1i*ones(10,10))),"Upper"); -%!assert(matrix_type(triu(1i*ones(10,10),-1)),"Full"); -%!assert(matrix_type(tril(1i*ones(10,10))),"Lower"); -%!assert(matrix_type(tril(1i*ones(10,10),1)),"Full"); -%!assert(matrix_type(10*eye(10,10) + 1i*triu(ones(10,10),1) -1i*tril(ones(10,10),-1)), "Positive Definite"); -%!assert(matrix_type(ones(11,10)),"Rectangular") +%!test +%! a = matrix_type (spdiags (randn (10,3),[-1,0,1],10,10), "Singular"); +%! assert (matrix_type (a), "Singular"); + +%!assert (matrix_type (triu (ones(10,10))), "Upper") +%!assert (matrix_type (triu (ones(10,10),-1)), "Full") +%!assert (matrix_type (tril (ones(10,10))), "Lower") +%!assert (matrix_type (tril (ones(10,10),1)), "Full") +%!assert (matrix_type (10*eye (10,10) + ones (10,10)), "Positive Definite") +%!assert (matrix_type (ones (11,10)), "Rectangular") %!test -%! a = matrix_type(ones(10,10),"Singular"); -%! assert(matrix_type(a),"Singular"); +%! a = matrix_type (ones (10,10), "Singular"); +%! assert (matrix_type (a), "Singular"); +%!assert (matrix_type (triu (1i*ones (10,10))), "Upper") +%!assert (matrix_type (triu (1i*ones (10,10),-1)), "Full") +%!assert (matrix_type (tril (1i*ones (10,10))), "Lower") +%!assert (matrix_type (tril (1i*ones (10,10),1)), "Full") +%!assert (matrix_type (10*eye (10,10) + 1i*triu (ones (10,10),1) -1i*tril (ones (10,10),-1)), "Positive Definite") +%!assert (matrix_type (ones (11,10)), "Rectangular") +%!test +%! a = matrix_type (ones (10,10), "Singular"); +%! assert (matrix_type (a), "Singular"); */ diff --git a/src/DLD-FUNCTIONS/max.cc b/src/DLD-FUNCTIONS/max.cc --- a/src/DLD-FUNCTIONS/max.cc +++ b/src/DLD-FUNCTIONS/max.cc @@ -358,30 +358,22 @@ } /* - -%% test/octave.test/arith/min-1.m -%!assert (min ([1, 4, 2, 3]) == 1); -%!assert (min ([1; -10; 5; -2]) == -10); - -%% test/octave.test/arith/min-2.m -%!assert(all (min ([4, i; -2, 2]) == [-2, i])); - -%% test/octave.test/arith/min-3.m -%!error min (); - -%% test/octave.test/arith/min-4.m -%!error min (1, 2, 3, 4); +%!assert (min ([1, 4, 2, 3]), 1) +%!assert (min ([1; -10; 5; -2]), -10) +%!assert (min ([4, i; -2, 2]), [-2, i]) %!test -%! x = reshape (1:8,[2,2,2]); -%! assert (max (x,[],1), reshape ([2, 4, 6, 8], [1,2,2])); -%! assert (max (x,[],2), reshape ([3, 4, 7, 8], [2,1,2])); -%! [y, i ] = max (x, [], 3); +%! x = reshape (1:8, [2,2,2]); +%! assert (max (x, [], 1), reshape ([2, 4, 6, 8], [1,2,2])); +%! assert (max (x, [], 2), reshape ([3, 4, 7, 8], [2,1,2])); +%! [y, i] = max (x, [], 3); +%! assert (ndims (y), 2); %! assert (y, [5, 7; 6, 8]); -%! assert (ndims(y), 2); +%! assert (ndims (i), 2); %! assert (i, [2, 2; 2, 2]); -%! assert (ndims(i), 2); +%!error min () +%!error min (1, 2, 3, 4) */ DEFUN_DLD (max, args, nargout, @@ -437,31 +429,22 @@ } /* - -%% test/octave.test/arith/max-1.m -%!assert (max ([1, 4, 2, 3]) == 4); -%!assert (max ([1; -10; 5; -2]) == 5); - -%% test/octave.test/arith/max-2.m -%!assert(all (max ([4, i 4.999; -2, 2, 3+4i]) == [4, 2, 3+4i])); - -%% test/octave.test/arith/max-3.m -%!error max (); - -%% test/octave.test/arith/max-4.m -%!error max (1, 2, 3, 4); +%!assert (max ([1, 4, 2, 3]), 4) +%!assert (max ([1; -10; 5; -2]), 5) +%!assert (max ([4, i 4.999; -2, 2, 3+4i]), [4, 2, 3+4i]) %!test -%! x = reshape (1:8,[2,2,2]); -%! assert (min (x,[],1), reshape ([1, 3, 5, 7], [1,2,2])); -%! assert (min (x,[],2), reshape ([1, 2, 5, 6], [2,1,2])); -%! [y, i ] = min (x, [], 3); +%! x = reshape (1:8, [2,2,2]); +%! assert (min (x, [], 1), reshape ([1, 3, 5, 7], [1,2,2])); +%! assert (min (x, [], 2), reshape ([1, 2, 5, 6], [2,1,2])); +%! [y, i] = min (x, [], 3); +%! assert (ndims(y), 2); %! assert (y, [1, 3; 2, 4]); -%! assert (ndims(y), 2); +%! assert (ndims(i), 2); %! assert (i, [1, 1; 1, 1]); -%! assert (ndims(i), 2); - +%!error max () +%!error max (1, 2, 3, 4) */ template diff --git a/src/DLD-FUNCTIONS/mgorth.cc b/src/DLD-FUNCTIONS/mgorth.cc --- a/src/DLD-FUNCTIONS/mgorth.cc +++ b/src/DLD-FUNCTIONS/mgorth.cc @@ -139,9 +139,10 @@ } /* - %!test -%! for ii=1:100; assert (abs (mgorth (randn (5, 1), eye (5, 4))), [0 0 0 0 1]', eps); endfor +%! for ii=1:100 +%! assert (abs (mgorth (randn (5, 1), eye (5, 4))), [0 0 0 0 1]', eps); +%! endfor %!test %! a = hilb (5); @@ -150,5 +151,4 @@ %! a(:, ii) = mgorth (a(:, ii), a(:, 1:ii-1)); %! endfor %! assert (a' * a, eye (5), 1e10); - */ diff --git a/src/DLD-FUNCTIONS/nproc.cc b/src/DLD-FUNCTIONS/nproc.cc --- a/src/DLD-FUNCTIONS/nproc.cc +++ b/src/DLD-FUNCTIONS/nproc.cc @@ -85,8 +85,6 @@ } /* - -%% Must always report at least 1 cpu available +## Must always report at least 1 cpu available %!assert (nproc () >= 1); - */ diff --git a/src/DLD-FUNCTIONS/qr.cc b/src/DLD-FUNCTIONS/qr.cc --- a/src/DLD-FUNCTIONS/qr.cc +++ b/src/DLD-FUNCTIONS/qr.cc @@ -456,12 +456,10 @@ } /* - %!test %! a = [0, 2, 1; 2, 1, 2]; %! %! [q, r] = qr (a); -%! %! [qe, re] = qr (a, 0); %! %! assert (q * r, a, sqrt (eps)); @@ -470,8 +468,7 @@ %!test %! a = [0, 2, 1; 2, 1, 2]; %! -%! [q, r, p] = qr (a); # not giving right dimensions. FIXME -%! +%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. %! [qe, re, pe] = qr (a, 0); %! %! assert (q * r, a * p, sqrt (eps)); @@ -481,7 +478,6 @@ %! a = [0, 2; 2, 1; 1, 2]; %! %! [q, r] = qr (a); -%! %! [qe, re] = qr (a, 0); %! %! assert (q * r, a, sqrt (eps)); @@ -491,27 +487,26 @@ %! a = [0, 2; 2, 1; 1, 2]; %! %! [q, r, p] = qr (a); -%! %! [qe, re, pe] = qr (a, 0); %! %! assert (q * r, a * p, sqrt (eps)); %! assert (qe * re, a(:, pe), sqrt (eps)); -%!error qr (); -%!error qr ([1, 2; 3, 4], 0, 2); +%!error qr () +%!error qr ([1, 2; 3, 4], 0, 2) %!function retval = __testqr (q, r, a, p) -%! tol = 100*eps (class(q)); +%! tol = 100*eps (class (q)); %! retval = 0; %! if (nargin == 3) -%! n1 = norm (q*r-a); -%! n2 = norm (q'*q-eye(columns(q))); +%! n1 = norm (q*r - a); +%! n2 = norm (q'*q - eye (columns (q))); %! retval = (n1 < tol && n2 < tol); %! else -%! n1 = norm (q'*q-eye(columns(q))); +%! n1 = norm (q'*q - eye (columns (q))); %! retval = (n1 < tol); %! if (isvector (p)) -%! n2 = norm (q*r-a(:,p)); +%! n2 = norm (q*r - a(:,p)); %! retval = (retval && n2 < tol); %! else %! n2 = norm (q*r - a*p); @@ -521,237 +516,226 @@ %!endfunction %!test -%! %! t = ones (24, 1); %! j = 1; %! -%! if false # eliminate big matrix tests -%! a = rand(5000,20); -%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); +%! if (false) # eliminate big matrix tests +%! a = rand (5000, 20); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); %! %! a = a+1i*eps; -%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); %! endif %! %! a = [ ones(1,15); sqrt(eps)*eye(15) ]; -%! [q,r]=qr(a); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a'); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a'); t(j++) = __testqr(q,r,a',p); -%! -%! a = a+1i*eps; -%! [q,r]=qr(a); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a'); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a'); t(j++) = __testqr(q,r,a',p); -%! -%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; -%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); %! %! a = a+1i*eps; -%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); +%! +%! a = [ ones(1,15); sqrt(eps)*eye(15) ]; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); %! -%! a = [ -%! 611 196 -192 407 -8 -52 -49 29 -%! 196 899 113 -192 -71 -43 -8 -44 -%! -192 113 899 196 61 49 8 52 -%! 407 -192 196 611 8 44 59 -23 -%! -8 -71 61 8 411 -599 208 208 -%! -52 -43 49 44 -599 411 208 208 -%! -49 -8 8 59 208 208 99 -911 -%! 29 -44 52 -23 208 208 -911 99 -%! ]; -%! [q,r] = qr(a); +%! a = a+1i*eps; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); %! -%! assert(all (t) && norm(q*r-a) < 5000*eps); +%! a = [ 611 196 -192 407 -8 -52 -49 29 +%! 196 899 113 -192 -71 -43 -8 -44 +%! -192 113 899 196 61 49 8 52 +%! 407 -192 196 611 8 44 59 -23 +%! -8 -71 61 8 411 -599 208 208 +%! -52 -43 49 44 -599 411 208 208 +%! -49 -8 8 59 208 208 99 -911 +%! 29 -44 52 -23 208 208 -911 99 ]; +%! [q,r] = qr (a); +%! +%! assert (all (t) && norm (q*r - a) < 5000*eps); %!test %! a = single ([0, 2, 1; 2, 1, 2]); %! %! [q, r] = qr (a); -%! %! [qe, re] = qr (a, 0); %! -%! assert (q * r, a, sqrt (eps ('single'))); -%! assert (qe * re, a, sqrt (eps ('single'))); +%! assert (q * r, a, sqrt (eps ("single"))); +%! assert (qe * re, a, sqrt (eps ("single"))); %!test -%! a = single([0, 2, 1; 2, 1, 2]); +%! a = single ([0, 2, 1; 2, 1, 2]); %! -%! [q, r, p] = qr (a); # not giving right dimensions. FIXME -%! +%! [q, r, p] = qr (a); # FIXME: not giving right dimensions. %! [qe, re, pe] = qr (a, 0); %! -%! assert (q * r, a * p, sqrt (eps('single'))); -%! assert (qe * re, a(:, pe), sqrt (eps('single'))); +%! assert (q * r, a * p, sqrt (eps ("single"))); +%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); %!test -%! a = single([0, 2; 2, 1; 1, 2]); +%! a = single ([0, 2; 2, 1; 1, 2]); %! %! [q, r] = qr (a); -%! %! [qe, re] = qr (a, 0); %! -%! assert (q * r, a, sqrt (eps('single'))); -%! assert (qe * re, a, sqrt (eps('single'))); +%! assert (q * r, a, sqrt (eps ("single"))); +%! assert (qe * re, a, sqrt (eps ("single"))); %!test -%! a = single([0, 2; 2, 1; 1, 2]); +%! a = single ([0, 2; 2, 1; 1, 2]); %! %! [q, r, p] = qr (a); -%! %! [qe, re, pe] = qr (a, 0); %! -%! assert (q * r, a * p, sqrt (eps('single'))); -%! assert (qe * re, a(:, pe), sqrt (eps('single'))); +%! assert (q * r, a * p, sqrt (eps ("single"))); +%! assert (qe * re, a(:, pe), sqrt (eps ("single"))); -%!error qr (); -%!error qr ([1, 2; 3, 4], 0, 2); +%!error qr () +%!error qr ([1, 2; 3, 4], 0, 2) %!test -%! %! t = ones (24, 1); %! j = 1; %! -%! if false # eliminate big matrix tests -%! a = rand(5000,20); -%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); +%! if (false) # eliminate big matrix tests +%! a = rand (5000,20); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); %! -%! a = a+1i*eps('single'); -%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); %! endif %! -%! a = [ ones(1,15); sqrt(eps('single'))*eye(15) ]; -%! [q,r]=qr(a); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a'); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a'); t(j++) = __testqr(q,r,a',p); +%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); %! -%! a = a+1i*eps('single'); -%! [q,r]=qr(a); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a'); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a'); t(j++) = __testqr(q,r,a',p); +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a'); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a'); t(j++) = __testqr (q, r, a', p); %! -%! a = [ ones(1,15); sqrt(eps('single'))*eye(15) ]; -%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); +%! a = [ ones(1,15); sqrt(eps("single"))*eye(15) ]; +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a', p); %! -%! a = a+1i*eps('single'); -%! [q,r]=qr(a,0); t(j++) = __testqr(q,r,a); -%! [q,r]=qr(a',0); t(j++) = __testqr(q,r,a'); -%! [q,r,p]=qr(a,0); t(j++) = __testqr(q,r,a,p); -%! [q,r,p]=qr(a',0); t(j++) = __testqr(q,r,a',p); +%! a = a+1i*eps ("single"); +%! [q,r] = qr (a, 0); t(j++) = __testqr (q, r, a); +%! [q,r] = qr (a',0); t(j++) = __testqr (q, r, a'); +%! [q,r,p] = qr (a, 0); t(j++) = __testqr (q, r, a, p); +%! [q,r,p] = qr (a',0); t(j++) = __testqr (q, r, a',p); %! -%! a = [ -%! 611 196 -192 407 -8 -52 -49 29 -%! 196 899 113 -192 -71 -43 -8 -44 -%! -192 113 899 196 61 49 8 52 -%! 407 -192 196 611 8 44 59 -23 -%! -8 -71 61 8 411 -599 208 208 -%! -52 -43 49 44 -599 411 208 208 -%! -49 -8 8 59 208 208 99 -911 -%! 29 -44 52 -23 208 208 -911 99 -%! ]; -%! [q,r] = qr(a); +%! a = [ 611 196 -192 407 -8 -52 -49 29 +%! 196 899 113 -192 -71 -43 -8 -44 +%! -192 113 899 196 61 49 8 52 +%! 407 -192 196 611 8 44 59 -23 +%! -8 -71 61 8 411 -599 208 208 +%! -52 -43 49 44 -599 411 208 208 +%! -49 -8 8 59 208 208 99 -911 +%! 29 -44 52 -23 208 208 -911 99 ]; +%! [q,r] = qr (a); %! -%! assert(all (t) && norm(q*r-a) < 5000*eps('single')); +%! assert (all (t) && norm (q*r-a) < 5000*eps ("single")); -%% The deactivated tests below can't be tested till rectangular back-subs is -%% implemented for sparse matrices. +## The deactivated tests below can't be tested till rectangular back-subs is +## implemented for sparse matrices. %!testif HAVE_CXSPARSE -%! n = 20; d= 0.2; -%! a = sprandn(n,n,d)+speye(n,n); -%! r = qr(a); -%! assert(r'*r,a'*a,1e-10) +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) %!testif HAVE_COLAMD -%! n = 20; d= 0.2; -%! a = sprandn(n,n,d)+speye(n,n); -%! q = symamd(a); +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! q = symamd (a); %! a = a(q,q); -%! r = qr(a); -%! assert(r'*r,a'*a,1e-10) +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) %!testif HAVE_CXSPARSE -%! n = 20; d= 0.2; -%! a = sprandn(n,n,d)+speye(n,n); -%! [c,r] = qr(a,ones(n,1)); -%! assert (r\c,full(a)\ones(n,1),10e-10) +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! [c,r] = qr (a, ones (n,1)); +%! assert (r\c, full (a)\ones (n,1), 10e-10) %!testif HAVE_CXSPARSE -%! n = 20; d= 0.2; -%! a = sprandn(n,n,d)+speye(n,n); -%! b = randn(n,2); -%! [c,r] = qr(a,b); -%! assert (r\c,full(a)\b,10e-10) +%! n = 20; d = 0.2; +%! a = sprandn (n,n,d) + speye (n,n); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) %% Test under-determined systems!! %!#testif HAVE_CXSPARSE -%! n = 20; d= 0.2; -%! a = sprandn(n,n+1,d)+speye(n,n+1); -%! b = randn(n,2); -%! [c,r] = qr(a,b); -%! assert (r\c,full(a)\b,10e-10) +%! n = 20; d = 0.2; +%! a = sprandn (n,n+1,d) + speye (n,n+1); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) %!testif HAVE_CXSPARSE -%! n = 20; d= 0.2; -%! a = 1i*sprandn(n,n,d)+speye(n,n); -%! r = qr(a); -%! assert(r'*r,a'*a,1e-10) +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! r = qr (a); +%! assert (r'*r,a'*a,1e-10) %!testif HAVE_COLAMD -%! n = 20; d= 0.2; -%! a = 1i*sprandn(n,n,d)+speye(n,n); -%! q = symamd(a); +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! q = symamd (a); %! a = a(q,q); -%! r = qr(a); -%! assert(r'*r,a'*a,1e-10) +%! r = qr (a); +%! assert (r'*r, a'*a, 1e-10) %!testif HAVE_CXSPARSE -%! n = 20; d= 0.2; -%! a = 1i*sprandn(n,n,d)+speye(n,n); -%! [c,r] = qr(a,ones(n,1)); -%! assert (r\c,full(a)\ones(n,1),10e-10) +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! [c,r] = qr (a, ones (n,1)); +%! assert (r\c, full (a)\ones (n,1), 10e-10) %!testif HAVE_CXSPARSE -%! n = 20; d= 0.2; -%! a = 1i*sprandn(n,n,d)+speye(n,n); -%! b = randn(n,2); -%! [c,r] = qr(a,b); -%! assert (r\c,full(a)\b,10e-10) +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n,d) + speye (n,n); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) %% Test under-determined systems!! %!#testif HAVE_CXSPARSE -%! n = 20; d= 0.2; -%! a = 1i*sprandn(n,n+1,d)+speye(n,n+1); -%! b = randn(n,2); -%! [c,r] = qr(a,b); -%! assert (r\c,full(a)\b,10e-10) +%! n = 20; d = 0.2; +%! a = 1i*sprandn (n,n+1,d) + speye (n,n+1); +%! b = randn (n,2); +%! [c,r] = qr (a, b); +%! assert (r\c, full (a)\b, 10e-10) -%!error qr(sprandn(10,10,0.2),ones(10,1)); - +%!error qr (sprandn (10,10,0.2), ones (10,1)) */ static @@ -885,6 +869,7 @@ return retval; } + /* %!shared A, u, v, Ac, uc, vc %! A = [0.091364 0.613038 0.999083; @@ -921,32 +906,32 @@ %! %!test -%! [Q,R] = qr(A); -%! [Q,R] = qrupdate(Q,R,u,v); -%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - A - u*v'),Inf) < norm(A)*1e1*eps) +%! [Q,R] = qr (A); +%! [Q,R] = qrupdate (Q, R, u, v); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - A - u*v'), Inf) < norm (A)*1e1*eps); %! %!test -%! [Q,R] = qr(Ac); -%! [Q,R] = qrupdate(Q,R,uc,vc); -%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - Ac - uc*vc'),Inf) < norm(Ac)*1e1*eps) +%! [Q,R] = qr (Ac); +%! [Q,R] = qrupdate (Q, R, uc, vc); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - Ac - uc*vc'), Inf) < norm (Ac)*1e1*eps); %!test -%! [Q,R] = qr(single(A)); -%! [Q,R] = qrupdate(Q,R,single(u),single(v)); -%! assert(norm(vec(Q'*Q - eye(5,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - single(A) - single(u)*single(v)'),Inf) < norm(single(A))*1e1*eps('single')) +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrupdate (Q, R, single (u), single (v)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - single (A) - single (u)*single (v)'), Inf) < norm (single (A))*1e1*eps ("single")); %! %!test -%! [Q,R] = qr(single(Ac)); -%! [Q,R] = qrupdate(Q,R,single(uc),single(vc)); -%! assert(norm(vec(Q'*Q - eye(5,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - single(Ac) - single(uc)*single(vc)'),Inf) < norm(single(Ac))*1e1*eps('single')) +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrupdate (Q, R, single (uc), single (vc)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R)-R), Inf) == 0); +%! assert (norm (vec (Q*R - single (Ac) - single (uc)*single (vc)'), Inf) < norm (single (Ac))*1e1*eps ("single")); */ DEFUN_DLD (qrinsert, args, , @@ -1110,62 +1095,62 @@ /* %!test -%! [Q,R] = qr(A); -%! [Q,R] = qrinsert(Q,R,3,u); -%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [A(:,1:2) u A(:,3)]),Inf) < norm(A)*1e1*eps) +%! [Q,R] = qr (A); +%! [Q,R] = qrinsert (Q, R, 3, u); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [A(:,1:2) u A(:,3)]), Inf) < norm (A)*1e1*eps); %!test -%! [Q,R] = qr(Ac); -%! [Q,R] = qrinsert(Q,R,3,uc); -%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [Ac(:,1:2) uc Ac(:,3)]),Inf) < norm(Ac)*1e1*eps) +%! [Q,R] = qr (Ac); +%! [Q,R] = qrinsert (Q, R, 3, uc); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [Ac(:,1:2) uc Ac(:,3)]), Inf) < norm (Ac)*1e1*eps); %!test %! x = [0.85082 0.76426 0.42883 ]; %! -%! [Q,R] = qr(A); -%! [Q,R] = qrinsert(Q,R,3,x,'row'); -%! assert(norm(vec(Q'*Q - eye(6)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [A(1:2,:);x;A(3:5,:)]),Inf) < norm(A)*1e1*eps) +%! [Q,R] = qr (A); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [A(1:2,:);x;A(3:5,:)]), Inf) < norm (A)*1e1*eps); %!test %! x = [0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]; %! -%! [Q,R] = qr(Ac); -%! [Q,R] = qrinsert(Q,R,3,x,'row'); -%! assert(norm(vec(Q'*Q - eye(6)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [Ac(1:2,:);x;Ac(3:5,:)]),Inf) < norm(Ac)*1e1*eps) +%! [Q,R] = qr (Ac); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [Ac(1:2,:);x;Ac(3:5,:)]), Inf) < norm (Ac)*1e1*eps); %!test -%! [Q,R] = qr(single(A)); -%! [Q,R] = qrinsert(Q,R,3,single(u)); -%! assert(norm(vec(Q'*Q - eye(5,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - single([A(:,1:2) u A(:,3)])),Inf) < norm(single(A))*1e1*eps('single')) +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrinsert (Q, R, 3, single (u)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([A(:,1:2) u A(:,3)])), Inf) < norm (single (A))*1e1*eps ("single")); %!test -%! [Q,R] = qr(single(Ac)); -%! [Q,R] = qrinsert(Q,R,3,single(uc)); -%! assert(norm(vec(Q'*Q - eye(5,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - single([Ac(:,1:2) uc Ac(:,3)])),Inf) < norm(single(Ac))*1e1*eps('single')) +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrinsert (Q, R, 3, single (uc)); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([Ac(:,1:2) uc Ac(:,3)])), Inf) < norm (single (Ac))*1e1*eps ("single")); %!test -%! x = single([0.85082 0.76426 0.42883 ]); +%! x = single ([0.85082 0.76426 0.42883 ]); %! -%! [Q,R] = qr(single(A)); -%! [Q,R] = qrinsert(Q,R,3,x,'row'); -%! assert(norm(vec(Q'*Q - eye(6,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - single([A(1:2,:);x;A(3:5,:)])),Inf) < norm(single(A))*1e1*eps('single')) +%! [Q,R] = qr (single (A)); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([A(1:2,:);x;A(3:5,:)])), Inf) < norm (single (A))*1e1*eps ("single")); %!test -%! x = single([0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]); +%! x = single ([0.20351 + 0.05401i 0.13141 + 0.43708i 0.29808 + 0.08789i ]); %! -%! [Q,R] = qr(single(Ac)); -%! [Q,R] = qrinsert(Q,R,3,x,'row'); -%! assert(norm(vec(Q'*Q - eye(6,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - single([Ac(1:2,:);x;Ac(3:5,:)])),Inf) < norm(single(Ac))*1e1*eps('single')) +%! [Q,R] = qr (single (Ac)); +%! [Q,R] = qrinsert (Q, R, 3, x, "row"); +%! assert (norm (vec (Q'*Q - eye (6,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - single ([Ac(1:2,:);x;Ac(3:5,:)])), Inf) < norm (single (Ac))*1e1*eps ("single")); */ DEFUN_DLD (qrdelete, args, , @@ -1322,11 +1307,11 @@ %! 0.265712 0.268003 0.783553 0.238409; %! 0.669966 0.743851 0.457255 0.445057 ]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3); -%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 16*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(:,1:2) AA(:,4)]),Inf) < norm(AA)*1e1*eps) +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); %! %!test %! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; @@ -1335,11 +1320,11 @@ %! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; %! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3); -%! assert(norm(vec(Q'*Q - eye(5)),Inf) < 16*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(:,1:2) AA(:,4)]),Inf) < norm(AA)*1e1*eps) +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5)), Inf) < 16*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps); %! %!test %! AA = [0.091364 0.613038 0.027504 0.999083; @@ -1348,11 +1333,11 @@ %! 0.265712 0.268003 0.783553 0.238409; %! 0.669966 0.743851 0.457255 0.445057 ]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3,'row'); -%! assert(norm(vec(Q'*Q - eye(4)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(1:2,:);AA(4:5,:)]),Inf) < norm(AA)*1e1*eps) +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); %! %!test %! AA = [0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; @@ -1361,76 +1346,76 @@ %! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; %! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ] * I; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3,'row'); -%! assert(norm(vec(Q'*Q - eye(4)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(1:2,:);AA(4:5,:)]),Inf) < norm(AA)*1e1*eps) +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps); %!test -%! AA = single([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3); -%! assert(norm(vec(Q'*Q - eye(5,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(:,1:2) AA(:,4)]),Inf) < norm(AA)*1e1*eps('single')) +%!test +%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; +%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; +%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; +%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3); +%! assert (norm (vec (Q'*Q - eye (5,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(:,1:2) AA(:,4)]), Inf) < norm (AA)*1e1*eps ("single")); %! %!test -%! AA = single([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1.5e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); +%!testif HAVE_QRUPDATE +%! # Same test as above but with more precicision +%! AA = single ([0.091364 0.613038 0.027504 0.999083; +%! 0.594638 0.425302 0.562834 0.603537; +%! 0.383594 0.291238 0.742073 0.085574; +%! 0.265712 0.268003 0.783553 0.238409; +%! 0.669966 0.743851 0.457255 0.445057 ]); +%! +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); +%! +%!test +%! AA = single ([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; %! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; %! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; %! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; %! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3); -%! assert(norm(vec(Q'*Q - eye(5,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(:,1:2) AA(:,4)]),Inf) < norm(AA)*1e1*eps('single')) -%! -%!test -%! AA = single([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); -%! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3,'row'); -%! assert(norm(vec(Q'*Q - eye(4,'single')),Inf) < 1.5e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(1:2,:);AA(4:5,:)]),Inf) < norm(AA)*1e1*eps('single')) -%!testif HAVE_QRUPDATE -%! # Same test as above but with more precicision -%! AA = single([0.091364 0.613038 0.027504 0.999083; -%! 0.594638 0.425302 0.562834 0.603537; -%! 0.383594 0.291238 0.742073 0.085574; -%! 0.265712 0.268003 0.783553 0.238409; -%! 0.669966 0.743851 0.457255 0.445057 ]); -%! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3,'row'); -%! assert(norm(vec(Q'*Q - eye(4,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(1:2,:);AA(4:5,:)]),Inf) < norm(AA)*1e1*eps('single')) -%! -%!test -%! AA = single([0.364554 + 0.993117i 0.669818 + 0.510234i 0.426568 + 0.041337i 0.847051 + 0.233291i; -%! 0.049600 + 0.242783i 0.448946 + 0.484022i 0.141155 + 0.074420i 0.446746 + 0.392706i; -%! 0.581922 + 0.657416i 0.581460 + 0.030016i 0.219909 + 0.447288i 0.201144 + 0.069132i; -%! 0.694986 + 0.000571i 0.682327 + 0.841712i 0.807537 + 0.166086i 0.192767 + 0.358098i; -%! 0.945002 + 0.066788i 0.350492 + 0.642638i 0.579629 + 0.048102i 0.600170 + 0.636938i ]) * I; -%! -%! [Q,R] = qr(AA); -%! [Q,R] = qrdelete(Q,R,3,'row'); -%! assert(norm(vec(Q'*Q - eye(4,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - [AA(1:2,:);AA(4:5,:)]),Inf) < norm(AA)*1e1*eps('single')) +%! [Q,R] = qr (AA); +%! [Q,R] = qrdelete (Q, R, 3, "row"); +%! assert (norm (vec (Q'*Q - eye (4,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - [AA(1:2,:);AA(4:5,:)]), Inf) < norm (AA)*1e1*eps ("single")); */ DEFUN_DLD (qrshift, args, , @@ -1537,77 +1522,77 @@ return retval; } + /* %!test %! AA = A.'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrshift(Q,R,i,j); -%! assert(norm(vec(Q'*Q - eye(3)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - AA(:,p)),Inf) < norm(AA)*1e1*eps) +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); %! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrshift(Q,R,i,j); -%! assert(norm(vec(Q'*Q - eye(3)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - AA(:,p)),Inf) < norm(AA)*1e1*eps) +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); %! %!test %! AA = Ac.'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrshift(Q,R,i,j); -%! assert(norm(vec(Q'*Q - eye(3)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - AA(:,p)),Inf) < norm(AA)*1e1*eps) +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); %! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrshift(Q,R,i,j); -%! assert(norm(vec(Q'*Q - eye(3)),Inf) < 1e1*eps) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - AA(:,p)),Inf) < norm(AA)*1e1*eps) - +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3)), Inf) < 1e1*eps); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps); %!test %! AA = single (A).'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrshift(Q,R,i,j); -%! assert(norm(vec(Q'*Q - eye(3,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - AA(:,p)),Inf) < norm(AA)*1e1*eps('single')) +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); %! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrshift(Q,R,i,j); -%! assert(norm(vec(Q'*Q - eye(3,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - AA(:,p)),Inf) < norm(AA)*1e1*eps('single')) +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); %! %!test -%! AA = single(Ac).'; -%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; +%! AA = single (Ac).'; +%! i = 2; j = 4; p = [1:i-1, shift(i:j,-1), j+1:5]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrshift(Q,R,i,j); -%! assert(norm(vec(Q'*Q - eye(3,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - AA(:,p)),Inf) < norm(AA)*1e1*eps('single')) +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); %! -%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; +%! j = 2; i = 4; p = [1:j-1, shift(j:i,+1), i+1:5]; %! -%! [Q,R] = qr(AA); -%! [Q,R] = qrshift(Q,R,i,j); -%! assert(norm(vec(Q'*Q - eye(3,'single')),Inf) < 1e1*eps('single')) -%! assert(norm(vec(triu(R)-R),Inf) == 0) -%! assert(norm(vec(Q*R - AA(:,p)),Inf) < norm(AA)*1e1*eps('single')) +%! [Q,R] = qr (AA); +%! [Q,R] = qrshift (Q, R, i, j); +%! assert (norm (vec (Q'*Q - eye (3,"single")), Inf) < 1e1*eps ("single")); +%! assert (norm (vec (triu (R) - R), Inf) == 0); +%! assert (norm (vec (Q*R - AA(:,p)), Inf) < norm (AA)*1e1*eps ("single")); */ diff --git a/src/DLD-FUNCTIONS/quad.cc b/src/DLD-FUNCTIONS/quad.cc --- a/src/DLD-FUNCTIONS/quad.cc +++ b/src/DLD-FUNCTIONS/quad.cc @@ -473,19 +473,23 @@ } /* - %!function y = __f (x) -%! y = x + 1; +%! y = x + 1; %!endfunction %!test %! [v, ier, nfun, err] = quad ("__f", 0, 5); -%! assert(ier == 0 && abs (v - 17.5) < sqrt (eps) && nfun > 0 && -%! err < sqrt (eps)) +%! assert (ier, 0); +%! assert (v, 17.5, sqrt (eps)); +%! assert (nfun > 0); +%! assert (err < sqrt (eps)); + %!test -%! [v, ier, nfun, err] = quad ("__f", single(0), single(5)); -%! assert(ier == 0 && abs (v - 17.5) < sqrt (eps ("single")) && nfun > 0 && -%! err < sqrt (eps ("single"))) +%! [v, ier, nfun, err] = quad ("__f", single (0), single (5)); +%! assert (ier, 0); +%! assert (v, 17.5, sqrt (eps ("single"))); +%! assert (nfun > 0); +%! assert (err < sqrt (eps ("single"))); %!function y = __f (x) %! y = x .* sin (1 ./ x) .* sqrt (abs (1 - x)); @@ -493,19 +497,22 @@ %!test %! [v, ier, nfun, err] = quad ("__f", 0.001, 3); -%! assert((ier == 0 || ier == 1) && abs (v - 1.98194120273598) < sqrt (eps) && nfun > 0); +%! assert (ier == 0 || ier == 1); +%! assert (v, 1.98194120273598, sqrt (eps)); +%! assert (nfun > 0); + %!test -%! [v, ier, nfun, err] = quad ("__f", single(0.001), single(3)); -%! assert((ier == 0 || ier == 1) && abs (v - 1.98194120273598) < sqrt (eps ("single")) && nfun > 0); +%! [v, ier, nfun, err] = quad ("__f", single (0.001), single (3)); +%! assert (ier == 0 || ier == 1); +%! assert (v, 1.98194120273598, sqrt (eps ("single"))); +%! assert (nfun > 0); -%!error quad (); - -%!error quad ("__f", 1, 2, 3, 4, 5); +%!error quad () +%!error quad ("__f", 1, 2, 3, 4, 5) %!test %! quad_options ("absolute tolerance", eps); -%! assert(quad_options ("absolute tolerance") == eps); +%! assert (quad_options ("absolute tolerance") == eps); -%!error quad_options (1, 2, 3); - +%!error quad_options (1, 2, 3) */ diff --git a/src/DLD-FUNCTIONS/quadcc.cc b/src/DLD-FUNCTIONS/quadcc.cc --- a/src/DLD-FUNCTIONS/quadcc.cc +++ b/src/DLD-FUNCTIONS/quadcc.cc @@ -2238,28 +2238,26 @@ /* - -%!assert (quadcc(@sin,-pi,pi), 0, 1e-6) -%!assert (quadcc(inline('sin'),-pi,pi), 0, 1e-6) -%!assert (quadcc('sin',-pi,pi), 0, 1e-6) +%!assert (quadcc (@sin, -pi, pi), 0, 1e-6) +%!assert (quadcc (inline ("sin"),- pi, pi), 0, 1e-6) +%!assert (quadcc ("sin", -pi, pi), 0, 1e-6) -%!assert (quadcc(@sin,-pi,0), -2, 1e-6) -%!assert (quadcc(@sin,0,pi), 2, 1e-6) -%!assert (quadcc(@(x) 1./sqrt(x), 0, 1), 2, 1e-6) -%!assert (quadcc(@(x) 1./(sqrt(x).*(x+1)), 0, Inf), pi, 1e-6) +%!assert (quadcc (@sin, -pi, 0), -2, 1e-6) +%!assert (quadcc (@sin, 0, pi), 2, 1e-6) +%!assert (quadcc (@(x) 1./sqrt (x), 0, 1), 2, 1e-6) +%!assert (quadcc (@(x) 1./(sqrt (x).*(x+1)), 0, Inf), pi, 1e-6) -%!assert (quadcc (@(x) exp(-x .^ 2), -Inf, Inf), sqrt(pi), 1e-6) -%!assert (quadcc (@(x) exp(-x .^ 2), -Inf, 0), sqrt(pi)/2, 1e-6) +%!assert (quadcc (@(x) exp (-x .^ 2), -Inf, Inf), sqrt (pi), 1e-6) +%!assert (quadcc (@(x) exp (-x .^ 2), -Inf, 0), sqrt (pi)/2, 1e-6) %% Test input validation %!error (quadcc ()) %!error (quadcc (@sin)) %!error (quadcc (@sin, 0)) -%!error (quadcc (@sin, ones(2), pi)) +%!error (quadcc (@sin, ones (2), pi)) %!error (quadcc (@sin, -i, pi)) -%!error (quadcc (@sin, 0, ones(2))) +%!error (quadcc (@sin, 0, ones (2))) %!error (quadcc (@sin, 0, i)) %!error (quadcc (@sin, 0, pi, 0)) %!error (quadcc (@sin, 0, pi, 1e-6, [ i ])) - */ diff --git a/src/DLD-FUNCTIONS/qz.cc b/src/DLD-FUNCTIONS/qz.cc --- a/src/DLD-FUNCTIONS/qz.cc +++ b/src/DLD-FUNCTIONS/qz.cc @@ -1243,27 +1243,26 @@ /* %!shared a, b, c -%! a = [1 2; 0 3]; -%! b = [1 0; 0 0]; -%! c = [0 1; 0 0]; -%!assert(qz (a,b), 1); -%!assert(isempty (qz (a,c))); +%! a = [1 2; 0 3]; +%! b = [1 0; 0 0]; +%! c = [0 1; 0 0]; +%!assert (qz (a,b), 1) +%!assert (isempty (qz (a,c))) -%% Exaple 7.7.3 in Golub & Van Loan +## Exaple 7.7.3 in Golub & Van Loan %!test %! a = [ 10 1 2; %! 1 2 -1; %! 1 1 2]; -%! b = reshape(1:9,3,3); +%! b = reshape (1:9,3,3); %! [aa, bb, q, z, v, w, lambda] = qz (a, b); -%! sz = length(lambda); -%! observed = (b * v * diag ([lambda;0])) (:, 1:sz); +%! sz = length (lambda); +%! observed = (b * v * diag ([lambda;0])) (:, 1:sz); %! assert ( (a*v) (:, 1:sz), observed, norm (observed) * 1e-14); %! observed = (diag ([lambda;0]) * w' * b) (1:sz, :); %! assert ( (w'*a) (1:sz, :) , observed, norm (observed) * 1e-13); %! assert (q * a * z, aa, norm (aa) * 1e-14); %! assert (q * b * z, bb, norm (bb) * 1e-14); -%% FIXME: Still need a test for third form of calling qz - +## FIXME: Still need a test for third form of calling qz */ diff --git a/src/DLD-FUNCTIONS/rand.cc b/src/DLD-FUNCTIONS/rand.cc --- a/src/DLD-FUNCTIONS/rand.cc +++ b/src/DLD-FUNCTIONS/rand.cc @@ -48,7 +48,7 @@ /* %!shared __random_statistical_tests__ -%! % Flag whether the statistical tests should be run in "make check" or not +%! # Flag whether the statistical tests should be run in "make check" or not %! __random_statistical_tests__ = 0; */ @@ -415,75 +415,74 @@ // work properly if compiled to use 64-bit integers. /* -%!test # 'state' can be a scalar -%! rand('state',12); x = rand(1,4); -%! rand('state',12); y = rand(1,4); -%! assert(x,y); -%!test # 'state' can be a vector -%! rand('state',[12,13]); x=rand(1,4); -%! rand('state',[12;13]); y=rand(1,4); -%! assert(x,y); -%!test # querying 'state' doesn't disturb sequence -%! rand('state',12); rand(1,2); x=rand(1,2); -%! rand('state',12); rand(1,2); -%! s=rand('state'); y=rand(1,2); -%! assert(x,y); -%! rand('state',s); z=rand(1,2); -%! assert(x,z); -%!test # 'seed' must be a scalar -%! rand('seed',12); x = rand(1,4); -%! rand('seed',12); y = rand(1,4); -%! assert(x,y); -%!error(rand('seed',[12,13])) -%!test # querying 'seed' returns a value which can be used later -%! s=rand('seed'); x=rand(1,2); -%! rand('seed',s); y=rand(1,2); -%! assert(x,y); -%!test # querying 'seed' doesn't disturb sequence -%! rand('seed',12); rand(1,2); x=rand(1,2); -%! rand('seed',12); rand(1,2); -%! s=rand('seed'); y=rand(1,2); -%! assert(x,y); -%! rand('seed',s); z=rand(1,2); -%! assert(x,z); +%!test # "state" can be a scalar +%! rand ("state", 12); x = rand (1,4); +%! rand ("state", 12); y = rand (1,4); +%! assert (x, y); +%!test # "state" can be a vector +%! rand ("state", [12,13]); x = rand (1,4); +%! rand ("state", [12;13]); y = rand (1,4); +%! assert (x, y); +%!test # querying "state" doesn't disturb sequence +%! rand ("state", 12); rand (1,2); x = rand (1,2); +%! rand ("state", 12); rand (1,2); +%! s = rand ("state"); y = rand (1,2); +%! assert (x, y); +%! rand ("state", s); z = rand (1,2); +%! assert (x, z); +%!test # "seed" must be a scalar +%! rand ("seed", 12); x = rand (1,4); +%! rand ("seed", 12); y = rand (1,4); +%! assert (x, y); +%!error rand ("seed", [12,13]) +%!test # querying "seed" returns a value which can be used later +%! s = rand ("seed"); x = rand (1,2); +%! rand ("seed", s); y = rand (1,2); +%! assert (x, y); +%!test # querying "seed" doesn't disturb sequence +%! rand ("seed", 12); rand (1,2); x = rand (1,2); +%! rand ("seed", 12); rand (1,2); +%! s = rand ("seed"); y = rand (1,2); +%! assert (x, y); +%! rand ("seed", s); z = rand (1,2); +%! assert (x, z); */ /* %!test -%! % Test fixed state -%! rand("state",1); -%! assert (rand(1,6), [0.1343642441124013 0.8474337369372327 0.763774618976614 0.2550690257394218 0.495435087091941 0.4494910647887382],1e-6); +%! # Test fixed state +%! rand ("state", 1); +%! assert (rand (1,6), [0.1343642441124013 0.8474337369372327 0.763774618976614 0.2550690257394218 0.495435087091941 0.4494910647887382], 1e-6); %!test -%! % Test fixed seed -%! rand("seed",1); -%! assert (rand(1,6), [0.8668024251237512 0.9126510815694928 0.09366085007786751 0.1664607301354408 0.7408077004365623 0.7615650338120759],1e-6); +%! # Test fixed seed +%! rand ("seed", 1); +%! assert (rand (1,6), [0.8668024251237512 0.9126510815694928 0.09366085007786751 0.1664607301354408 0.7408077004365623 0.7615650338120759], 1e-6); %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! rand("state",12); -%! x = rand(100000,1); -%! assert(max(x)<1.); %*** Please report this!!! *** -%! assert(min(x)>0.); %*** Please report this!!! *** -%! assert(mean(x),0.5,0.0024); -%! assert(var(x),1/48,0.0632); -%! assert(skewness(x),0,0.012); -%! assert(kurtosis(x),-6/5,0.0094); +%! # statistical tests may fail occasionally. +%! rand ("state", 12); +%! x = rand (100000, 1); +%! assert (max (x) < 1); #*** Please report this!!! *** +%! assert (min (x) > 0); #*** Please report this!!! *** +%! assert (mean (x), 0.5, 0.0024); +%! assert (var (x), 1/48, 0.0632); +%! assert (skewness (x), 0, 0.012); +%! assert (kurtosis (x), -6/5, 0.0094); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! rand("seed",12); -%! x = rand(100000,1); -%! assert(max(x)<1.); %*** Please report this!!! *** -%! assert(min(x)>0.); %*** Please report this!!! *** -%! assert(mean(x),0.5,0.0024); -%! assert(var(x),1/48,0.0632); -%! assert(skewness(x),0,0.012); -%! assert(kurtosis(x),-6/5,0.0094); +%! # statistical tests may fail occasionally. +%! rand ("seed", 12); +%! x = rand (100000, 1); +%! assert (max (x) < 1); #*** Please report this!!! *** +%! assert (min (x) > 0); #*** Please report this!!! *** +%! assert (mean (x), 0.5, 0.0024); +%! assert (var (x), 1/48, 0.0632); +%! assert (skewness (x), 0, 0.012); +%! assert (kurtosis (x), -6/5, 0.0094); %! endif */ - static std::string current_distribution = octave_rand::distribution (); DEFUN_DLD (randn, args, , @@ -523,32 +522,32 @@ /* %!test -%! % Test fixed state -%! randn("state",1); -%! assert (randn(1,6), [-2.666521678978671 -0.7381719971724564 1.507903992673601 0.6019427189162239 -0.450661261143348 -0.7054431351574116],1e-6); +%! # Test fixed state +%! randn ("state", 1); +%! assert (randn (1, 6), [-2.666521678978671 -0.7381719971724564 1.507903992673601 0.6019427189162239 -0.450661261143348 -0.7054431351574116], 1e-6); %!test -%! % Test fixed seed -%! randn("seed",1); -%! assert (randn(1,6), [-1.039402365684509 -1.25938892364502 0.1968704611063004 0.3874166905879974 -0.5976632833480835 -0.6615074276924133],1e-6); +%! # Test fixed seed +%! randn ("seed", 1); +%! assert (randn (1, 6), [-1.039402365684509 -1.25938892364502 0.1968704611063004 0.3874166905879974 -0.5976632833480835 -0.6615074276924133], 1e-6); %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randn("state",12); -%! x = randn(100000,1); -%! assert(mean(x),0,0.01); -%! assert(var(x),1,0.02); -%! assert(skewness(x),0,0.02); -%! assert(kurtosis(x),0,0.04); +%! # statistical tests may fail occasionally. +%! randn ("state", 12); +%! x = randn (100000, 1); +%! assert (mean (x), 0, 0.01); +%! assert (var (x), 1, 0.02); +%! assert (skewness (x), 0, 0.02); +%! assert (kurtosis (x), 0, 0.04); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randn("seed",12); -%! x = randn(100000,1); -%! assert(mean(x),0,0.01); -%! assert(var(x),1,0.02); -%! assert(skewness(x),0,0.02); -%! assert(kurtosis(x),0,0.04); +%! # statistical tests may fail occasionally. +%! randn ("seed", 12); +%! x = randn (100000, 1); +%! assert (mean (x), 0, 0.01); +%! assert (var (x), 1, 0.02); +%! assert (skewness (x), 0, 0.02); +%! assert (kurtosis (x), 0, 0.04); %! endif */ @@ -588,34 +587,34 @@ /* %!test -%! % Test fixed state -%! rande("state",1); -%! assert (rande(1,6), [3.602973885835625 0.1386190677555021 0.6743112889616958 0.4512830847258422 0.7255744741233175 0.3415969205292291],1e-6); +%! # Test fixed state +%! rande ("state", 1); +%! assert (rande (1, 6), [3.602973885835625 0.1386190677555021 0.6743112889616958 0.4512830847258422 0.7255744741233175 0.3415969205292291], 1e-6); %!test -%! % Test fixed seed -%! rande("seed",1); -%! assert (rande(1,6), [0.06492075175653866 1.717980206012726 0.4816154008731246 0.5231300676241517 0.103910739364359 1.668931916356087],1e-6); +%! # Test fixed seed +%! rande ("seed", 1); +%! assert (rande (1, 6), [0.06492075175653866 1.717980206012726 0.4816154008731246 0.5231300676241517 0.103910739364359 1.668931916356087], 1e-6); %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally -%! rande("state",1); -%! x = rande(100000,1); -%! assert(min(x)>0); % *** Please report this!!! *** -%! assert(mean(x),1,0.01); -%! assert(var(x),1,0.03); -%! assert(skewness(x),2,0.06); -%! assert(kurtosis(x),6,0.7); +%! # statistical tests may fail occasionally +%! rande ("state", 1); +%! x = rande (100000, 1); +%! assert (min (x) > 0); # *** Please report this!!! *** +%! assert (mean (x), 1, 0.01); +%! assert (var (x), 1, 0.03); +%! assert (skewness (x), 2, 0.06); +%! assert (kurtosis (x), 6, 0.7); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally -%! rande("seed",1); -%! x = rande(100000,1); -%! assert(min(x)>0); % *** Please report this!!! *** -%! assert(mean(x),1,0.01); -%! assert(var(x),1,0.03); -%! assert(skewness(x),2,0.06); -%! assert(kurtosis(x),6,0.7); +%! # statistical tests may fail occasionally +%! rande ("seed", 1); +%! x = rande (100000, 1); +%! assert (min (x)>0); # *** Please report this!!! *** +%! assert (mean (x), 1, 0.01); +%! assert (var (x), 1, 0.03); +%! assert (skewness (x), 2, 0.06); +%! assert (kurtosis (x), 6, 0.7); %! endif */ @@ -726,156 +725,165 @@ /* %!test -%! randg("state",12) -%!assert(randg([-inf,-1,0,inf,nan]),[nan,nan,nan,nan,nan]) % *** Please report - +%! randg ("state", 12) +%! assert (randg ([-inf, -1, 0, inf, nan]), [nan, nan, nan, nan, nan]); # *** Please report %!test -%! % Test fixed state -%! randg("state",1); -%! assert (randg(0.1,1,6), [0.0103951513331241 8.335671459898252e-05 0.00138691397249762 0.000587308416993855 0.495590518784736 2.3921917414795e-12],1e-6); +%! # Test fixed state +%! randg ("state", 1); +%! assert (randg (0.1, 1, 6), [0.0103951513331241 8.335671459898252e-05 0.00138691397249762 0.000587308416993855 0.495590518784736 2.3921917414795e-12], 1e-6); %!test -%! % Test fixed state -%! randg("state",1); -%! assert (randg(0.95,1,6), [3.099382433255327 0.3974529788871218 0.644367450750855 1.143261091802246 1.964111762696822 0.04011915547957939],1e-6); +%! # Test fixed state +%! randg ("state", 1); +%! assert (randg (0.95, 1, 6), [3.099382433255327 0.3974529788871218 0.644367450750855 1.143261091802246 1.964111762696822 0.04011915547957939], 1e-6); %!test -%! % Test fixed state -%! randg("state",1); -%! assert (randg(1,1,6), [0.2273389379645993 1.288822625058359 0.2406335209340746 1.218869553370733 1.024649860162554 0.09631230343599533],1e-6); +%! # Test fixed state +%! randg ("state", 1); +%! assert (randg (1, 1, 6), [0.2273389379645993 1.288822625058359 0.2406335209340746 1.218869553370733 1.024649860162554 0.09631230343599533], 1e-6); %!test -%! % Test fixed state -%! randg("state",1); -%! assert (randg(10,1,6), [3.520369644331133 15.15369864472106 8.332112081991205 8.406211067432674 11.81193475187611 10.88792728177059],1e-5); +%! # Test fixed state +%! randg ("state", 1); +%! assert (randg (10, 1, 6), [3.520369644331133 15.15369864472106 8.332112081991205 8.406211067432674 11.81193475187611 10.88792728177059], 1e-5); %!test -%! % Test fixed state -%! randg("state",1); -%! assert (randg(100,1,6), [75.34570255262264 115.4911985594699 95.23493031356388 95.48926019250911 106.2397448229803 103.4813150404118],1e-4); +%! # Test fixed state +%! randg ("state", 1); +%! assert (randg (100, 1, 6), [75.34570255262264 115.4911985594699 95.23493031356388 95.48926019250911 106.2397448229803 103.4813150404118], 1e-4); %!test -%! % Test fixed seed -%! randg("seed",1); -%! assert (randg(0.1,1,6), [0.07144210487604141 0.460641473531723 0.4749028384685516 0.06823389977216721 0.000293838675133884 1.802567535340305e-12],1e-6); +%! # Test fixed seed +%! randg ("seed", 1); +%! assert (randg (0.1, 1, 6), [0.07144210487604141 0.460641473531723 0.4749028384685516 0.06823389977216721 0.000293838675133884 1.802567535340305e-12], 1e-6); %!test -%! % Test fixed seed -%! randg("seed",1); -%! assert (randg(0.95,1,6), [1.664905071258545 1.879976987838745 1.905677795410156 0.9948706030845642 0.5606933236122131 0.0766092911362648],1e-6); +%! # Test fixed seed +%! randg ("seed", 1); +%! assert (randg (0.95, 1, 6), [1.664905071258545 1.879976987838745 1.905677795410156 0.9948706030845642 0.5606933236122131 0.0766092911362648], 1e-6); %!test -%! % Test fixed seed -%! randg("seed",1); -%! assert (randg(1,1,6), [0.03512085229158401 0.6488978862762451 0.8114678859710693 0.1666885763406754 1.60791552066803 1.90356981754303],1e-6); +%! # Test fixed seed +%! randg ("seed", 1); +%! assert (randg (1, 1, 6), [0.03512085229158401 0.6488978862762451 0.8114678859710693 0.1666885763406754 1.60791552066803 1.90356981754303], 1e-6); %!test -%! % Test fixed seed -%! randg("seed",1); -%! assert (randg(10,1,6), [6.566435813903809 10.11648464202881 10.73162078857422 7.747178077697754 6.278522491455078 6.240195751190186],1e-5); +%! # Test fixed seed +%! randg ("seed", 1); +%! assert (randg (10, 1, 6), [6.566435813903809 10.11648464202881 10.73162078857422 7.747178077697754 6.278522491455078 6.240195751190186], 1e-5); %!test -%! % Test fixed seed -%! randg("seed",1); -%! assert (randg(100,1,6), [89.40208435058594 101.4734725952148 103.4020004272461 93.62763214111328 88.33104705810547 88.1871337890625],1e-4); +%! # Test fixed seed +%! randg ("seed", 1); +%! assert (randg (100, 1, 6), [89.40208435058594 101.4734725952148 103.4020004272461 93.62763214111328 88.33104705810547 88.1871337890625], 1e-4); + %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("state",12) -%! a=0.1; x = randg(a,100000,1); -%! assert(mean(x), a, 0.01); -%! assert(var(x), a, 0.01); -%! assert(skewness(x),2/sqrt(a), 1.); -%! assert(kurtosis(x),6/a, 50.); +%! # statistical tests may fail occasionally. +%! randg ("state", 12); +%! a = 0.1; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.01); +%! assert (var (x), a, 0.01); +%! assert (skewness (x), 2/sqrt (a), 1); +%! assert (kurtosis (x), 6/a, 50); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("state",12) -%! a=0.95; x = randg(a,100000,1); -%! assert(mean(x), a, 0.01); -%! assert(var(x), a, 0.04); -%! assert(skewness(x),2/sqrt(a), 0.2); -%! assert(kurtosis(x),6/a, 2.); +%! # statistical tests may fail occasionally. +%! randg ("state", 12); +%! a = 0.95; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.01); +%! assert (var (x), a, 0.04); +%! assert (skewness (x), 2/sqrt (a), 0.2); +%! assert (kurtosis (x), 6/a, 2); +%! endif +%!test +%! if (__random_statistical_tests__) +%! # statistical tests may fail occasionally. +%! randg ("state", 12); +%! a = 1; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.01); +%! assert (var (x), a, 0.04); +%! assert (skewness (x), 2/sqrt (a), 0.2); +%! assert (kurtosis (x), 6/a, 2); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("state",12) -%! a=1; x = randg(a,100000,1); -%! assert(mean(x),a, 0.01); -%! assert(var(x),a, 0.04); -%! assert(skewness(x),2/sqrt(a), 0.2); -%! assert(kurtosis(x),6/a, 2.); +%! # statistical tests may fail occasionally. +%! randg ("state", 12); +%! a = 10; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.1); +%! assert (var (x), a, 0.5); +%! assert (skewness (x), 2/sqrt (a), 0.1); +%! assert (kurtosis (x), 6/a, 0.5); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("state",12) -%! a=10; x = randg(a,100000,1); -%! assert(mean(x), a, 0.1); -%! assert(var(x), a, 0.5); -%! assert(skewness(x),2/sqrt(a), 0.1); -%! assert(kurtosis(x),6/a, 0.5); +%! # statistical tests may fail occasionally. +%! randg ("state", 12); +%! a = 100; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.2); +%! assert (var (x), a, 2); +%! assert (skewness (x), 2/sqrt (a), 0.05); +%! assert (kurtosis (x), 6/a, 0.2); +%! endif +%!test +%! randg ("seed", 12); +%!assert (randg ([-inf, -1, 0, inf, nan]), [nan, nan, nan, nan, nan]) # *** Please report +%!test +%! if (__random_statistical_tests__) +%! # statistical tests may fail occasionally. +%! randg ("seed", 12); +%! a = 0.1; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.01); +%! assert (var (x), a, 0.01); +%! assert (skewness (x), 2/sqrt (a), 1); +%! assert (kurtosis (x), 6/a, 50); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("state",12) -%! a=100; x = randg(a,100000,1); -%! assert(mean(x), a, 0.2); -%! assert(var(x), a, 2.); -%! assert(skewness(x),2/sqrt(a), 0.05); -%! assert(kurtosis(x),6/a, 0.2); +%! # statistical tests may fail occasionally. +%! randg ("seed", 12); +%! a = 0.95; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.01); +%! assert (var (x), a, 0.04); +%! assert (skewness (x), 2/sqrt (a), 0.2); +%! assert (kurtosis (x), 6/a, 2); %! endif %!test -%! randg("seed",12) -%!assert(randg([-inf,-1,0,inf,nan]),[nan,nan,nan,nan,nan]) % *** Please report -%!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("seed",12) -%! a=0.1; x = randg(a,100000,1); -%! assert(mean(x), a, 0.01); -%! assert(var(x), a, 0.01); -%! assert(skewness(x),2/sqrt(a), 1.); -%! assert(kurtosis(x),6/a, 50.); +%! # statistical tests may fail occasionally. +%! randg ("seed", 12); +%! a = 1; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.01); +%! assert (var (x), a, 0.04); +%! assert (skewness (x), 2/sqrt (a), 0.2); +%! assert (kurtosis (x), 6/a, 2); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("seed",12) -%! a=0.95; x = randg(a,100000,1); -%! assert(mean(x), a, 0.01); -%! assert(var(x), a, 0.04); -%! assert(skewness(x),2/sqrt(a), 0.2); -%! assert(kurtosis(x),6/a, 2.); -%! endif -%!test -%! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("seed",12) -%! a=1; x = randg(a,100000,1); -%! assert(mean(x),a, 0.01); -%! assert(var(x),a, 0.04); -%! assert(skewness(x),2/sqrt(a), 0.2); -%! assert(kurtosis(x),6/a, 2.); +%! # statistical tests may fail occasionally. +%! randg ("seed", 12); +%! a = 10; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.1); +%! assert (var (x), a, 0.5); +%! assert (skewness (x), 2/sqrt (a), 0.1); +%! assert (kurtosis (x), 6/a, 0.5); %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("seed",12) -%! a=10; x = randg(a,100000,1); -%! assert(mean(x), a, 0.1); -%! assert(var(x), a, 0.5); -%! assert(skewness(x),2/sqrt(a), 0.1); -%! assert(kurtosis(x),6/a, 0.5); -%! endif -%!test -%! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randg("seed",12) -%! a=100; x = randg(a,100000,1); -%! assert(mean(x), a, 0.2); -%! assert(var(x), a, 2.); -%! assert(skewness(x),2/sqrt(a), 0.05); -%! assert(kurtosis(x),6/a, 0.2); +%! # statistical tests may fail occasionally. +%! randg ("seed", 12); +%! a = 100; +%! x = randg (a, 100000, 1); +%! assert (mean (x), a, 0.2); +%! assert (var (x), a, 2); +%! assert (skewness (x), 2/sqrt (a), 0.05); +%! assert (kurtosis (x), 6/a, 0.2); %! endif */ - DEFUN_DLD (randp, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} randp (@var{l}, @var{n})\n\ @@ -934,86 +942,86 @@ /* %!test -%! randp("state",12) -%!assert(randp([-inf,-1,0,inf,nan]),[nan,nan,0,nan,nan]); % *** Please report +%! randp ("state", 12); +%! assert (randp ([-inf, -1, 0, inf, nan]), [nan, nan, 0, nan, nan]); # *** Please report %!test -%! % Test fixed state -%! randp("state",1); -%! assert(randp(5,1,6),[5 5 3 7 7 3]) +%! # Test fixed state +%! randp ("state", 1); +%! assert (randp (5, 1, 6), [5 5 3 7 7 3]) %!test -%! % Test fixed state -%! randp("state",1); -%! assert(randp(15,1,6),[13 15 8 18 18 15]) +%! # Test fixed state +%! randp ("state", 1); +%! assert (randp (15, 1, 6), [13 15 8 18 18 15]) %!test -%! % Test fixed state -%! randp("state",1); -%! assert(randp(1e9,1,6),[999915677 999976657 1000047684 1000019035 999985749 999977692],-1e-6) +%! # Test fixed state +%! randp ("state", 1); +%! assert (randp (1e9, 1, 6), [999915677 999976657 1000047684 1000019035 999985749 999977692], -1e-6) %!test -%! % Test fixed state -%! randp("seed",1); -%! %%assert(randp(5,1,6),[8 2 3 6 6 8]) -%! assert(randp(5,1,5),[8 2 3 6 6]) +%! # Test fixed state +%! randp ("seed", 1); +%! %%assert (randp (5, 1, 6), [8 2 3 6 6 8]) +%! assert (randp (5, 1, 5), [8 2 3 6 6]) %!test -%! % Test fixed state -%! randp("seed",1); -%! assert(randp(15,1,6),[15 16 12 10 10 12]) +%! # Test fixed state +%! randp ("seed", 1); +%! assert (randp (15, 1, 6), [15 16 12 10 10 12]) %!test -%! % Test fixed state -%! randp("seed",1); -%! assert(randp(1e9,1,6),[1000006208 1000012224 999981120 999963520 999963072 999981440],-1e-6) +%! # Test fixed state +%! randp ("seed", 1); +%! assert (randp (1e9, 1, 6), [1000006208 1000012224 999981120 999963520 999963072 999981440], -1e-6) %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randp("state",12) -%! for a=[5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] -%! x = randp(a(1),100000,1); -%! assert(min(x)>=0); % *** Please report this!!! *** -%! assert(mean(x),a(1),a(2)); -%! assert(var(x),a(1),0.02*a(1)); -%! assert(skewness(x),1/sqrt(a(1)),a(3)); -%! assert(kurtosis(x),1/a(1),3*a(3)); +%! # statistical tests may fail occasionally. +%! randp ("state", 12); +%! for a = [5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] +%! x = randp (a (1), 100000, 1); +%! assert (min (x) >= 0); # *** Please report this!!! *** +%! assert (mean (x), a(1), a(2)); +%! assert (var (x), a(1), 0.02*a(1)); +%! assert (skewness (x), 1/sqrt (a(1)), a(3)); +%! assert (kurtosis (x), 1/a(1), 3*a(3)); %! endfor %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randp("state",12) -%! for a=[5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] -%! x = randp(a(1)*ones(100000,1),100000,1); -%! assert(min(x)>=0); % *** Please report this!!! *** -%! assert(mean(x),a(1),a(2)); -%! assert(var(x),a(1),0.02*a(1)); -%! assert(skewness(x),1/sqrt(a(1)),a(3)); -%! assert(kurtosis(x),1/a(1),3*a(3)); +%! # statistical tests may fail occasionally. +%! randp ("state", 12); +%! for a = [5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] +%! x = randp (a(1)*ones (100000, 1), 100000, 1); +%! assert (min (x) >= 0); # *** Please report this!!! *** +%! assert (mean (x), a(1), a(2)); +%! assert (var (x), a(1), 0.02*a(1)); +%! assert (skewness (x), 1/sqrt (a(1)), a(3)); +%! assert (kurtosis (x), 1/a(1), 3*a(3)); %! endfor %! endif %!test -%! randp("seed",12) -%!assert(randp([-inf,-1,0,inf,nan]),[nan,nan,0,nan,nan]); % *** Please report +%! randp ("seed", 12); +%! assert (randp ([-inf, -1, 0, inf, nan]), [nan, nan, 0, nan, nan]); # *** Please report %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randp("seed",12) -%! for a=[5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] -%! x = randp(a(1),100000,1); -%! assert(min(x)>=0); % *** Please report this!!! *** -%! assert(mean(x),a(1),a(2)); -%! assert(var(x),a(1),0.02*a(1)); -%! assert(skewness(x),1/sqrt(a(1)),a(3)); -%! assert(kurtosis(x),1/a(1),3*a(3)); +%! # statistical tests may fail occasionally. +%! randp ("seed", 12); +%! for a = [5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] +%! x = randp (a(1), 100000, 1); +%! assert (min (x) >= 0); # *** Please report this!!! *** +%! assert (mean (x), a(1), a(2)); +%! assert (var (x), a(1), 0.02*a(1)); +%! assert (skewness (x), 1/sqrt (a(1)), a(3)); +%! assert (kurtosis (x), 1/a(1), 3*a(3)); %! endfor %! endif %!test %! if (__random_statistical_tests__) -%! % statistical tests may fail occasionally. -%! randp("seed",12) -%! for a=[5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] -%! x = randp(a(1)*ones(100000,1),100000,1); -%! assert(min(x)>=0); % *** Please report this!!! *** -%! assert(mean(x),a(1),a(2)); -%! assert(var(x),a(1),0.02*a(1)); -%! assert(skewness(x),1/sqrt(a(1)),a(3)); -%! assert(kurtosis(x),1/a(1),3*a(3)); +%! # statistical tests may fail occasionally. +%! randp ("seed", 12); +%! for a = [5, 15, 1e9; 0.03, 0.03, -5e-3; 0.03, 0.03, 0.03] +%! x = randp (a(1)*ones (100000, 1), 100000, 1); +%! assert (min (x) >= 0); # *** Please report this!!! *** +%! assert (mean (x), a(1), a(2)); +%! assert (var (x), a(1), 0.02*a(1)); +%! assert (skewness (x), 1/sqrt (a(1)), a(3)); +%! assert (kurtosis (x), 1/a(1), 3*a(3)); %! endfor %! endif */ @@ -1126,6 +1134,6 @@ } /* -%!assert(sort (randperm (20)),1:20) -%!assert(length (randperm (20,10)), 10) +%!assert (sort (randperm (20)), 1:20) +%!assert (length (randperm (20,10)), 10) */ diff --git a/src/DLD-FUNCTIONS/rcond.cc b/src/DLD-FUNCTIONS/rcond.cc --- a/src/DLD-FUNCTIONS/rcond.cc +++ b/src/DLD-FUNCTIONS/rcond.cc @@ -87,10 +87,8 @@ } /* - -%!assert( rcond (eye (2)), 1) -%!assert( rcond (ones (2)), 0) -%!assert( rcond ([1 1; 2 1]), 1/9) -%!assert( rcond (magic (4)), 0, eps) - +%!assert (rcond (eye (2)), 1) +%!assert (rcond (ones (2)), 0) +%!assert (rcond ([1 1; 2 1]), 1/9) +%!assert (rcond (magic (4)), 0, eps) */ diff --git a/src/DLD-FUNCTIONS/regexp.cc b/src/DLD-FUNCTIONS/regexp.cc --- a/src/DLD-FUNCTIONS/regexp.cc +++ b/src/DLD-FUNCTIONS/regexp.cc @@ -44,6 +44,93 @@ #include "oct-obj.h" #include "utils.h" +// Replace backslash escapes in a string with the real values. We need +// this special function instead of the one in utils.cc because the set +// of escape sequences used in regexps is different from those used in +// the *printf functions. + +static std::string +do_regexp_string_escapes (const std::string& s) +{ + std::string retval; + + size_t i = 0; + size_t j = 0; + size_t len = s.length (); + + retval.resize (len); + + while (j < len) + { + if (s[j] == '\\' && j+1 < len) + { + switch (s[++j]) + { + case '$': + retval[i] = '$'; + break; + + case 'a': + retval[i] = '\a'; + break; + + case 'b': // backspace + retval[i] = '\b'; + break; + + case 'f': // formfeed + retval[i] = '\f'; + break; + + case 'n': // newline + retval[i] = '\n'; + break; + + case 'r': // carriage return + retval[i] = '\r'; + break; + + case 't': // horizontal tab + retval[i] = '\t'; + break; + + case 'v': // vertical tab + retval[i] = '\v'; + break; + + case '\\': // backslash + retval[i] = '\\'; + break; + +#if 0 +// FIXME -- to be complete, we need to handle \oN, \o{N}, \xN, and +// \x{N}. Hex digits may be upper or lower case. Brackets are +// optional, so \x5Bz is the same as \x{5B}z. + + case 'o': // octal number + case 'x': // hex number +#endif + + default: + retval[i] = '\\'; + retval[++i] = s[j]; + break; + } + } + else + { + retval[i] = s[j]; + } + + i++; + j++; + } + + retval.resize (i); + + return retval; +} + static void parse_options (regexp::opts& options, const octave_value_list& args, const std::string& who, int skip, bool& extra_args) @@ -77,12 +164,16 @@ options.lineanchors (false); else if (str.find ("literalspacing", 0) == 0) options.freespacing (false); + else if (str.find ("noemptymatch", 0) == 0) + options.emptymatch (false); else if (str.find ("dotexceptnewline", 0) == 0) options.dotexceptnewline (true); else if (str.find ("lineanchors", 0) == 0) options.lineanchors (true); else if (str.find ("freespacing", 0) == 0) options.freespacing (true); + else if (str.find ("emptymatch", 0) == 0) + options.emptymatch (true); else if (str.find ("start", 0) == 0 || str.find ("end", 0) == 0 || str.find ("tokenextents", 0) == 0 @@ -109,9 +200,12 @@ if (error_state) return retval; - const std::string pattern = args(1).string_value (); + std::string pattern = args(1).string_value (); if (error_state) return retval; + // Matlab compatibility. + if (args(1).is_sq_string ()) + pattern = do_regexp_string_escapes (pattern); regexp::opts options; options.case_insensitive (case_insensitive); @@ -257,7 +351,9 @@ || str.find ("dotall", 0) == 0 || str.find ("dotexceptnewline", 0) == 0 || str.find ("literalspacing", 0) == 0 - || str.find ("freespacing", 0) == 0) + || str.find ("freespacing", 0) == 0 + || str.find ("noemptymatch", 0) == 0 + || str.find ("emptymatch", 0) == 0) continue; else if (str.find ("start", 0) == 0) k = 0; @@ -488,8 +584,8 @@ operators. For example, a template for a floating point number might be\n\ @code{[-+.\\d]+}.\n\ \n\ -@item ()\n\ -Grouping operator\n\ +@item () (?:)\n\ +Grouping operator. The first form, parentheses only, also creates a token.\n\ \n\ @item |\n\ Alternation operator. Match one of a choice of regular expressions. The\n\ @@ -562,7 +658,8 @@ @code{(?@dots{})}.\n\ \n\ @item sp\n\ -A cell array of the text not returned by match.\n\ +A cell array of the text not returned by match, i.e., what remains if you\n\ +split the string based on @var{pat}.\n\ @end table\n\ \n\ Particular output arguments, or the order of the output arguments, can be\n\ @@ -630,6 +727,15 @@ \n\ Alternatively, use (?x) in the pattern.\n\ \n\ +@item noemptymatch\n\ +Zero-length matches are not returned. (default)\n\ +\n\ +@item emptymatch\n\ +Return zero-length matches.\n\ +\n\ +@code{regexp ('a', 'b*', 'emptymatch'} returns @code{[1 2]} because there are\n\ +zero or more 'b' characters at positions 1 and end-of-string.\n\ +\n\ @end table\n\ @seealso{regexpi, strfind, regexprep}\n\ @end deftypefn") @@ -649,130 +755,129 @@ } /* - ## PCRE_ERROR_MATCHLIMIT test %!test -%! s=sprintf('\t4\n0000\t-0.00\t-0.0000\t4\t-0.00\t-0.0000\t4\n0000\t-0.00\t-0.0000\t0\t-0.00\t-'); -%! ws = warning("query"); +%! s = sprintf ('\t4\n0000\t-0.00\t-0.0000\t4\t-0.00\t-0.0000\t4\n0000\t-0.00\t-0.0000\t0\t-0.00\t-'); +%! ws = warning ("query"); %! unwind_protect -%! warning("off"); -%! regexp(s, '(\s*-*\d+[.]*\d*\s*)+\n'); +%! warning ("off"); +%! regexp (s, '(\s*-*\d+[.]*\d*\s*)+\n'); %! unwind_protect_cleanup -%! warning(ws); +%! warning (ws); %! end_unwind_protect -## seg-fault test -%!assert(regexp("abcde","."),[1,2,3,4,5]) +## segfault test +%!assert (regexp ("abcde", "."), [1,2,3,4,5]) ## Infinite loop test -%!assert (isempty (regexp("abcde", ""))) +%!assert (isempty (regexp ("abcde", ""))) ## Check that anchoring of pattern works correctly -%!assert(regexp('abcabc','^abc'),1); -%!assert(regexp('abcabc','abc$'),4); -%!assert(regexp('abcabc','^abc$'),zeros(1,0)); +%!assert (regexp ('abcabc', '^abc'), 1) +%!assert (regexp ('abcabc', 'abc$'), 4) +%!assert (regexp ('abcabc', '^abc$'), zeros (1,0)) %!test -%! [s, e, te, m, t] = regexp(' No Match ', 'f(.*)uck'); -%! assert (s,zeros(1,0)) -%! assert (e,zeros(1,0)) -%! assert (te,cell(1,0)) -%! assert (m, cell(1,0)) -%! assert (t, cell(1,0)) +%! [s, e, te, m, t] = regexp (' No Match ', 'f(.*)uck'); +%! assert (s, zeros (1,0)); +%! assert (e, zeros (1,0)); +%! assert (te, cell (1,0)); +%! assert (m, cell (1,0)); +%! assert (t, cell (1,0)); %!test -%! [s, e, te, m, t] = regexp(' FiRetrUck ', 'f(.*)uck'); -%! assert (s,zeros(1,0)) -%! assert (e,zeros(1,0)) -%! assert (te,cell(1,0)) -%! assert (m, cell(1,0)) -%! assert (t, cell(1,0)) +%! [s, e, te, m, t] = regexp (' FiRetrUck ', 'f(.*)uck'); +%! assert (s, zeros (1,0)); +%! assert (e, zeros (1,0)); +%! assert (te, cell (1,0)); +%! assert (m, cell (1,0)); +%! assert (t, cell (1,0)); %!test -%! [s, e, te, m, t] = regexp(' firetruck ', 'f(.*)uck'); -%! assert (s,2) -%! assert (e,10) -%! assert (te{1},[3,7]) -%! assert (m{1}, 'firetruck') -%! assert (t{1}{1}, 'iretr') +%! [s, e, te, m, t] = regexp (' firetruck ', 'f(.*)uck'); +%! assert (s, 2); +%! assert (e, 10); +%! assert (te{1}, [3, 7]); +%! assert (m{1}, 'firetruck'); +%! assert (t{1}{1}, 'iretr'); %!test -%! [s, e, te, m, t] = regexp('short test string','\w*r\w*'); -%! assert (s,[1,12]) -%! assert (e,[5,17]) -%! assert (size(te), [1,2]) -%! assert (isempty(te{1})) -%! assert (isempty(te{2})) -%! assert (m{1},'short') -%! assert (m{2},'string') -%! assert (size(t), [1,2]) -%! assert (isempty(t{1})) -%! assert (isempty(t{2})) +%! [s, e, te, m, t] = regexp ('short test string', '\w*r\w*'); +%! assert (s, [1, 12]); +%! assert (e, [5, 17]); +%! assert (size (te), [1, 2]); +%! assert (isempty (te{1})); +%! assert (isempty (te{2})); +%! assert (m{1}, 'short'); +%! assert (m{2}, 'string'); +%! assert (size (t), [1, 2]); +%! assert (isempty (t{1})); +%! assert (isempty (t{2})); %!test -%! [s, e, te, m, t] = regexp('short test string','\w*r\w*','once'); -%! assert (s,1) -%! assert (e,5) -%! assert (isempty(te)) -%! assert (m,'short') -%! assert (isempty(t)) +%! [s, e, te, m, t] = regexp ('short test string', '\w*r\w*', 'once'); +%! assert (s, 1); +%! assert (e, 5); +%! assert (isempty (te)); +%! assert (m, 'short'); +%! assert (isempty (t)); %!test -%! [m, te, e, s, t] = regexp('short test string','\w*r\w*','once', 'match', 'tokenExtents', 'end', 'start', 'tokens'); -%! assert (s,1) -%! assert (e,5) -%! assert (isempty(te)) -%! assert (m,'short') -%! assert (isempty(t)) +%! [m, te, e, s, t] = regexp ('short test string', '\w*r\w*', 'once', 'match', 'tokenExtents', 'end', 'start', 'tokens'); +%! assert (s, 1); +%! assert (e, 5); +%! assert (isempty (te)); +%! assert (m, 'short'); +%! assert (isempty (t)); %!test -%! [s, e, te, m, t, nm] = regexp('short test string','(?\w*t)\s*(?\w*t)'); -%! assert (s,1) -%! assert (e,10) -%! assert (size(te), [1,1]) -%! assert (te{1}, [1 5; 7, 10]) -%! assert (m{1},'short test') -%! assert (size(t),[1,1]) -%! assert (t{1}{1},'short') -%! assert (t{1}{2},'test') -%! assert (size(nm), [1,1]) -%! assert (!isempty(fieldnames(nm))) -%! assert (sort(fieldnames(nm)),{'word1';'word2'}) -%! assert (nm.word1,'short') -%! assert (nm.word2,'test') +%! [s, e, te, m, t, nm] = regexp ('short test string', '(?\w*t)\s*(?\w*t)'); +%! assert (s, 1); +%! assert (e, 10); +%! assert (size (te), [1, 1]); +%! assert (te{1}, [1,5; 7,10]); +%! assert (m{1}, 'short test'); +%! assert (size (t), [1, 1]); +%! assert (t{1}{1}, 'short'); +%! assert (t{1}{2}, 'test'); +%! assert (size (nm), [1, 1]); +%! assert (! isempty (fieldnames (nm))); +%! assert (sort (fieldnames (nm)), {'word1';'word2'}); +%! assert (nm.word1, 'short'); +%! assert (nm.word2, 'test'); %!test -%! [nm, m, te, e, s, t] = regexp('short test string','(?\w*t)\s*(?\w*t)', 'names', 'match', 'tokenExtents', 'end', 'start', 'tokens'); -%! assert (s,1) -%! assert (e,10) -%! assert (size(te), [1,1]) -%! assert (te{1}, [1 5; 7, 10]) -%! assert (m{1},'short test') -%! assert (size(t),[1,1]) -%! assert (t{1}{1},'short') -%! assert (t{1}{2},'test') -%! assert (size(nm), [1,1]) -%! assert (!isempty(fieldnames(nm))) -%! assert (sort(fieldnames(nm)),{'word1';'word2'}) -%! assert (nm.word1,'short') -%! assert (nm.word2,'test') +%! [nm, m, te, e, s, t] = regexp ('short test string', '(?\w*t)\s*(?\w*t)', 'names', 'match', 'tokenExtents', 'end', 'start', 'tokens'); +%! assert (s, 1); +%! assert (e, 10); +%! assert (size (te), [1, 1]); +%! assert (te{1}, [1,5; 7,10]); +%! assert (m{1}, 'short test'); +%! assert (size (t), [1, 1]); +%! assert (t{1}{1}, 'short'); +%! assert (t{1}{2}, 'test'); +%! assert (size (nm), [1, 1]); +%! assert (!isempty (fieldnames (nm))); +%! assert (sort (fieldnames (nm)), {'word1';'word2'}); +%! assert (nm.word1, 'short'); +%! assert (nm.word2, 'test'); %!test -%! [t, nm] = regexp("John Davis\nRogers, James",'(?\w+)\s+(?\w+)|(?\w+),\s+(?\w+)','tokens','names'); -%! assert (size(t), [1,2]); -%! assert (t{1}{1},'John'); -%! assert (t{1}{2},'Davis'); -%! assert (t{2}{1},'Rogers'); -%! assert (t{2}{2},'James'); -%! assert (size(nm), [1,1]); -%! assert (nm.first{1},'John'); -%! assert (nm.first{2},'James'); -%! assert (nm.last{1},'Davis'); -%! assert (nm.last{2},'Rogers'); +%! [t, nm] = regexp ("John Davis\nRogers, James", '(?\w+)\s+(?\w+)|(?\w+),\s+(?\w+)', 'tokens', 'names'); +%! assert (size (t), [1, 2]); +%! assert (t{1}{1}, 'John'); +%! assert (t{1}{2}, 'Davis'); +%! assert (t{2}{1}, 'Rogers'); +%! assert (t{2}{2}, 'James'); +%! assert (size (nm), [1, 1]); +%! assert (nm.first{1}, 'John'); +%! assert (nm.first{2}, 'James'); +%! assert (nm.last{1}, 'Davis'); +%! assert (nm.last{2}, 'Rogers'); ## Tests for named tokens %!test %! # Parenthesis in named token (ie (int)) causes a problem -%! assert (regexp('qwe int asd', ['(?(int))'], 'names'), struct ('typestr', 'int')); +%! assert (regexp ('qwe int asd', ['(?(int))'], 'names'), struct ('typestr', 'int')); %!test %! ## Mix of named and unnamed tokens can cause segfault (bug #35683) @@ -783,51 +888,90 @@ %! assert (tokens.T1, "a"); %! assert (tokens.T2, "de"); -%!assert(regexp("abc\nabc",'.'),[1:7]) -%!assert(regexp("abc\nabc",'.','dotall'),[1:7]) +%!assert (regexp ("abc\nabc", '.'), [1:7]) +%!assert (regexp ("abc\nabc", '.', 'dotall'), [1:7]) %!test -%! assert(regexp("abc\nabc",'(?s).'),[1:7]) -%! assert(regexp("abc\nabc",'.','dotexceptnewline'),[1,2,3,5,6,7]) -%! assert(regexp("abc\nabc",'(?-s).'),[1,2,3,5,6,7]) +%! assert (regexp ("abc\nabc", '(?s).'), [1:7]); +%! assert (regexp ("abc\nabc", '.', 'dotexceptnewline'), [1,2,3,5,6,7]); +%! assert (regexp ("abc\nabc", '(?-s).'), [1,2,3,5,6,7]); + +%!assert (regexp ("caseCaSe", 'case'), 1) +%!assert (regexp ("caseCaSe", 'case', "matchcase"), 1) +%!assert (regexp ("caseCaSe", 'case', "ignorecase"), [1,5]) +%!test +%! assert (regexp ("caseCaSe", '(?-i)case'), 1); +%! assert (regexp ("caseCaSe", '(?i)case'), [1, 5]); -%!assert(regexp("caseCaSe",'case'),1) -%!assert(regexp("caseCaSe",'case',"matchcase"),1) -%!assert(regexp("caseCaSe",'case',"ignorecase"),[1,5]) +%!assert (regexp ("abc\nabc", 'c$'), 7) +%!assert (regexp ("abc\nabc", 'c$', "stringanchors"), 7) %!test -%! assert(regexp("caseCaSe",'(?-i)case'),1) -%! assert(regexp("caseCaSe",'(?i)case'),[1,5]) +%! assert (regexp ("abc\nabc", '(?-m)c$'), 7); +%! assert (regexp ("abc\nabc", 'c$',"lineanchors"), [3, 7]); +%! assert (regexp ("abc\nabc", '(?m)c$'), [3,7]); -%!assert (regexp("abc\nabc",'c$'),7) -%!assert (regexp("abc\nabc",'c$',"stringanchors"),7) +%!assert (regexp ("this word", 's w'), 4) +%!assert (regexp ("this word", 's w', 'literalspacing'), 4) +%!test +%! assert (regexp ("this word", '(?-x)s w', 'literalspacing'), 4); +%! assert (regexp ("this word", 's w', 'freespacing'), zeros (1,0)); +%! assert (regexp ("this word", '(?x)s w'), zeros (1,0)); + %!test -%! assert (regexp("abc\nabc",'(?-m)c$'),7) -%! assert (regexp("abc\nabc",'c$',"lineanchors"),[3,7]) -%! assert (regexp("abc\nabc",'(?m)c$'),[3,7]) +%! [s, e, te, m, t, nm, sp] = regexp ('OCTAVE', '[VOCT]*', 'noemptymatch'); +%! assert (s, [1 5]); +%! assert (e, [3 5]); +%! assert (te, { zeros(0,2), zeros(0,2) }); +%! assert (m, { "OCT", "V" }); +%! assert (t, { cell(1,0), cell(1,0) }); +%! assert (isempty (fieldnames (nm))); +%! assert (sp, { "", "A", "E" }); -%!assert (regexp("this word",'s w'),4) -%!assert (regexp("this word",'s w','literalspacing'),4) +%!test +%! [s, e, te, m, t, nm, sp] = regexp ('OCTAVE', '([VOCT]*)', 'noemptymatch'); +%! assert (s, [1 5]); +%! assert (e, [3 5]); +%! assert (te, { [1 3], [5 5] }); +%! assert (m, { "OCT", "V" }); +%! assert (t, { {"OCT"}, {"V"} }); +%! assert (isempty (fieldnames (nm))); +%! assert (sp, { "", "A", "E" }); + %!test -%! assert (regexp("this word",'(?-x)s w','literalspacing'),4) -%! assert (regexp("this word",'s w','freespacing'),zeros(1,0)) -%! assert (regexp("this word",'(?x)s w'),zeros(1,0)) +%! [s, e, te, m, t, nm, sp] = regexp ('OCTAVE', '[VOCT]*', 'emptymatch'); +%! assert (s, [1 4 5 6 7]); +%! assert (e, [3 3 5 5 6]); +%! assert (te, repmat ({zeros(0,2)}, [1, 5])); +%! assert (m, { "OCT", "", "V", "", "" }); +%! assert (t, repmat({cell(1,0)}, [1, 5])); +%! assert (isempty (fieldnames (nm))); +%! assert (sp, { "", "", "A", "", "E", "" }); -%!error regexp('string', 'tri', 'BadArg'); -%!error regexp('string'); +%!test +%! [s, e, te, m, t, nm, sp] = regexp ('OCTAVE', '([VOCT]*)', 'emptymatch'); +%! assert (s, [1 4 5 6 7]); +%! assert (e, [3 3 5 5 6]); +%! assert (te, { [1 3], [4 3], [5 5], [6 5], [7 6] }); +%! assert (m, { "OCT", "", "V", "", "" }); +%! assert (t, { {"OCT"}, {""}, {"V"}, {""}, {""} }); +%! assert (isempty (fieldnames (nm))); +%! assert (sp, { "", "", "A", "", "E", "" }); -%!assert(regexp({'asdfg-dfd';'-dfd-dfd-';'qasfdfdaq'},'-'),{6;[1,5,9];zeros(1,0)}) -%!assert(regexp({'asdfg-dfd','-dfd-dfd-','qasfdfdaq'},'-'),{6,[1,5,9],zeros(1,0)}) -%!assert(regexp({'asdfg-dfd';'-dfd-dfd-';'qasfdfdaq'},{'-';'f';'q'}),{6;[3,7];[1,9]}) -%!assert(regexp('Strings',{'t','s'}),{2,7}) +%!error regexp ('string', 'tri', 'BadArg') +%!error regexp ('string') + +%!assert (regexp ({'asdfg-dfd';'-dfd-dfd-';'qasfdfdaq'}, '-'), {6;[1,5,9];zeros(1,0)}) +%!assert (regexp ({'asdfg-dfd';'-dfd-dfd-';'qasfdfdaq'}, {'-';'f';'q'}), {6;[3,7];[1,9]}) +%!assert (regexp ('Strings', {'t','s'}), {2, 7}) ## Test case for lookaround operators %!test -%! assert(regexp('Iraq','q(?!u)'),4) -%! assert(regexp('quit','q(?!u)'), zeros(1,0)) -%! assert(regexp('quit','q(?=u)','match'), {'q'}) -%! assert(regexp("quit",'q(?=u+)','match'), {'q'}) -%! assert(regexp("qit",'q(?=u+)','match'), cell(1,0)) -%! assert(regexp("qit",'q(?=u*)','match'), {'q'}) -%! assert(regexp('thingamabob','(?<=a)b'), 9) +%! assert (regexp ('Iraq', 'q(?!u)'), 4); +%! assert (regexp ('quit', 'q(?!u)'), zeros (1, 0)); +%! assert (regexp ('quit', 'q(?=u)' , 'match'), {'q'}); +%! assert (regexp ("quit", 'q(?=u+)', 'match'), {'q'}); +%! assert (regexp ("qit", 'q(?=u+)', 'match'), cell (1, 0)); +%! assert (regexp ("qit", 'q(?=u*)', 'match'), {'q'}); +%! assert (regexp ('thingamabob', '(?<=a)b'), 9); ## Tests for split option. %!shared str @@ -846,8 +990,8 @@ %! assert (b, {"foo bar foo"}); %!test %! [a, b] = regexp (str, "fx.", "match", "split", "once"); -%! assert (a, ""); -%! assert (b, "foo bar foo") +%! assert (a, "");; +%! assert (b, "foo bar foo"); %!shared str %! str = "foo bar"; @@ -868,6 +1012,8 @@ %! assert (a, {"oo"}); %! assert (b, {"f", " bar"}); +%!assert (regexp ("\n", '\n'), 1); +%!assert (regexp ("\n", "\n"), 1); */ DEFUN_DLD (regexpi, args, nargout, @@ -897,139 +1043,139 @@ } /* - -## seg-fault test -%!assert(regexpi("abcde","."),[1,2,3,4,5]) +## segfault test +%!assert (regexpi ("abcde", "."), [1,2,3,4,5]) ## Check that anchoring of pattern works correctly -%!assert(regexpi('abcabc','^ABC'),1); -%!assert(regexpi('abcabc','ABC$'),4); -%!assert(regexpi('abcabc','^ABC$'),zeros(1,0)); +%!assert (regexpi ('abcabc', '^ABC'), 1) +%!assert (regexpi ('abcabc', 'ABC$'), 4) +%!assert (regexpi ('abcabc', '^ABC$'), zeros (1,0)) %!test -%! [s, e, te, m, t] = regexpi(' No Match ', 'f(.*)uck'); -%! assert (s,zeros(1,0)) -%! assert (e,zeros(1,0)) -%! assert (te,cell(1,0)) -%! assert (m, cell(1,0)) -%! assert (t, cell(1,0)) +%! [s, e, te, m, t] = regexpi (' No Match ', 'f(.*)uck'); +%! assert (s, zeros (1,0)); +%! assert (e, zeros (1,0)); +%! assert (te, cell (1,0)); +%! assert (m, cell (1,0)); +%! assert (t, cell (1,0)); %!test -%! [s, e, te, m, t] = regexpi(' FiRetrUck ', 'f(.*)uck'); -%! assert (s,2) -%! assert (e,10) -%! assert (te{1},[3,7]) -%! assert (m{1}, 'FiRetrUck') -%! assert (t{1}{1}, 'iRetr') +%! [s, e, te, m, t] = regexpi (' FiRetrUck ', 'f(.*)uck'); +%! assert (s, 2); +%! assert (e, 10); +%! assert (te{1}, [3, 7]); +%! assert (m{1}, 'FiRetrUck'); +%! assert (t{1}{1}, 'iRetr'); %!test -%! [s, e, te, m, t] = regexpi(' firetruck ', 'f(.*)uck'); -%! assert (s,2) -%! assert (e,10) -%! assert (te{1},[3,7]) -%! assert (m{1}, 'firetruck') -%! assert (t{1}{1}, 'iretr') +%! [s, e, te, m, t] = regexpi (' firetruck ', 'f(.*)uck'); +%! assert (s, 2); +%! assert (e, 10); +%! assert (te{1}, [3, 7]); +%! assert (m{1}, 'firetruck'); +%! assert (t{1}{1}, 'iretr'); %!test -%! [s, e, te, m, t] = regexpi('ShoRt Test String','\w*r\w*'); -%! assert (s,[1,12]) -%! assert (e,[5,17]) -%! assert (size(te), [1,2]) -%! assert (isempty(te{1})) -%! assert (isempty(te{2})) -%! assert (m{1},'ShoRt') -%! assert (m{2},'String') -%! assert (size(t), [1,2]) -%! assert (isempty(t{1})) -%! assert (isempty(t{2})) +%! [s, e, te, m, t] = regexpi ('ShoRt Test String', '\w*r\w*'); +%! assert (s, [1, 12]); +%! assert (e, [5, 17]); +%! assert (size (te), [1, 2]); +%! assert (isempty (te{1})); +%! assert (isempty (te{2})); +%! assert (m{1}, 'ShoRt'); +%! assert (m{2}, 'String'); +%! assert (size (t), [1, 2]); +%! assert (isempty (t{1})); +%! assert (isempty (t{2})); %!test -%! [s, e, te, m, t] = regexpi('ShoRt Test String','\w*r\w*','once'); -%! assert (s,1) -%! assert (e,5) -%! assert (isempty(te)) -%! assert (m,'ShoRt') -%! assert (isempty(t)) +%! [s, e, te, m, t] = regexpi ('ShoRt Test String', '\w*r\w*', 'once'); +%! assert (s, 1); +%! assert (e, 5); +%! assert (isempty (te)); +%! assert (m, 'ShoRt'); +%! assert (isempty (t)); %!test -%! [m, te, e, s, t] = regexpi('ShoRt Test String','\w*r\w*','once', 'match', 'tokenExtents', 'end', 'start', 'tokens'); -%! assert (s,1) -%! assert (e,5) -%! assert (isempty(te)) -%! assert (m,'ShoRt') -%! assert (isempty(t)) +%! [m, te, e, s, t] = regexpi ('ShoRt Test String', '\w*r\w*', 'once', 'match', 'tokenExtents', 'end', 'start', 'tokens'); +%! assert (s, 1); +%! assert (e, 5); +%! assert (isempty (te)); +%! assert (m, 'ShoRt'); +%! assert (isempty (t)); %!test -%! [s, e, te, m, t, nm] = regexpi('ShoRt Test String','(?\w*t)\s*(?\w*t)'); -%! assert (s,1) -%! assert (e,10) -%! assert (size(te), [1,1]) -%! assert (te{1}, [1 5; 7, 10]) -%! assert (m{1},'ShoRt Test') -%! assert (size(t),[1,1]) -%! assert (t{1}{1},'ShoRt') -%! assert (t{1}{2},'Test') -%! assert (size(nm), [1,1]) -%! assert (!isempty(fieldnames(nm))) -%! assert (sort(fieldnames(nm)),{'word1';'word2'}) -%! assert (nm.word1,'ShoRt') -%! assert (nm.word2,'Test') +%! [s, e, te, m, t, nm] = regexpi ('ShoRt Test String', '(?\w*t)\s*(?\w*t)'); +%! assert (s, 1); +%! assert (e, 10); +%! assert (size (te), [1, 1]); +%! assert (te{1}, [1,5; 7,10]); +%! assert (m{1}, 'ShoRt Test'); +%! assert (size (t), [1, 1]); +%! assert (t{1}{1}, 'ShoRt'); +%! assert (t{1}{2}, 'Test'); +%! assert (size (nm), [1, 1]); +%! assert (! isempty (fieldnames (nm))); +%! assert (sort (fieldnames (nm)), {'word1';'word2'}); +%! assert (nm.word1, 'ShoRt'); +%! assert (nm.word2, 'Test'); %!test -%! [nm, m, te, e, s, t] = regexpi('ShoRt Test String','(?\w*t)\s*(?\w*t)', 'names', 'match', 'tokenExtents', 'end', 'start', 'tokens'); -%! assert (s,1) -%! assert (e,10) -%! assert (size(te), [1,1]) -%! assert (te{1}, [1 5; 7, 10]) -%! assert (m{1},'ShoRt Test') -%! assert (size(t),[1,1]) -%! assert (t{1}{1},'ShoRt') -%! assert (t{1}{2},'Test') -%! assert (size(nm), [1,1]) -%! assert (!isempty(fieldnames(nm))) -%! assert (sort(fieldnames(nm)),{'word1';'word2'}) -%! assert (nm.word1,'ShoRt') -%! assert (nm.word2,'Test') +%! [nm, m, te, e, s, t] = regexpi ('ShoRt Test String', '(?\w*t)\s*(?\w*t)', 'names', 'match', 'tokenExtents', 'end', 'start', 'tokens'); +%! assert (s, 1); +%! assert (e, 10); +%! assert (size (te), [1, 1]); +%! assert (te{1}, [1,5; 7,10]); +%! assert (m{1}, 'ShoRt Test'); +%! assert (size (t), [1, 1]); +%! assert (t{1}{1}, 'ShoRt'); +%! assert (t{1}{2}, 'Test'); +%! assert (size (nm), [1, 1]); +%! assert (!isempty (fieldnames (nm))); +%! assert (sort (fieldnames (nm)), {'word1';'word2'}); +%! assert (nm.word1, 'ShoRt'); +%! assert (nm.word2, 'Test'); -%!assert(regexpi("abc\nabc",'.'),[1:7]) -%!assert(regexpi("abc\nabc",'.','dotall'),[1:7]) +%!assert (regexpi ("abc\nabc", '.'), [1:7]) +%!assert (regexpi ("abc\nabc", '.', 'dotall'), [1:7]) %!test -%! assert(regexpi("abc\nabc",'(?s).'),[1:7]) -%! assert(regexpi("abc\nabc",'.','dotexceptnewline'),[1,2,3,5,6,7]) -%! assert(regexpi("abc\nabc",'(?-s).'),[1,2,3,5,6,7]) +%! assert (regexpi ("abc\nabc", '(?s).'), [1:7]); +%! assert (regexpi ("abc\nabc", '.', 'dotexceptnewline'), [1,2,3,5,6,7]); +%! assert (regexpi ("abc\nabc", '(?-s).'), [1,2,3,5,6,7]); -%!assert(regexpi("caseCaSe",'case'),[1,5]) -%!assert(regexpi("caseCaSe",'case',"matchcase"),1) -%!assert(regexpi("caseCaSe",'case',"ignorecase"),[1,5]) +%!assert (regexpi ("caseCaSe", 'case'), [1, 5]) +%!assert (regexpi ("caseCaSe", 'case', "matchcase"), 1) +%!assert (regexpi ("caseCaSe", 'case', "ignorecase"), [1, 5]) %!test -%! assert(regexpi("caseCaSe",'(?-i)case'),1) -%! assert(regexpi("caseCaSe",'(?i)case'),[1,5]) +%! assert (regexpi ("caseCaSe", '(?-i)case'), 1); +%! assert (regexpi ("caseCaSe", '(?i)case'), [1, 5]); -%!assert (regexpi("abc\nabc",'C$'),7) -%!assert (regexpi("abc\nabc",'C$',"stringanchors"),7) +%!assert (regexpi ("abc\nabc", 'C$'), 7) +%!assert (regexpi ("abc\nabc", 'C$', "stringanchors"), 7) %!test -%! assert (regexpi("abc\nabc",'(?-m)C$'),7) -%! assert (regexpi("abc\nabc",'C$',"lineanchors"),[3,7]) -%! assert (regexpi("abc\nabc",'(?m)C$'),[3,7]) +%! assert (regexpi ("abc\nabc", '(?-m)C$'), 7); +%! assert (regexpi ("abc\nabc", 'C$', "lineanchors"), [3, 7]); +%! assert (regexpi ("abc\nabc", '(?m)C$'), [3, 7]); -%!assert (regexpi("this word",'S w'),4) -%!assert (regexpi("this word",'S w','literalspacing'),4) +%!assert (regexpi ("this word", 'S w'), 4) +%!assert (regexpi ("this word", 'S w', 'literalspacing'), 4) %!test -%! assert (regexpi("this word",'(?-x)S w','literalspacing'),4) -%! assert (regexpi("this word",'S w','freespacing'),zeros(1,0)) -%! assert (regexpi("this word",'(?x)S w'),zeros(1,0)) +%! assert (regexpi ("this word", '(?-x)S w', 'literalspacing'), 4); +%! assert (regexpi ("this word", 'S w', 'freespacing'), zeros (1,0)); +%! assert (regexpi ("this word", '(?x)S w'), zeros (1,0)); -%!error regexpi('string', 'tri', 'BadArg'); -%!error regexpi('string'); +%!error regexpi ('string', 'tri', 'BadArg') +%!error regexpi ('string') -%!assert(regexpi({'asdfg-dfd';'-dfd-dfd-';'qasfdfdaq'},'-'),{6;[1,5,9];zeros(1,0)}) -%!assert(regexpi({'asdfg-dfd','-dfd-dfd-','qasfdfdaq'},'-'),{6,[1,5,9],zeros(1,0)}) -%!assert(regexpi({'asdfg-dfd';'-dfd-dfd-';'qasfdfdaq'},{'-';'f';'q'}),{6;[3,7];[1,9]}) -%!assert(regexpi('Strings',{'t','s'}),{2,[1,7]}) +%!assert (regexpi ({'asdfg-dfd';'-dfd-dfd-';'qasfdfdaq'}, '-'), {6;[1,5,9];zeros(1, 0)}) +%!assert (regexpi ({'asdfg-dfd', '-dfd-dfd-', 'qasfdfdaq'}, '-'), {6, [1,5,9], zeros(1,0)}) +%!assert (regexpi ({'asdfg-dfd';'-dfd-dfd-';'qasfdfdaq'}, {'-';'f';'q'}), {6;[3,7];[1,9]}) +%!assert (regexpi ('Strings', {'t', 's'}), {2, [1, 7]}) +%!assert (regexpi ("\n", '\n'), 1); +%!assert (regexpi ("\n", "\n"), 1); */ - static octave_value octregexprep (const octave_value_list &args, const std::string &who) { @@ -1042,13 +1188,19 @@ if (error_state) return retval; - const std::string pattern = args(1).string_value (); + std::string pattern = args(1).string_value (); if (error_state) return retval; + // Matlab compatibility. + if (args(1).is_sq_string ()) + pattern = do_regexp_string_escapes (pattern); - const std::string replacement = args(2).string_value (); + std::string replacement = args(2).string_value (); if (error_state) return retval; + // Matlab compatibility. + if (args(2).is_sq_string ()) + replacement = do_regexp_string_escapes (replacement); // Pack options excluding 'tokenize' and various output // reordering strings into regexp arg list @@ -1196,56 +1348,61 @@ /* %!test # Replace with empty %! xml = ' some stuff'; -%! t = regexprep(xml,'<[!?][^>]*>',''); -%! assert(t,' some stuff') +%! t = regexprep (xml, '<[!?][^>]*>', ''); +%! assert (t, ' some stuff'); %!test # Replace with non-empty %! xml = ' some stuff'; -%! t = regexprep(xml,'<[!?][^>]*>','?'); -%! assert(t,'? some stuff?') +%! t = regexprep (xml, '<[!?][^>]*>', '?'); +%! assert (t, '? some stuff?'); %!test # Check that 'tokenize' is ignored %! xml = ' some stuff'; -%! t = regexprep(xml,'<[!?][^>]*>','','tokenize'); -%! assert(t,' some stuff') +%! t = regexprep (xml, '<[!?][^>]*>', '', 'tokenize'); +%! assert (t, ' some stuff'); ## Test capture replacement %!test %! data = "Bob Smith\nDavid Hollerith\nSam Jenkins"; %! result = "Smith, Bob\nHollerith, David\nJenkins, Sam"; -%! t = regexprep(data,'(?m)^(\w+)\s+(\w+)$','$2, $1'); -%! assert(t,result) +%! t = regexprep (data, '(?m)^(\w+)\s+(\w+)$', '$2, $1'); +%! assert (t, result); ## Return the original if no match -%!assert(regexprep('hello','world','earth'),'hello') +%!assert (regexprep ('hello', 'world', 'earth'), 'hello') + +## Test emptymatch +%!assert (regexprep ('World', '^', 'Hello '), 'World') +%!assert (regexprep ('World', '^', 'Hello ', 'emptymatch'), 'Hello World') ## Test a general replacement -%!assert(regexprep("a[b]c{d}e-f=g", "[^A-Za-z0-9_]", "_"), "a_b_c_d_e_f_g"); +%!assert (regexprep ("a[b]c{d}e-f=g", "[^A-Za-z0-9_]", "_"), "a_b_c_d_e_f_g") ## Make sure it works at the beginning and end -%!assert(regexprep("a[b]c{d}e-f=g", "a", "_"), "_[b]c{d}e-f=g"); -%!assert(regexprep("a[b]c{d}e-f=g", "g", "_"), "a[b]c{d}e-f=_"); +%!assert (regexprep ("a[b]c{d}e-f=g", "a", "_"), "_[b]c{d}e-f=g") +%!assert (regexprep ("a[b]c{d}e-f=g", "g", "_"), "a[b]c{d}e-f=_") ## Options -%!assert(regexprep("a[b]c{d}e-f=g", "[^A-Za-z0-9_]", "_", "once"), "a_b]c{d}e-f=g"); -%!assert(regexprep("a[b]c{d}e-f=g", "[^A-Z0-9_]", "_", "ignorecase"), "a_b_c_d_e_f_g"); +%!assert (regexprep ("a[b]c{d}e-f=g", "[^A-Za-z0-9_]", "_", "once"), "a_b]c{d}e-f=g") +%!assert (regexprep ("a[b]c{d}e-f=g", "[^A-Z0-9_]", "_", "ignorecase"), "a_b_c_d_e_f_g") ## Option combinations -%!assert(regexprep("a[b]c{d}e-f=g", "[^A-Z0-9_]", "_", "once", "ignorecase"), "a_b]c{d}e-f=g"); +%!assert (regexprep ("a[b]c{d}e-f=g", "[^A-Z0-9_]", "_", "once", "ignorecase"), "a_b]c{d}e-f=g") ## End conditions on replacement -%!assert(regexprep("abc","(b)",".$1"),"a.bc"); -%!assert(regexprep("abc","(b)","$1"),"abc"); -%!assert(regexprep("abc","(b)","$1."),"ab.c"); -%!assert(regexprep("abc","(b)","$1.."),"ab..c"); +%!assert (regexprep ("abc", "(b)", ".$1"), "a.bc"); +%!assert (regexprep ("abc", "(b)", "$1"), "abc"); +%!assert (regexprep ("abc", "(b)", "$1."), "ab.c"); +%!assert (regexprep ("abc", "(b)", "$1.."), "ab..c"); ## Test cell array arguments -%!assert(regexprep("abc",{"b","a"},"?"),"??c") -%!assert(regexprep({"abc","cba"},"b","?"),{"a?c","c?a"}) -%!assert(regexprep({"abc","cba"},{"b","a"},{"?","!"}),{"!?c","c?!"}) +%!assert (regexprep ("abc", {"b","a"}, "?"), "??c") +%!assert (regexprep ({"abc","cba"}, "b", "?"), {"a?c","c?a"}) +%!assert (regexprep ({"abc","cba"}, {"b","a"}, {"?","!"}), {"!?c","c?!"}) # Nasty lookbehind expression -%!test -%! assert(regexprep('x^(-1)+y(-1)+z(-1)=0','(?<=[a-z]+)\(\-[1-9]*\)','_minus1'),'x^(-1)+y_minus1+z_minus1=0') +%!assert (regexprep ('x^(-1)+y(-1)+z(-1)=0', '(?<=[a-z]+)\(\-[1-9]*\)', '_minus1'),'x^(-1)+y_minus1+z_minus1=0') +%!assert (regexprep ("\n", '\n', "X"), "X"); +%!assert (regexprep ("\n", "\n", "X"), "X"); */ diff --git a/src/DLD-FUNCTIONS/schur.cc b/src/DLD-FUNCTIONS/schur.cc --- a/src/DLD-FUNCTIONS/schur.cc +++ b/src/DLD-FUNCTIONS/schur.cc @@ -275,23 +275,21 @@ } /* - %!test %! a = [1, 2, 3; 4, 5, 9; 7, 8, 6]; %! [u, s] = schur (a); -%! assert(u' * a * u, s, sqrt (eps)); +%! assert (u' * a * u, s, sqrt (eps)); %!test -%! a = single([1, 2, 3; 4, 5, 9; 7, 8, 6]); +%! a = single ([1, 2, 3; 4, 5, 9; 7, 8, 6]); %! [u, s] = schur (a); -%! assert(u' * a * u, s, sqrt (eps('single'))); +%! assert (u' * a * u, s, sqrt (eps ("single"))); %!test -%! fail("schur ([1, 2; 3, 4], 2)","warning"); +%! fail("schur ([1, 2; 3, 4], 2)", "warning"); -%!error schur (); -%!error schur ([1, 2, 3; 4, 5, 6]); - +%!error schur () +%!error schur ([1, 2, 3; 4, 5, 6]) */ DEFUN_DLD (rsf2csf, args, nargout, @@ -361,24 +359,23 @@ } /* - %!test %! A = [1, 1, 1, 2; 1, 2, 1, 1; 1, 1, 3, 1; -2, 1, 1, 1]; %! [u, t] = schur (A); %! [U, T] = rsf2csf (u, t); -%! assert (norm (u * t * u' - U * T * U'), 0, 1e-12) -%! assert (norm (A - U * T * U'), 0, 1e-12) +%! assert (norm (u * t * u' - U * T * U'), 0, 1e-12); +%! assert (norm (A - U * T * U'), 0, 1e-12); %!test %! A = rand (10); %! [u, t] = schur (A); %! [U, T] = rsf2csf (u, t); -%! assert (norm (tril (T, -1)), 0) -%! assert (norm (U * U'), 1, 1e-14) +%! assert (norm (tril (T, -1)), 0); +%! assert (norm (U * U'), 1, 1e-14); %!test %! A = [0, 1;-1, 0]; %! [u, t] = schur (A); %! [U, T] = rsf2csf (u,t); -%! assert (U * T * U', A, 1e-14) +%! assert (U * T * U', A, 1e-14); */ diff --git a/src/DLD-FUNCTIONS/spparms.cc b/src/DLD-FUNCTIONS/spparms.cc --- a/src/DLD-FUNCTIONS/spparms.cc +++ b/src/DLD-FUNCTIONS/spparms.cc @@ -178,7 +178,6 @@ } /* - %!test %! old_vals = spparms (); # save state %! spparms ("defaults"); @@ -196,13 +195,14 @@ %! spparms (old_vals); # restore state %% Test input validation -%!error (spparms (1, 2, 3)) -%!error ([x, y, z] = spparms ()) -%!error (spparms ("UNKNOWN_KEY")) -%!error (spparms ({1, 2, 3})) -%!error (spparms (ones (14, 1))) -%!error (spparms (1, 1)) -%!error (spparms ("ths_rel", "hello")) -%!error (spparms ("UNKNOWN_KEY", 1)) - +%!error spparms (1, 2, 3) +%!error [x, y, z] = spparms () +%!error spparms ("UNKNOWN_KEY") +%!#error spparms ({1, 2, 3}) +%!error spparms ({1, 2, 3}) +%!error spparms (ones (14, 1)) +%!error spparms (1, 1) +%!#error spparms ("ths_rel", "hello") +%!error spparms ("ths_rel", "hello") +%!error spparms ("UNKNOWN_KEY", 1) */ diff --git a/src/DLD-FUNCTIONS/sqrtm.cc b/src/DLD-FUNCTIONS/sqrtm.cc --- a/src/DLD-FUNCTIONS/sqrtm.cc +++ b/src/DLD-FUNCTIONS/sqrtm.cc @@ -260,20 +260,17 @@ } /* - %!assert (sqrtm (2*ones (2)), ones (2), 3*eps) ## The following two tests are from the reference in the docstring above. - %!test %! x = [0 1; 0 0]; -%! assert (any (isnan (sqrtm (x))(:) )) +%! assert (any (isnan (sqrtm (x))(:))); %!test -%! x = eye (4); x(2,2) = x(3,3) = 2^-26; x(1,4) = 1; -%! z = eye (4); z(2,2) = z(3,3) = 2^-13; z(1,4) = 0.5; -%! [y, err] = sqrtm(x); -%! assert (y, z) -%! assert (err, 0) ## Yes, this one has to hold exactly - +%! x = eye (4); x(2,2) = x(3,3) = 2^-26; x(1,4) = 1; +%! z = eye (4); z(2,2) = z(3,3) = 2^-13; z(1,4) = 0.5; +%! [y, err] = sqrtm (x); +%! assert (y, z); +%! assert (err, 0); ## Yes, this one has to hold exactly */ diff --git a/src/DLD-FUNCTIONS/str2double.cc b/src/DLD-FUNCTIONS/str2double.cc --- a/src/DLD-FUNCTIONS/str2double.cc +++ b/src/DLD-FUNCTIONS/str2double.cc @@ -350,10 +350,9 @@ } /* - %!assert (str2double ("1"), 1) %!assert (str2double ("-.1e-5"), -1e-6) -%!assert (str2double (char ("1", "2 3", "4i")), [1; NaN; 4i]); +%!assert (str2double (char ("1", "2 3", "4i")), [1; NaN; 4i]) %!assert (str2double ("-.1e-5"), -1e-6) %!assert (str2double ("1,222.5"), 1222.5) %!assert (str2double ("i"), i) @@ -378,5 +377,4 @@ %!assert (str2double ({"abc", "4i"}), [NaN + 0i, 4i]) %!assert (str2double ({2, "4i"}), [NaN + 0i, 4i]) %!assert (str2double (zeros(3,1,2)), NaN (3,1,2)) - */ diff --git a/src/DLD-FUNCTIONS/strfind.cc b/src/DLD-FUNCTIONS/strfind.cc --- a/src/DLD-FUNCTIONS/strfind.cc +++ b/src/DLD-FUNCTIONS/strfind.cc @@ -247,17 +247,15 @@ } /* - -%!error strfind (); -%!error strfind ("foo", "bar", 1); -%!error strfind ("foo", 100); -%!error strfind (100, "foo"); +%!assert (strfind ("abababa", "aba"), [1, 3, 5]) +%!assert (strfind ("abababa", "aba", "overlaps", false), [1, 5]) +%!assert (strfind ({"abababa", "bla", "bla"}, "a"), {[1, 3, 5, 7], 3, 3}) +%!assert (strfind ("Linux _is_ user-friendly. It just isn't ignorant-friendly or idiot-friendly.", "friendly"), [17, 50, 68]) -%!assert (strfind ("abababa", "aba"), [1, 3, 5]); -%!assert (strfind ("abababa", "aba", "overlaps", false), [1, 5]); -%!assert (strfind ({"abababa", "bla", "bla"}, "a"), {[1, 3, 5, 7], 3, 3}); -%!assert (strfind ("Linux _is_ user-friendly. It just isn't ignorant-friendly or idiot-friendly.", "friendly"), [17, 50, 68]); - +%!error strfind () +%!error strfind ("foo", "bar", 1) +%!error strfind ("foo", 100) +%!error strfind (100, "foo") */ static Array @@ -407,14 +405,11 @@ } /* - -%!assert(strcmp (strrep ("This is a test string", "is", "&%$"), -%! "Th&%$ &%$ a test string")); -%!assert(strrep ("abababc", "abab", "xyz"), "xyzxyzc"); -%!assert(strrep ("abababc", "abab", "xyz", "overlaps", false), "xyzabc"); +%!assert (strrep ("This is a test string", "is", "&%$"), +%! "Th&%$ &%$ a test string") +%!assert (strrep ("abababc", "abab", "xyz"), "xyzxyzc") +%!assert (strrep ("abababc", "abab", "xyz", "overlaps", false), "xyzabc") -%!error strrep (); - -%!error strrep ("foo", "bar", 3, 4); - +%!error strrep () +%!error strrep ("foo", "bar", 3, 4) */ diff --git a/src/DLD-FUNCTIONS/sub2ind.cc b/src/DLD-FUNCTIONS/sub2ind.cc --- a/src/DLD-FUNCTIONS/sub2ind.cc +++ b/src/DLD-FUNCTIONS/sub2ind.cc @@ -123,51 +123,48 @@ } /* - -# Test input validation -%!error sub2ind([10 10.5], 1, 1); -%!error sub2ind([10 10], 1.5, 1); -%!error sub2ind([10 10], 1, 1.5); - -# Test evaluation -%!shared s1, s2, s3, in -%! s1 = [ 1 1 1 1 ; 2 2 2 2 ]; -%! s2 = [ 1 1 2 2 ; 1 1 2 2 ]; -%! s3 = [ 1 2 1 2 ; 1 2 1 2 ]; -%! in = [ 1 101 11 111 ; 2 102 12 112 ]; -%!assert (sub2ind([10 10 10], s1, s2, s3), in); -%!shared +## Test evaluation +%!test +%! s1 = [ 1 1 1 1 ; 2 2 2 2 ]; +%! s2 = [ 1 1 2 2 ; 1 1 2 2 ]; +%! s3 = [ 1 2 1 2 ; 1 2 1 2 ]; +%! in = [ 1 101 11 111 ; 2 102 12 112 ]; +%! assert (sub2ind ([10 10 10], s1, s2, s3), in); # Test low index -%!assert (sub2ind([10 10 10], 1, 1, 1), 1); -%!error sub2ind([10 10 10], 0, 1, 1); -%!error sub2ind([10 10 10], 1, 0, 1); -%!error sub2ind([10 10 10], 1, 1, 0); +%!assert (sub2ind ([10 10 10], 1, 1, 1), 1) +%!error sub2ind ([10 10 10], 0, 1, 1) +%!error sub2ind ([10 10 10], 1, 0, 1) +%!error sub2ind ([10 10 10], 1, 1, 0) # Test high index -%!assert (sub2ind([10 10 10], 10, 10, 10), 1000); -%!error sub2ind([10 10 10], 11, 10, 10); -%!error sub2ind([10 10 10], 10, 11, 10); -%!error sub2ind([10 10 10], 10, 10, 11); +%!assert (sub2ind ([10 10 10], 10, 10, 10), 1000) +%!error sub2ind ([10 10 10], 11, 10, 10) +%!error sub2ind ([10 10 10], 10, 11, 10) +%!error sub2ind ([10 10 10], 10, 10, 11) # Test high index in the trailing dimensions -%!assert (sub2ind([10, 1], 2, 1, 1), 2); -%!error sub2ind([10, 1], 1, 2, 1); -%!error sub2ind([10, 1], 1, 1, 2); -%!assert (sub2ind([10 10], 2, 2, 1), 12); -%!error sub2ind([10 10], 2, 1, 2); -%!error sub2ind([10 10], 1, 2, 2); +%!assert (sub2ind ([10, 1], 2, 1, 1), 2) +%!error sub2ind ([10, 1], 1, 2, 1) +%!error sub2ind ([10, 1], 1, 1, 2) +%!assert (sub2ind ([10 10], 2, 2, 1), 12) +%!error sub2ind ([10 10], 2, 1, 2) +%!error sub2ind ([10 10], 1, 2, 2) # Test handling of empty arguments -%!assert (sub2ind([10 10], zeros(0,0), zeros(0,0)), zeros(0,0)); -%!assert (sub2ind([10 10], zeros(2,0), zeros(2,0)), zeros(2,0)); -%!assert (sub2ind([10 10], zeros(0,2), zeros(0,2)), zeros(0,2)); -%!error sub2ind([10 10 10], zeros(0,2), zeros(2,0)); +%!assert (sub2ind ([10 10], zeros (0,0), zeros (0,0)), zeros (0,0)) +%!assert (sub2ind ([10 10], zeros (2,0), zeros (2,0)), zeros (2,0)) +%!assert (sub2ind ([10 10], zeros (0,2), zeros (0,2)), zeros (0,2)) +%!error sub2ind ([10 10 10], zeros (0,2), zeros (2,0)) # Test handling of arguments of different size -%!error sub2ind([10 10], ones(1,2), ones(1,3)); -%!error sub2ind([10 10], ones(1,2), ones(2,1)); +%!error sub2ind ([10 10], ones (1,2), ones (1,3)) +%!error sub2ind ([10 10], ones (1,2), ones (2,1)) +## Test input validation +%!error sub2ind ([10 10.5], 1, 1) +%!error sub2ind ([10 10], 1.5, 1) +%!error sub2ind ([10 10], 1, 1.5) */ DEFUN_DLD (ind2sub, args, nargout, diff --git a/src/DLD-FUNCTIONS/svd.cc b/src/DLD-FUNCTIONS/svd.cc --- a/src/DLD-FUNCTIONS/svd.cc +++ b/src/DLD-FUNCTIONS/svd.cc @@ -325,8 +325,7 @@ } /* - -%!assert(svd ([1, 2; 2, 1]), [3; 1], sqrt (eps)); +%!assert (svd ([1, 2; 2, 1]), [3; 1], sqrt (eps)) %!test %! [u, s, v] = svd ([1, 2; 2, 1]); @@ -355,34 +354,34 @@ %! [u, s, v] = svd (a, 1); %! assert (u * s * v', a, sqrt (eps)); -%!assert(svd (single([1, 2; 2, 1])), single([3; 1]), sqrt (eps('single'))); +%!assert (svd (single ([1, 2; 2, 1])), single ([3; 1]), sqrt (eps ("single"))) %!test -%! [u, s, v] = svd (single([1, 2; 2, 1])); +%! [u, s, v] = svd (single ([1, 2; 2, 1])); %! x = single (1 / sqrt (2)); -%! assert (u, [-x, -x; -x, x], sqrt (eps('single'))); -%! assert (s, single([3, 0; 0, 1]), sqrt (eps('single'))); -%! assert (v, [-x, x; -x, -x], sqrt (eps('single'))); +%! assert (u, [-x, -x; -x, x], sqrt (eps ("single"))); +%! assert (s, single ([3, 0; 0, 1]), sqrt (eps ("single"))); +%! assert (v, [-x, x; -x, -x], sqrt (eps ("single"))); %!test -%! a = single([1, 2, 3; 4, 5, 6]); +%! a = single ([1, 2, 3; 4, 5, 6]); %! [u, s, v] = svd (a); -%! assert (u * s * v', a, sqrt (eps('single'))); +%! assert (u * s * v', a, sqrt (eps ("single"))); %!test -%! a = single([1, 2; 3, 4; 5, 6]); +%! a = single ([1, 2; 3, 4; 5, 6]); %! [u, s, v] = svd (a); -%! assert (u * s * v', a, sqrt (eps('single'))); +%! assert (u * s * v', a, sqrt (eps ("single"))); %!test -%! a = single([1, 2, 3; 4, 5, 6]); +%! a = single ([1, 2, 3; 4, 5, 6]); %! [u, s, v] = svd (a, 1); -%! assert (u * s * v', a, sqrt (eps('single'))); +%! assert (u * s * v', a, sqrt (eps ("single"))); %!test -%! a = single([1, 2; 3, 4; 5, 6]); +%! a = single ([1, 2; 3, 4; 5, 6]); %! [u, s, v] = svd (a, 1); -%! assert (u * s * v', a, sqrt (eps('single'))); +%! assert (u * s * v', a, sqrt (eps ("single"))); %!test %! a = zeros (0, 5); @@ -398,10 +397,9 @@ %! assert (size (s), [0, 0]); %! assert (size (v), [0, 0]); -%!error svd (); -%!error svd ([1, 2; 4, 5], 2, 3); -%!error [u, v] = svd ([1, 2; 3, 4]); - +%!error svd () +%!error svd ([1, 2; 4, 5], 2, 3) +%!error [u, v] = svd ([1, 2; 3, 4]) */ DEFUN_DLD (svd_driver, args, nargout, diff --git a/src/DLD-FUNCTIONS/syl.cc b/src/DLD-FUNCTIONS/syl.cc --- a/src/DLD-FUNCTIONS/syl.cc +++ b/src/DLD-FUNCTIONS/syl.cc @@ -209,12 +209,10 @@ } /* - -%!assert(syl ([1, 2; 3, 4], [5, 6; 7, 8], [9, 10; 11, 12]), [-1/2, -2/3; -2/3, -1/2], sqrt (eps)); -%!assert(syl (single([1, 2; 3, 4]), single([5, 6; 7, 8]), single([9, 10; 11, 12])), single([-1/2, -2/3; -2/3, -1/2]), sqrt (eps('single'))); +%!assert (syl ([1, 2; 3, 4], [5, 6; 7, 8], [9, 10; 11, 12]), [-1/2, -2/3; -2/3, -1/2], sqrt (eps)) +%!assert (syl (single ([1, 2; 3, 4]), single ([5, 6; 7, 8]), single ([9, 10; 11, 12])), single ([-1/2, -2/3; -2/3, -1/2]), sqrt (eps ("single"))) -%!error syl (); -%!error syl (1, 2, 3, 4); -%!error syl ([1, 2; 3, 4], [1, 2, 3; 4, 5, 6], [4, 3]); - +%!error syl () +%!error syl (1, 2, 3, 4) +%!error syl ([1, 2; 3, 4], [1, 2, 3; 4, 5, 6], [4, 3]) */ diff --git a/src/DLD-FUNCTIONS/time.cc b/src/DLD-FUNCTIONS/time.cc --- a/src/DLD-FUNCTIONS/time.cc +++ b/src/DLD-FUNCTIONS/time.cc @@ -122,9 +122,7 @@ } /* - -%!assert(time () > 0); - +%!assert (time () > 0) */ DEFUN_DLD (gmtime, args, , @@ -171,25 +169,22 @@ } /* - %!test %! ts = gmtime (time ()); -%! assert((isstruct (ts) -%! && isfield (ts, "usec") -%! && isfield (ts, "year") -%! && isfield (ts, "mon") -%! && isfield (ts, "mday") -%! && isfield (ts, "sec") -%! && isfield (ts, "min") -%! && isfield (ts, "wday") -%! && isfield (ts, "hour") -%! && isfield (ts, "isdst") -%! && isfield (ts, "yday"))); +%! assert (isstruct (ts)); +%! assert (isfield (ts, "usec")); +%! assert (isfield (ts, "year")); +%! assert (isfield (ts, "mon")); +%! assert (isfield (ts, "mday")); +%! assert (isfield (ts, "sec")); +%! assert (isfield (ts, "min")); +%! assert (isfield (ts, "wday")); +%! assert (isfield (ts, "hour")); +%! assert (isfield (ts, "isdst")); +%! assert (isfield (ts, "yday")); -%!error gmtime (); - -%!error gmtime (1, 2); - +%!error gmtime () +%!error gmtime (1, 2) */ DEFUN_DLD (localtime, args, , @@ -235,25 +230,22 @@ } /* - %!test %! ts = localtime (time ()); -%! assert((isstruct (ts) -%! && isfield (ts, "usec") -%! && isfield (ts, "year") -%! && isfield (ts, "mon") -%! && isfield (ts, "mday") -%! && isfield (ts, "sec") -%! && isfield (ts, "min") -%! && isfield (ts, "wday") -%! && isfield (ts, "hour") -%! && isfield (ts, "isdst") -%! && isfield (ts, "yday"))); +%! assert (isstruct (ts)); +%! assert (isfield (ts, "usec")); +%! assert (isfield (ts, "year")); +%! assert (isfield (ts, "mon")); +%! assert (isfield (ts, "mday")); +%! assert (isfield (ts, "sec")); +%! assert (isfield (ts, "min")); +%! assert (isfield (ts, "wday")); +%! assert (isfield (ts, "hour")); +%! assert (isfield (ts, "isdst")); +%! assert (isfield (ts, "yday")); -%!error localtime (); - -%!error localtime (1, 2); - +%!error localtime () +%!error localtime (1, 2) */ DEFUN_DLD (mktime, args, , @@ -296,21 +288,18 @@ } /* - %!test %! t = time (); -%! assert(fix (mktime (localtime (t))) == fix (t)); - -%!error mktime (); +%! assert (fix (mktime (localtime (t))) == fix (t)); -%!error mktime (1, 2, 3); - -%% These tests fail on systems with mktime functions of limited -%% intelligence: +## These tests fail on systems with mktime functions of limited +## intelligence: %!assert (datestr (datenum (1969, 1, 1), 0), "01-Jan-1969 00:00:00") %!assert (datestr (datenum (1901, 1, 1), 0), "01-Jan-1901 00:00:00") %!assert (datestr (datenum (1795, 1, 1), 0), "01-Jan-1795 00:00:00") +%!error mktime () +%!error mktime (1, 2, 3) */ DEFUN_DLD (strftime, args, , @@ -498,17 +487,14 @@ } /* +%!assert (ischar (strftime ("%%%n%t%H%I%k%l", localtime (time ())))); +%!assert (ischar (strftime ("%M%p%r%R%s%S%T", localtime (time ())))); +%!assert (ischar (strftime ("%X%Z%z%a%A%b%B", localtime (time ())))); +%!assert (ischar (strftime ("%c%C%d%e%D%h%j", localtime (time ())))); +%!assert (ischar (strftime ("%m%U%w%W%x%y%Y", localtime (time ())))); -%!assert((ischar (strftime ("%%%n%t%H%I%k%l", localtime (time ()))) -%! && ischar (strftime ("%M%p%r%R%s%S%T", localtime (time ()))) -%! && ischar (strftime ("%X%Z%z%a%A%b%B", localtime (time ()))) -%! && ischar (strftime ("%c%C%d%e%D%h%j", localtime (time ()))) -%! && ischar (strftime ("%m%U%w%W%x%y%Y", localtime (time ()))))); - -%!error strftime (); - -%!error strftime ("foo", localtime (time ()), 1); - +%!error strftime () +%!error strftime ("foo", localtime (time ()), 1) */ DEFUN_DLD (strptime, args, , diff --git a/src/DLD-FUNCTIONS/tril.cc b/src/DLD-FUNCTIONS/tril.cc --- a/src/DLD-FUNCTIONS/tril.cc +++ b/src/DLD-FUNCTIONS/tril.cc @@ -407,7 +407,6 @@ } /* - %!test %! a = [1, 2, 3; 4, 5, 6; 7, 8, 9; 10, 11, 12]; %! @@ -419,10 +418,13 @@ %! lm3 = [0, 0, 0; 0, 0, 0; 0, 0, 0; 10, 0, 0]; %! lm4 = [0, 0, 0; 0, 0, 0; 0, 0, 0; 0, 0, 0]; %! -%! assert((tril (a, -4) == lm4 && tril (a, -3) == lm3 -%! && tril (a, -2) == lm2 && tril (a, -1) == lm1 -%! && tril (a) == l0 && tril (a, 1) == l1 && tril (a, 2) == l2)); +%! assert (tril (a, -4), lm4); +%! assert (tril (a, -3), lm3); +%! assert (tril (a, -2), lm2); +%! assert (tril (a, -1), lm1); +%! assert (tril (a), l0); +%! assert (tril (a, 1), l1); +%! assert (tril (a, 2), l2); -%!error tril (); - +%!error tril () */ diff --git a/src/DLD-FUNCTIONS/tsearch.cc b/src/DLD-FUNCTIONS/tsearch.cc --- a/src/DLD-FUNCTIONS/tsearch.cc +++ b/src/DLD-FUNCTIONS/tsearch.cc @@ -176,11 +176,11 @@ %! x = [-1;-1;1]; %! y = [-1;1;-1]; %! tri = [1, 2, 3]; -%!error (tsearch()) %!assert (tsearch (x,y,tri,-1,-1), 1) %!assert (tsearch (x,y,tri, 1,-1), 1) %!assert (tsearch (x,y,tri,-1, 1), 1) %!assert (tsearch (x,y,tri,-1/3, -1/3), 1) %!assert (tsearch (x,y,tri, 1, 1), NaN) +%!error tsearch () */ diff --git a/src/Makefile.am b/src/Makefile.am --- a/src/Makefile.am +++ b/src/Makefile.am @@ -97,27 +97,27 @@ EXTRA_DIST = \ Makefile.in \ - defaults.h.in \ + defaults.in.h \ DOCSTRINGS \ find-defun-files.sh \ genprops.awk \ gl2ps.c \ - graphics.h.in \ + graphics.in.h \ mk-errno-list \ mk-pkg-add \ mkbuiltins \ mkdefs \ mkgendoc \ - mkoctfile.cc.in \ - mkoctfile.in \ + mkoctfile.in.cc \ + mkoctfile.in.sh \ mkops \ - mxarray.h.in \ - oct-conf.h.in \ - oct-errno.cc.in \ - octave-config.cc.in \ - octave-config.in \ + mxarray.in.h \ + oct-conf.in.h \ + oct-errno.in.cc \ + octave-config.in.cc \ + octave-config.in.sh \ octave.gperf \ - version.h.in \ + version.in.h \ $(BUILT_DISTFILES) OPT_HANDLERS = \ @@ -581,14 +581,14 @@ ## defaults.h and oct-conf.h must depend on Makefile. Calling configure ## may change default/config values. However, calling configure will also ## regenerate the Makefiles from Makefile.am and trigger the rules below. -defaults.h: defaults.h.in Makefile +defaults.h: defaults.in.h Makefile @$(do_subst_default_vals) -graphics.h: graphics.h.in genprops.awk Makefile +graphics.h: graphics.in.h genprops.awk Makefile $(AWK) -f $(srcdir)/genprops.awk $< > $@-t mv $@-t $@ -oct-conf.h: oct-conf.h.in Makefile +oct-conf.h: oct-conf.in.h Makefile @$(do_subst_config_vals) ## Don't use a pipeline to process gperf output since if gperf @@ -601,12 +601,12 @@ mv $@-t $@ rm -f $@-t1 -mxarray.h: mxarray.h.in Makefile +mxarray.h: mxarray.in.h Makefile $(SED) < $< \ -e "s|%OCTAVE_IDX_TYPE%|${OCTAVE_IDX_TYPE}|" > $@-t mv $@-t $@ -version.h: version.h.in Makefile +version.h: version.in.h Makefile $(SED) < $< \ -e "s|%OCTAVE_API_VERSION_NUMBER%|${OCTAVE_API_VERSION_NUMBER}|" \ -e "s|%OCTAVE_API_VERSION%|\"${OCTAVE_API_VERSION}\"|" \ @@ -619,7 +619,7 @@ $(srcdir)/mkbuiltins $(DEF_FILES) > $@-t mv $@-t $@ -graphics-props.cc: graphics.h.in genprops.awk Makefile +graphics-props.cc: graphics.in.h genprops.awk Makefile $(AWK) -v emit_graphics_props=1 -f $(srcdir)/genprops.awk $< > $@-t mv $@-t $@ @@ -627,7 +627,7 @@ $(srcdir)/mkops $(OPERATORS_SRC) > $@-t mv $@-t $@ -oct-errno.cc: oct-errno.cc.in Makefile +oct-errno.cc: oct-errno.in.cc Makefile if test -n "$(PERL)"; then \ $(srcdir)/mk-errno-list --perl "$(PERL)" < $< > $@-t; \ elif test -n "$(PYTHON)"; then \ @@ -689,17 +689,17 @@ endif if AMCOND_BUILD_COMPILED_AUX_PROGRAMS -octave-config.cc: octave-config.cc.in Makefile +octave-config.cc: octave-config.in.cc Makefile @$(do_subst_default_vals) -mkoctfile.cc: mkoctfile.cc.in Makefile +mkoctfile.cc: mkoctfile.in.cc Makefile @$(do_subst_config_vals) else -octave-config: octave-config.in Makefile +octave-config: octave-config.in.sh Makefile @$(do_subst_default_vals) chmod a+rx $@ -mkoctfile: mkoctfile.in Makefile +mkoctfile: mkoctfile.in.sh Makefile @$(do_subst_config_vals) chmod a+rx $@ endif diff --git a/src/data.cc b/src/data.cc --- a/src/data.cc +++ b/src/data.cc @@ -1281,11 +1281,14 @@ else if (nargin == 3) { octave_value arg0 = args(0); - if (arg0.ndims () == 2 && (args(0).rows () == 1 || args(0).columns () == 1)) + + if (arg0.ndims () == 2 && (arg0.rows () == 1 || arg0.columns () == 1)) { - octave_idx_type m = args(1).int_value (), n = args(2).int_value (); + octave_idx_type m = args(1).int_value (); + octave_idx_type n = args(2).int_value (); + if (! error_state) - retval = arg0.diag ().resize (dim_vector (m, n), true); + retval = arg0.diag (m, n); else error ("diag: invalid dimensions"); } @@ -1334,6 +1337,9 @@ ## Test non-square size %!assert(diag ([1,2,3], 6, 3), [1 0 0; 0 2 0; 0 0 3; 0 0 0; 0 0 0; 0 0 0]) +%!assert (diag (1, 2, 3), [1,0,0; 0,0,0]); +%!assert (diag ({1}, 2, 3), {1,[],[]; [],[],[]}); +%!assert (diag ({1,2}, 3, 4), {1,[],[],[]; [],2,[],[]; [],[],[],[]}); %% Test input validation %!error diag () @@ -1341,7 +1347,15 @@ %!error diag (ones (2), 3, 3) %!error diag (1:3, -4, 3) - */ +%!assert (diag (1, 3, 3), diag ([1, 0, 0])) +%!assert (diag (i, 3, 3), diag ([i, 0, 0])) +%!assert (diag (single (1), 3, 3), diag ([single(1), 0, 0])) +%!assert (diag (single (i), 3, 3), diag ([single(i), 0, 0])) +%!assert (diag ([1, 2], 3, 3), diag ([1, 2, 0])) +%!assert (diag ([1, 2]*i, 3, 3), diag ([1, 2, 0]*i)) +%!assert (diag (single ([1, 2]), 3, 3), diag (single ([1, 2, 0]))) +%!assert (diag (single ([1, 2]*i), 3, 3), diag (single ([1, 2, 0]*i))) +*/ DEFUN (prod, args, , "-*- texinfo -*-\n\ @@ -4719,9 +4733,7 @@ %! assert (size (x2) == [1, 10] && x2(1) == 1 && x2(10) == 2); %! assert (size (x3) == [1, 10] && x3(1) == 1 && x3(10) == -2); -%#assert (linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)) - -%!fail ("linspace ([1, 2; 3, 4], 5, 6)", "warning") +%assert (linspace ([1, 2; 3, 4], 5, 6), linspace (1, 5, 6)) %!error linspace () %!error linspace (1, 2, 3, 4) @@ -5233,6 +5245,12 @@ %! fhi = single (1e+300); %!assert (norm (flo*m2,"fro"), single (sqrt (30)*flo), -eps ("single")) %!assert (norm (fhi*m2,"fro"), single (sqrt (30)*fhi), -eps ("single")) + +%!test +%! ## Test for norm returning NaN on sparse matrix (bug #30631) +%! A = sparse (2,2); +%! A(2,1) = 1; +%! assert (norm (A), 1); */ static octave_value diff --git a/src/defaults.h.in b/src/defaults.in.h rename from src/defaults.h.in rename to src/defaults.in.h diff --git a/src/error.cc b/src/error.cc --- a/src/error.cc +++ b/src/error.cc @@ -764,7 +764,7 @@ static std::string handle_message (error_fun f, const char *id, const char *msg, - const octave_value_list& args) + const octave_value_list& args, bool have_fmt) { std::string retval; @@ -776,7 +776,7 @@ { octave_value arg; - if (nargin > 1) + if (have_fmt) { octave_value_list tmp = Fsprintf (args, 1); arg = tmp(0); @@ -962,6 +962,57 @@ return retval; } +// Determine whether the first argument to error or warning function +// should be handled as the message identifier or as the format string. + +static bool +maybe_extract_message_id (const std::string& caller, + const octave_value_list& args, + octave_value_list& nargs, + std::string& id) +{ + nargs = args; + id = std::string (); + + int nargin = args.length (); + + bool have_fmt = nargin > 1; + + if (nargin > 0) + { + std::string arg1 = args(0).string_value (); + + if (! error_state) + { + // For compatibility with Matlab, an identifier must contain + // ':', but not at the beginning or the end, and it must not + // contain '%' (even if it is not a valid conversion + // operator) or whitespace. + + if (arg1.find_first_of ("% \f\n\r\t\v") == std::string::npos + && arg1.find (':') != std::string::npos + && arg1[0] != ':' + && arg1[arg1.length()-1] != ':') + { + if (nargin > 1) + { + id = arg1; + + nargs.resize (nargin-1); + + for (int i = 1; i < nargin; i++) + nargs(i-1) = args(i); + } + else + nargs(0) = "call to " + caller + + " with message identifier requires message"; + } + } + } + + return have_fmt; +} + DEFUN (error, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} error (@var{template}, @dots{})\n\ @@ -1031,26 +1082,9 @@ print_usage (); else { - if (nargin > 1) - { - std::string arg1 = args(0).string_value (); - - if (! error_state) - { - if (arg1.find ('%') == std::string::npos) - { - id = arg1; + bool have_fmt = false; - nargs.resize (nargin-1); - - for (int i = 1; i < nargin; i++) - nargs(i-1) = args(i); - } - } - else - return retval; - } - else if (nargin == 1 && args(0).is_map ()) + if (nargin == 1 && args(0).is_map ()) { // empty struct is not an error. return and resume calling function. if (args(0).is_empty ()) @@ -1084,8 +1118,16 @@ // structure, but that will require some more significant // surgery on handle_message, error_with_id, etc. } + else + { + have_fmt = maybe_extract_message_id ("error", args, nargs, id); - handle_message (error_with_id, id.c_str (), "unspecified error", nargs); + if (error_state) + return retval; + } + + handle_message (error_with_id, id.c_str (), "unspecified error", + nargs, have_fmt); } return retval; @@ -1399,30 +1441,16 @@ std::string id; - if (nargin > 1) - { - std::string arg1 = args(0).string_value (); - - if (! error_state) - { - if (arg1.find ('%') == std::string::npos) - { - id = arg1; + bool have_fmt = maybe_extract_message_id ("warning", args, nargs, id); - nargs.resize (nargin-1); - - for (int i = 1; i < nargin; i++) - nargs(i-1) = args(i); - } - } - else - return retval; - } + if (error_state) + return retval; std::string prev_msg = Vlast_warning_message; std::string curr_msg = handle_message (warning_with_id, id.c_str (), - "unspecified warning", nargs); + "unspecified warning", nargs, + have_fmt); if (nargout > 0) retval = prev_msg; @@ -1765,7 +1793,7 @@ @end deftypefn") { octave_value_list retval; - handle_message (usage_with_id, "", "unknown", args); + handle_message (usage_with_id, "", "unknown", args, true); return retval; } diff --git a/src/graphics.h.in b/src/graphics.in.h rename from src/graphics.h.in rename to src/graphics.in.h --- a/src/graphics.h.in +++ b/src/graphics.in.h @@ -4664,7 +4664,7 @@ string_property ydatasource , "" string_property zdatasource , "" string_property cdatasource , "" - color_property facecolor , "{flat}|none|interp" + color_property facecolor , "{flat}|none|interp|texturemap" double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) radio_property linestyle , "{-}|--|:|-.|none" diff --git a/src/lex.ll b/src/lex.ll --- a/src/lex.ll +++ b/src/lex.ll @@ -1417,6 +1417,10 @@ delete_buffer (YY_BUFFER_STATE buf) { yy_delete_buffer (buf); + + // Prevent invalid yyin from being used by yyrestart. + if (! current_buffer ()) + yyin = 0; } // Delete all buffers from the stack. diff --git a/src/mkoctfile.cc.in b/src/mkoctfile.in.cc rename from src/mkoctfile.cc.in rename to src/mkoctfile.in.cc diff --git a/src/mkoctfile.in b/src/mkoctfile.in.sh rename from src/mkoctfile.in rename to src/mkoctfile.in.sh diff --git a/src/mxarray.h.in b/src/mxarray.in.h rename from src/mxarray.h.in rename to src/mxarray.in.h diff --git a/src/oct-conf.h.in b/src/oct-conf.in.h rename from src/oct-conf.h.in rename to src/oct-conf.in.h diff --git a/src/oct-errno.cc.in b/src/oct-errno.in.cc rename from src/oct-errno.cc.in rename to src/oct-errno.in.cc diff --git a/src/oct-map.cc b/src/oct-map.cc --- a/src/oct-map.cc +++ b/src/oct-map.cc @@ -971,7 +971,7 @@ octave_idx_type nf = nfields (); for (octave_idx_type k = 0; k < nf; k++) - xvals[k].assign (i, rhs.xvals[k]); + xvals[k].assign (i, rhs.xvals[k], Matrix ()); if (nf > 0) dimensions = xvals[0].dims (); @@ -1014,7 +1014,7 @@ octave_idx_type nf = nfields (); for (octave_idx_type k = 0; k < nf; k++) - xvals[k].assign (i, j, rhs.xvals[k]); + xvals[k].assign (i, j, rhs.xvals[k], Matrix ()); if (nf > 0) dimensions = xvals[0].dims (); @@ -1057,7 +1057,7 @@ octave_idx_type nf = nfields (); for (octave_idx_type k = 0; k < nf; k++) - xvals[k].assign (ia, rhs.xvals[k]); + xvals[k].assign (ia, rhs.xvals[k], Matrix ()); if (nf > 0) dimensions = xvals[0].dims (); @@ -1170,6 +1170,13 @@ setfield (k, tmp); } +/* +%!test +%! rhs.b = 1; +%! a(3) = rhs; +%! assert ({a.b}, {[], [], 1}) +*/ + void octave_map::delete_elements (const idx_vector& i) { diff --git a/src/oct-parse.yy b/src/oct-parse.yy --- a/src/oct-parse.yy +++ b/src/oct-parse.yy @@ -115,6 +115,11 @@ // nested function. static int current_function_depth = 0; +// A stack holding the nested function scopes being parsed. +// We don't use std::stack, because we want the clear method. Also, we +// must access one from the top +static std::vector function_scopes; + // Maximum function depth detected. Just here to determine whether // we have nested functions or just implicitly ended subfunctions. static int max_function_depth = 0; @@ -368,7 +373,8 @@ yyerrok; \ if (! parser_symtab_context.empty ()) \ parser_symtab_context.pop (); \ - if (interactive || forced_interactive) \ + if ((interactive || forced_interactive) \ + && ! get_input_from_eval_string) \ YYACCEPT; \ else \ YYABORT; \ @@ -460,7 +466,7 @@ // Nonterminals we construct. %type stash_comment function_beg classdef_beg %type properties_beg methods_beg events_beg enum_beg -%type sep_no_nl opt_sep_no_nl sep opt_sep +%type sep_no_nl opt_sep_no_nl sep opt_sep opt_comma %type input %type string constant magic_colon %type anon_fcn_handle @@ -906,7 +912,7 @@ $$ = new tree_argument_list ($1); $$->mark_as_simple_assign_lhs (); } - | '[' arg_list CLOSE_BRACE + | '[' arg_list opt_comma CLOSE_BRACE { $$ = $2; lexer_flags.looking_at_matrix_or_assign_lhs = false; @@ -1226,6 +1232,8 @@ symbol_table::set_scope (symbol_table::alloc_scope ()); + function_scopes.push_back (symbol_table::current_scope ()); + if (! reading_script_file && current_function_depth == 1 && ! parsing_subfunctions) primary_fcn_scope = symbol_table::current_scope (); @@ -1672,6 +1680,12 @@ { $$ = $1; } ; +opt_comma : // empty + { $$ = 0; } + | ',' + { $$ = ','; } + ; + %% // Generic error messages. @@ -2823,8 +2837,7 @@ // file. Matlab doesn't provide a diagnostic (it ignores the stated // name). if (! autoloading && reading_fcn_file - && (current_function_depth == 1 - && ! (parsing_subfunctions || lexer_flags.parsing_class_method))) + && current_function_depth == 1 && ! parsing_subfunctions) { // FIXME -- should curr_fcn_file_name already be // preprocessed when we get here? It seems to only be a @@ -2862,7 +2875,11 @@ if (current_function_depth > 1 || parsing_subfunctions) { fcn->stash_parent_fcn_name (curr_fcn_file_name); - fcn->stash_parent_fcn_scope (primary_fcn_scope); + + if (current_function_depth > 1) + fcn->stash_parent_fcn_scope (function_scopes[function_scopes.size()-2]); + else + fcn->stash_parent_fcn_scope (primary_fcn_scope); } if (lexer_flags.parsing_class_method) @@ -2938,19 +2955,32 @@ { fcn->mark_as_subfunction (); - symbol_table::install_subfunction (nm, octave_value (fcn), - primary_fcn_scope); + if (endfunction_found && function_scopes.size () > 1) + { + symbol_table::scope_id pscope + = function_scopes[function_scopes.size()-2]; + + symbol_table::install_nestfunction (nm, octave_value (fcn), + pscope); + } + else + symbol_table::install_subfunction (nm, octave_value (fcn), + primary_fcn_scope); } - if (! reading_fcn_file) + if (current_function_depth == 1 && fcn) + symbol_table::update_nest (fcn->scope ()); + + if (! reading_fcn_file && current_function_depth == 1) { // We are either reading a script file or defining a function // at the command line, so this definition creates a // tree_function object that is placed in the parse tree. // Otherwise, it is just inserted in the symbol table, - // either as a subfunction (see above), or as the primary - // function for the file, via primary_fcn_ptr (see also - // load_fcn_from_file,, parse_fcn_file, and + // either as a subfunction or nested function (see above), + // or as the primary function for the file, via + // primary_fcn_ptr (see also load_fcn_from_file,, + // parse_fcn_file, and // symbol_table::fcn_info::fcn_info_rep::find_user_function). retval = new tree_function_def (fcn); @@ -2979,6 +3009,7 @@ parsing_subfunctions = true; current_function_depth--; + function_scopes.pop_back (); lexer_flags.defining_func--; lexer_flags.parsed_function_name.pop (); @@ -3448,6 +3479,7 @@ frame.protect_var (line_editing); frame.protect_var (current_class_name); frame.protect_var (current_function_depth); + frame.protect_var (function_scopes); frame.protect_var (max_function_depth); frame.protect_var (parsing_subfunctions); frame.protect_var (endfunction_found); @@ -3458,6 +3490,7 @@ line_editing = false; current_class_name = dispatch_type; current_function_depth = 0; + function_scopes.clear (); max_function_depth = 0; parsing_subfunctions = false; endfunction_found = false; @@ -3576,11 +3609,6 @@ if (status != 0) error ("parse error while reading %s file %s", file_type.c_str(), ff.c_str ()); - else if (reading_fcn_file && endfunction_found - && max_function_depth > 1) - warning_with_id ("Octave:nested-functions-coerced", - "nested functions are coerced into subfunctions " - "in file %s", ff.c_str ()); } else { @@ -4292,6 +4320,7 @@ frame.protect_var (line_editing); frame.protect_var (current_eval_string); frame.protect_var (current_function_depth); + frame.protect_var (function_scopes); frame.protect_var (max_function_depth); frame.protect_var (parsing_subfunctions); frame.protect_var (endfunction_found); @@ -4306,6 +4335,7 @@ parser_end_of_input = false; line_editing = false; current_function_depth = 0; + function_scopes.clear (); max_function_depth = 0; parsing_subfunctions = false; endfunction_found = false; @@ -4553,6 +4583,11 @@ %!endfunction %!assert (__f(), 2) +% bug #35645 +%!test +%! [a,] = gcd (1,2); +%! [a,b,] = gcd (1, 2); + */ DEFUN (assignin, args, , diff --git a/src/octave-config.cc.in b/src/octave-config.in.cc rename from src/octave-config.cc.in rename to src/octave-config.in.cc diff --git a/src/octave-config.in b/src/octave-config.in.sh rename from src/octave-config.in rename to src/octave-config.in.sh diff --git a/src/octave.cc b/src/octave.cc --- a/src/octave.cc +++ b/src/octave.cc @@ -317,6 +317,7 @@ catch (std::bad_alloc) { recover_from_exception (); + error_state = -2; gripe_safe_source_exception (file_name, "memory exhausted or requested size too large for range of Octave's index type"); @@ -443,6 +444,7 @@ } catch (std::bad_alloc) { + error_state = -2; std::cerr << "error: memory exhausted or requested size too large for range of Octave's index type -- eval failed" << std::endl; } diff --git a/src/ov-base-diag.cc b/src/ov-base-diag.cc --- a/src/ov-base-diag.cc +++ b/src/ov-base-diag.cc @@ -82,7 +82,7 @@ if (idx0.is_scalar () && idx1.is_scalar ()) { - retval = matrix.checkelem (idx0(0), idx1(0)); + retval = matrix.elem (idx0(0), idx1(0)); } else { diff --git a/src/ov-base-mat.h b/src/ov-base-mat.h --- a/src/ov-base-mat.h +++ b/src/ov-base-mat.h @@ -123,6 +123,9 @@ octave_value diag (octave_idx_type k = 0) const { return octave_value (matrix.diag (k)); } + octave_value diag (octave_idx_type m, octave_idx_type n) const + { return octave_value (matrix.diag (m, n)); } + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const { return octave_value (matrix.sort (dim, mode)); } octave_value sort (Array &sidx, octave_idx_type dim = 0, diff --git a/src/ov-base-scalar.cc b/src/ov-base-scalar.cc --- a/src/ov-base-scalar.cc +++ b/src/ov-base-scalar.cc @@ -121,6 +121,13 @@ } template +octave_value +octave_base_scalar::diag (octave_idx_type m, octave_idx_type n) const +{ + return Array (dim_vector (1, 1), scalar).diag (m, n); +} + +template bool octave_base_scalar::is_true (void) const { diff --git a/src/ov-base-scalar.h b/src/ov-base-scalar.h --- a/src/ov-base-scalar.h +++ b/src/ov-base-scalar.h @@ -98,6 +98,8 @@ octave_value diag (octave_idx_type k = 0) const; + octave_value diag (octave_idx_type m, octave_idx_type n) const; + octave_value sort (octave_idx_type, sortmode) const { return octave_value (scalar); } octave_value sort (Array &sidx, octave_idx_type, diff --git a/src/ov-base-sparse.cc b/src/ov-base-sparse.cc --- a/src/ov-base-sparse.cc +++ b/src/ov-base-sparse.cc @@ -318,7 +318,13 @@ << ", cols = " << nc << ", nnz = " << nz; - double dnel = matrix.numel (); + // Avoid calling numel here since it can easily overflow + // octave_idx_type even when there is no real problem storing the + // sparse array. + + double dnr = nr; + double dnc = nc; + double dnel = dnr * dnc; if (dnel > 0) { diff --git a/src/ov-base.cc b/src/ov-base.cc --- a/src/ov-base.cc +++ b/src/ov-base.cc @@ -1121,6 +1121,14 @@ } octave_value +octave_base_value::diag (octave_idx_type, octave_idx_type) const +{ + gripe_wrong_type_arg ("octave_base_value::diag ()", type_name ()); + + return octave_value(); +} + +octave_value octave_base_value::sort (octave_idx_type, sortmode) const { gripe_wrong_type_arg ("octave_base_value::sort ()", type_name ()); diff --git a/src/ov-base.h b/src/ov-base.h --- a/src/ov-base.h +++ b/src/ov-base.h @@ -646,6 +646,8 @@ virtual octave_value diag (octave_idx_type k = 0) const; + virtual octave_value diag (octave_idx_type m, octave_idx_type n) const; + virtual octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const; virtual octave_value sort (Array &sidx, diff --git a/src/ov-complex.cc b/src/ov-complex.cc --- a/src/ov-complex.cc +++ b/src/ov-complex.cc @@ -243,6 +243,12 @@ } } +octave_value +octave_complex::diag (octave_idx_type m, octave_idx_type n) const +{ + return ComplexDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); +} + bool octave_complex::save_ascii (std::ostream& os) { diff --git a/src/ov-complex.h b/src/ov-complex.h --- a/src/ov-complex.h +++ b/src/ov-complex.h @@ -163,6 +163,8 @@ return boolNDArray (dim_vector (1, 1), scalar != 0.0); } + octave_value diag (octave_idx_type m, octave_idx_type n) const; + void increment (void) { scalar += 1.0; } void decrement (void) { scalar -= 1.0; } diff --git a/src/ov-cx-diag.cc b/src/ov-cx-diag.cc --- a/src/ov-cx-diag.cc +++ b/src/ov-cx-diag.cc @@ -229,3 +229,10 @@ x = val.complex_value (); return retval; } + +/* + +%% bug #36368 +%!assert (diag ([1+i, 1-i])^2 , diag ([2i, -2i]), 4*eps); + +*/ diff --git a/src/ov-cx-mat.cc b/src/ov-cx-mat.cc --- a/src/ov-cx-mat.cc +++ b/src/ov-cx-mat.cc @@ -292,6 +292,24 @@ return retval; } +octave_value +octave_complex_matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + octave_value retval; + + if (matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + { + ComplexMatrix mat = matrix.matrix_value (); + + retval = mat.diag (m, n); + } + else + error ("diag: expecting vector argument"); + + return retval; +} + bool octave_complex_matrix::save_ascii (std::ostream& os) { diff --git a/src/ov-cx-mat.h b/src/ov-cx-mat.h --- a/src/ov-cx-mat.h +++ b/src/ov-cx-mat.h @@ -135,6 +135,8 @@ octave_value diag (octave_idx_type k = 0) const; + octave_value diag (octave_idx_type m, octave_idx_type n) const; + void increment (void) { matrix += Complex (1.0); } void decrement (void) { matrix -= Complex (1.0); } diff --git a/src/ov-fcn-handle.cc b/src/ov-fcn-handle.cc --- a/src/ov-fcn-handle.cc +++ b/src/ov-fcn-handle.cc @@ -80,6 +80,9 @@ if (uf && nm != anonymous) symbol_table::cache_name (uf->scope (), nm); + + if (uf && uf->is_nested_function ()) + ::error ("handles to nested functions are not yet supported"); } octave_value_list diff --git a/src/ov-float.cc b/src/ov-float.cc --- a/src/ov-float.cc +++ b/src/ov-float.cc @@ -98,6 +98,12 @@ } octave_value +octave_float_scalar::diag (octave_idx_type m, octave_idx_type n) const +{ + return FloatDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); +} + +octave_value octave_float_scalar::convert_to_str_internal (bool, bool, char type) const { octave_value retval; diff --git a/src/ov-float.h b/src/ov-float.h --- a/src/ov-float.h +++ b/src/ov-float.h @@ -211,6 +211,8 @@ return boolNDArray (dim_vector (1, 1), scalar); } + octave_value diag (octave_idx_type m, octave_idx_type n) const; + octave_value convert_to_str_internal (bool pad, bool force, char type) const; void increment (void) { ++scalar; } diff --git a/src/ov-flt-complex.cc b/src/ov-flt-complex.cc --- a/src/ov-flt-complex.cc +++ b/src/ov-flt-complex.cc @@ -228,6 +228,12 @@ } } +octave_value +octave_float_complex::diag (octave_idx_type m, octave_idx_type n) const +{ + return FloatComplexDiagMatrix (Array (dim_vector (1, 1), scalar), m, n); +} + bool octave_float_complex::save_ascii (std::ostream& os) { diff --git a/src/ov-flt-complex.h b/src/ov-flt-complex.h --- a/src/ov-flt-complex.h +++ b/src/ov-flt-complex.h @@ -152,6 +152,8 @@ return boolNDArray (dim_vector (1, 1), scalar != 1.0f); } + octave_value diag (octave_idx_type m, octave_idx_type n) const; + void increment (void) { scalar += 1.0; } void decrement (void) { scalar -= 1.0; } diff --git a/src/ov-flt-cx-mat.cc b/src/ov-flt-cx-mat.cc --- a/src/ov-flt-cx-mat.cc +++ b/src/ov-flt-cx-mat.cc @@ -281,6 +281,24 @@ return retval; } +octave_value +octave_float_complex_matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + octave_value retval; + + if (matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + { + FloatComplexMatrix mat = matrix.matrix_value (); + + retval = mat.diag (m, n); + } + else + error ("diag: expecting vector argument"); + + return retval; +} + bool octave_float_complex_matrix::save_ascii (std::ostream& os) { diff --git a/src/ov-flt-cx-mat.h b/src/ov-flt-cx-mat.h --- a/src/ov-flt-cx-mat.h +++ b/src/ov-flt-cx-mat.h @@ -133,6 +133,8 @@ octave_value diag (octave_idx_type k = 0) const; + octave_value diag (octave_idx_type m, octave_idx_type n) const; + void increment (void) { matrix += FloatComplex (1.0); } void decrement (void) { matrix -= FloatComplex (1.0); } diff --git a/src/ov-flt-re-mat.cc b/src/ov-flt-re-mat.cc --- a/src/ov-flt-re-mat.cc +++ b/src/ov-flt-re-mat.cc @@ -264,6 +264,24 @@ } octave_value +octave_float_matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + octave_value retval; + + if (matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + { + FloatMatrix mat = matrix.matrix_value (); + + retval = mat.diag (m, n); + } + else + error ("diag: expecting vector argument"); + + return retval; +} + +octave_value octave_float_matrix::convert_to_str_internal (bool, bool, char type) const { octave_value retval; diff --git a/src/ov-flt-re-mat.h b/src/ov-flt-re-mat.h --- a/src/ov-flt-re-mat.h +++ b/src/ov-flt-re-mat.h @@ -164,6 +164,8 @@ octave_value diag (octave_idx_type k = 0) const; + octave_value diag (octave_idx_type m, octave_idx_type n) const; + // Use matrix_ref here to clear index cache. void increment (void) { matrix_ref () += 1.0; } diff --git a/src/ov-range.cc b/src/ov-range.cc --- a/src/ov-range.cc +++ b/src/ov-range.cc @@ -248,6 +248,13 @@ : octave_value (range.diag (k))); } +octave_value +octave_range::diag (octave_idx_type m, octave_idx_type n) const +{ + Matrix mat = range.matrix_value (); + + return mat.diag (m, n); +} bool octave_range::is_true (void) const diff --git a/src/ov-range.h b/src/ov-range.h --- a/src/ov-range.h +++ b/src/ov-range.h @@ -139,6 +139,8 @@ octave_value diag (octave_idx_type k = 0) const; + octave_value diag (octave_idx_type m, octave_idx_type n) const; + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const { return range.sort (dim, mode); } diff --git a/src/ov-re-mat.cc b/src/ov-re-mat.cc --- a/src/ov-re-mat.cc +++ b/src/ov-re-mat.cc @@ -272,6 +272,24 @@ return retval; } +octave_value +octave_matrix::diag (octave_idx_type m, octave_idx_type n) const +{ + octave_value retval; + + if (matrix.ndims () == 2 + && (matrix.rows () == 1 || matrix.columns () == 1)) + { + Matrix mat = matrix.matrix_value (); + + retval = mat.diag (m, n); + } + else + error ("diag: expecting vector argument"); + + return retval; +} + // We override these two functions to allow reshaping both // the matrix and the index cache. octave_value diff --git a/src/ov-re-mat.h b/src/ov-re-mat.h --- a/src/ov-re-mat.h +++ b/src/ov-re-mat.h @@ -178,6 +178,8 @@ octave_value diag (octave_idx_type k = 0) const; + octave_value diag (octave_idx_type m, octave_idx_type n) const; + octave_value reshape (const dim_vector& new_dims) const; octave_value squeeze (void) const; diff --git a/src/ov-scalar.cc b/src/ov-scalar.cc --- a/src/ov-scalar.cc +++ b/src/ov-scalar.cc @@ -113,6 +113,12 @@ } octave_value +octave_scalar::diag (octave_idx_type m, octave_idx_type n) const +{ + return DiagMatrix (Array (dim_vector (1, 1), scalar), m, n); +} + +octave_value octave_scalar::convert_to_str_internal (bool, bool, char type) const { octave_value retval; diff --git a/src/ov-scalar.h b/src/ov-scalar.h --- a/src/ov-scalar.h +++ b/src/ov-scalar.h @@ -212,6 +212,8 @@ return boolNDArray (dim_vector (1, 1), scalar); } + octave_value diag (octave_idx_type m, octave_idx_type n) const; + octave_value convert_to_str_internal (bool pad, bool force, char type) const; void increment (void) { ++scalar; } diff --git a/src/ov-usr-fcn.cc b/src/ov-usr-fcn.cc --- a/src/ov-usr-fcn.cc +++ b/src/ov-usr-fcn.cc @@ -188,8 +188,9 @@ system_fcn_file (false), call_depth (-1), num_named_args (param_list ? param_list->length () : 0), subfunction (false), inline_function (false), - anonymous_function (false), class_constructor (false), - class_method (false), parent_scope (-1), local_scope (sid), + anonymous_function (false), nested_function(false), + class_constructor (false), class_method (false), + parent_scope (-1), local_scope (sid), curr_unwind_protect_frame (0) { if (cmd_list) @@ -387,7 +388,7 @@ // Save old and set current symbol table context, for // eval_undefined_error(). - int context = is_anonymous_function () ? 0 : call_depth; + int context = active_context (); octave_call_stack::push (this, local_scope, context); frame.add_fcn (octave_call_stack::pop); @@ -601,6 +602,9 @@ if (takes_varargs ()) symbol_table::varref ("varargin") = va_args.cell_value (); + // Force .ignored. variable to be undefined by default. + symbol_table::varref (".ignored.") = octave_value (); + if (lvalue_list) { octave_idx_type nbh = 0; @@ -622,11 +626,11 @@ } symbol_table::varref (".ignored.") = bh; - - symbol_table::mark_hidden (".ignored."); - symbol_table::mark_automatic (".ignored."); } } + + symbol_table::mark_hidden (".ignored."); + symbol_table::mark_automatic (".ignored."); } DEFUN (nargin, args, , @@ -923,3 +927,40 @@ return retval; } + +/* +%!function [x, y] = try_isargout () +%! if (isargout (1)) +%! if (isargout (2)) +%! x = 1; y = 2; +%! else +%! x = -1; +%! endif +%! else +%! if (isargout (2)) +%! y = -2; +%! else +%! error ("no outputs requested"); +%! endif +%! endif +%!endfunction +%! +%!test +%! [x, y] = try_isargout (); +%! assert ([x, y], [1, 2]); +%! +%!test +%! [x, ~] = try_isargout (); +%! assert (x, -1); +%! +%!test +%! [~, y] = try_isargout (); +%! assert (y, -2); +%! +%!error [~, ~] = try_isargout (); +%! +%% Check to see that isargout isn't sticky: +%!test +%! [x, y] = try_isargout (); +%! assert ([x, y], [1, 2]); +*/ diff --git a/src/ov-usr-fcn.h b/src/ov-usr-fcn.h --- a/src/ov-usr-fcn.h +++ b/src/ov-usr-fcn.h @@ -177,6 +177,12 @@ ~octave_user_function (void); + symbol_table::context_id active_context () const + { + return is_anonymous_function () + ? 0 : static_cast(call_depth); + } + octave_function *function_value (bool = false) { return this; } octave_user_function *user_function_value (bool = false) { return this; } @@ -277,6 +283,10 @@ : false; } + bool is_nested_function (void) const { return nested_function; } + + void mark_as_nested_function (void) { nested_function = true; } + void mark_as_class_constructor (void) { class_constructor = true; } bool is_class_constructor (const std::string& cname = std::string ()) const @@ -400,6 +410,9 @@ // TRUE means this is an anonymous function. bool anonymous_function; + // TRUE means this is a nested function. (either a child or parent) + bool nested_function; + // TRUE means this function is the constructor for class object. bool class_constructor; diff --git a/src/ov.cc b/src/ov.cc diff --git a/src/ov.h b/src/ov.h --- a/src/ov.h +++ b/src/ov.h @@ -1075,6 +1075,9 @@ octave_value diag (octave_idx_type k = 0) const { return rep->diag (k); } + octave_value diag (octave_idx_type m, octave_idx_type n) const + { return rep->diag (m, n); } + octave_value sort (octave_idx_type dim = 0, sortmode mode = ASCENDING) const { return rep->sort (dim, mode); } octave_value sort (Array &sidx, octave_idx_type dim = 0, diff --git a/src/pager.cc b/src/pager.cc --- a/src/pager.cc +++ b/src/pager.cc @@ -591,6 +591,7 @@ Turn output pagination on or off. Without an argument, @code{more}\n\ toggles the current state.\n\ The current state can be determined via @code{page_screen_output}.\n\ +@seealso{page_screen_output, page_output_immediately, PAGER, PAGER_FLAGS}\n\ @end deftypefn") { octave_value_list retval; @@ -650,6 +651,7 @@ When called from inside a function with the \"local\" option, the variable is\n\ changed locally for the function and any subroutines it calls. The original\n\ variable value is restored when exiting the function.\n\ +@seealso{page_screen_output, more, PAGER, PAGER_FLAGS}\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (page_output_immediately); @@ -669,6 +671,7 @@ When called from inside a function with the \"local\" option, the variable is\n\ changed locally for the function and any subroutines it calls. The original\n\ variable value is restored when exiting the function.\n\ +@seealso{more, page_output_immediately, PAGER, PAGER_FLAGS}\n\ @end deftypefn") { return SET_INTERNAL_VARIABLE (page_screen_output); @@ -688,7 +691,7 @@ When called from inside a function with the \"local\" option, the variable is\n\ changed locally for the function and any subroutines it calls. The original\n\ variable value is restored when exiting the function.\n\ -@seealso{more, page_screen_output, page_output_immediately, PAGER_FLAGS}\n\ +@seealso{PAGER_FLAGS, page_output_immediately, more, page_screen_output}\n\ @end deftypefn") { return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER); @@ -705,7 +708,7 @@ When called from inside a function with the \"local\" option, the variable is\n\ changed locally for the function and any subroutines it calls. The original\n\ variable value is restored when exiting the function.\n\ -@seealso{PAGER}\n\ +@seealso{PAGER, more, page_screen_output, page_output_immediately}\n\ @end deftypefn") { return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (PAGER_FLAGS); diff --git a/src/pt-assign.cc b/src/pt-assign.cc --- a/src/pt-assign.cc +++ b/src/pt-assign.cc @@ -431,7 +431,30 @@ } } else - error ("element number %d undefined in return list", k+1); + { + // This can happen for a function like + // + // function varargout = f () + // varargout{1} = nargout; + // endfunction + // + // called with + // + // [a, ~] = f (); + // + // Then the list of of RHS values will contain one + // element but we are iterating over the list of all + // RHS values. We shouldn't complain that a value we + // don't need is missing from the list. + + if (ult.is_black_hole ()) + { + k++; + continue; + } + else + error ("element number %d undefined in return list", k+1); + } } if (error_state) @@ -467,6 +490,19 @@ return retval; } +/* +%!function varargout = f () +%! varargout{1} = nargout; +%!endfunction +%! +%!test +%! [a, ~] = f (); +%! assert (a, 2); +%!test +%! [a, ~, ~, ~, ~] = f (); +%! assert (a, 5); +*/ + std::string tree_multi_assignment::oper (void) const { diff --git a/src/pt-id.h b/src/pt-id.h --- a/src/pt-id.h +++ b/src/pt-id.h @@ -128,7 +128,7 @@ { symbol_table::scope_id curr_scope = symbol_table::current_scope (); - if (scope != curr_scope) + if (scope != curr_scope || ! sym.is_valid ()) { scope = curr_scope; sym = symbol_table::insert (sym.name ()); diff --git a/src/pt-mat.cc b/src/pt-mat.cc --- a/src/pt-mat.cc +++ b/src/pt-mat.cc @@ -784,7 +784,7 @@ { // Optimize all scalars case. result.clear (dv); - assert (result.numel () == row.length ()); + assert (static_cast (result.numel ()) == row.length ()); octave_idx_type i = 0; for (tm_row_const::iterator q = row.begin (); q != row.end () && ! error_state; q++) diff --git a/src/symtab.cc b/src/symtab.cc --- a/src/symtab.cc +++ b/src/symtab.cc @@ -78,11 +78,25 @@ singleton_cleanup_list::add (cleanup_instance); } +symbol_table::context_id +symbol_table::symbol_record::symbol_record_rep::active_context (void) const +{ + octave_user_function *fcn = curr_fcn; + + // FIXME -- If active_context () == -1, then it does not make much + // sense to use this symbol_record. This means an attempt at accessing + // a variable from a function that has not been called yet is + // happening. This should be cleared up when an implementing closures. + + return fcn && fcn->active_context () != static_cast (-1) + ? fcn->active_context () : xcurrent_context; +} + void symbol_table::symbol_record::symbol_record_rep::dump (std::ostream& os, const std::string& prefix) const { - octave_value val = varval (xcurrent_context); + octave_value val = varval (); os << prefix << name; @@ -625,40 +639,23 @@ // subfunctions if we are currently executing a function defined // from a .m file. - scope_val_iterator r = subfunctions.find (xcurrent_scope); - octave_user_function *curr_fcn = symbol_table::get_curr_fcn (); - if (r != subfunctions.end ()) + for (scope_id scope = xcurrent_scope; scope >= 0;) { - // FIXME -- out-of-date check here. - - return r->second; - } - else - { - if (curr_fcn) + scope_val_iterator r = subfunctions.find (scope); + if (r != subfunctions.end ()) { - // FIXME -- maybe it would be better if we could just get - // a pointer to the parent function so we would have - // access to all info about it instead of only being able - // to query the current function for specific bits of info - // about its parent function? + // FIXME -- out-of-date check here. - scope_id pscope = curr_fcn->parent_fcn_scope (); + return r->second; + } - if (pscope > 0) - { - r = subfunctions.find (pscope); - - if (r != subfunctions.end ()) - { - // FIXME -- out-of-date check here. - - return r->second; - } - } - } + octave_user_function *scope_curr_fcn = get_curr_fcn (scope); + if (scope_curr_fcn) + scope = scope_curr_fcn->parent_fcn_scope (); + else + scope = -1; } // Private function. @@ -896,29 +893,21 @@ // subfunctions if we are currently executing a function defined // from a .m file. - scope_val_iterator r = subfunctions.find (xcurrent_scope); - - if (r != subfunctions.end ()) + for (scope_id scope = xcurrent_scope; scope >= 0;) { - // FIXME -- out-of-date check here. - - return r->second; - } - else if (curr_fcn) - { - scope_id pscope = curr_fcn->parent_fcn_scope (); + scope_val_iterator r = subfunctions.find (scope); + if (r != subfunctions.end ()) + { + // FIXME -- out-of-date check here. - if (pscope > 0) - { - r = subfunctions.find (pscope); + return r->second; + } - if (r != subfunctions.end ()) - { - // FIXME -- out-of-date check here. - - return r->second; - } - } + octave_user_function *scope_curr_fcn = get_curr_fcn (scope); + if (scope_curr_fcn) + scope = scope_curr_fcn->parent_fcn_scope (); + else + scope = -1; } return octave_value (); @@ -1144,6 +1133,23 @@ } } +void +symbol_table::install_nestfunction (const std::string& name, + const octave_value& fcn, + scope_id parent_scope) +{ + install_subfunction (name, fcn, parent_scope); + + // Stash the nest_parent for resolving variables after parsing is done. + octave_function *fv = fcn.function_value(); + + symbol_table *fcn_table = get_instance (fv->scope()); + + symbol_table *parent_table = get_instance (parent_scope); + + parent_table->add_nest_child (*fcn_table); +} + octave_value symbol_table::find (const std::string& name, const octave_value_list& args, @@ -1456,6 +1462,44 @@ } } +void +symbol_table::do_update_nest (void) +{ + if (nest_parent || nest_children.size ()) + curr_fcn->mark_as_nested_function (); + + if (nest_parent) + { + // fix bad symbol_records + for (table_iterator ti = table.begin (); ti != table.end (); ++ti) + { + symbol_record &ours = ti->second; + symbol_record parents; + if (! ours.is_formal () + && nest_parent->look_nonlocal (ti->first, parents)) + { + if (ours.is_global () || ours.is_persistent ()) + ::error ("global and persistent may only be used in the topmost level in which a nested variable is used"); + + if (! ours.is_formal ()) + { + ours.invalidate (); + ti->second = parents; + } + } + else + ours.set_curr_fcn (curr_fcn); + } + } + else if (nest_children.size()) + for (table_iterator ti = table.begin (); ti != table.end (); ++ti) + ti->second.set_curr_fcn (curr_fcn); + + for (std::vector::iterator iter = nest_children.begin (); + iter != nest_children.end (); ++iter) + (*iter)->do_update_nest (); +} + DEFUN (ignore_function_time_stamp, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} ignore_function_time_stamp ()\n\ diff --git a/src/symtab.h b/src/symtab.h --- a/src/symtab.h +++ b/src/symtab.h @@ -208,22 +208,26 @@ { public: - symbol_record_rep (const std::string& nm, const octave_value& v, - unsigned int sc) - : name (nm), value_stack (), storage_class (sc), finfo (), count (1) + symbol_record_rep (scope_id s, const std::string& nm, + const octave_value& v, unsigned int sc) + : decl_scope (s), curr_fcn (0), name (nm), value_stack (), + storage_class (sc), finfo (), valid (true), count (1) { value_stack.push_back (v); } - void force_variable (context_id context) + void force_variable (context_id context = xdefault_context) { + if (context == xdefault_context) + context = active_context (); + octave_value& val = varref (context); if (! val.is_defined ()) mark_forced (); } - octave_value& varref (context_id context) + octave_value& varref (context_id context = xdefault_context) { if (is_global ()) return symbol_table::global_varref (name); @@ -231,6 +235,9 @@ return symbol_table::persistent_varref (name); else { + if (context == xdefault_context) + context = active_context (); + context_id n = value_stack.size (); while (n++ <= context) value_stack.push_back (octave_value ()); @@ -239,7 +246,7 @@ } } - octave_value varval (context_id context) const + octave_value varval (context_id context = xdefault_context) const { if (is_global ()) return symbol_table::global_varval (name); @@ -247,6 +254,9 @@ return symbol_table::persistent_varval (name); else { + if (context == xdefault_context) + context = active_context (); + if (context < value_stack.size ()) return value_stack[context]; else @@ -254,9 +264,10 @@ } } - void push_context (void) + void push_context (scope_id s) { - if (! (is_persistent () || is_global ())) + if (! (is_persistent () || is_global ()) + && s == scope ()) value_stack.push_back (octave_value ()); } @@ -274,11 +285,12 @@ // // Here, X should only exist in the final stack frame. - size_t pop_context (void) + size_t pop_context (scope_id s) { size_t retval = 1; - if (! (is_persistent () || is_global ())) + if (! (is_persistent () || is_global ()) + && s == scope ()) { value_stack.pop_back (); retval = value_stack.size (); @@ -287,9 +299,12 @@ return retval; } - void clear (void) + void clear (void) { clear (scope ()); } + + void clear (scope_id s) { - if (! (is_hidden () || is_inherited ())) + if (! (is_hidden () || is_inherited ()) + && s == scope ()) { if (is_global ()) unmark_global (); @@ -297,22 +312,33 @@ if (is_persistent ()) { symbol_table::persistent_varref (name) - = varval (xcurrent_context); + = varval (); unmark_persistent (); } - varref (xcurrent_context) = octave_value (); + varref () = octave_value (); } } - bool is_defined (context_id context) const + bool is_defined (context_id context = xdefault_context) const { + if (context == xdefault_context) + context = active_context (); + return varval (context).is_defined (); } + bool is_valid (void) const + { + return valid; + } + bool is_variable (context_id context) const { + if (context == xdefault_context) + context = active_context (); + return (! is_local () || is_defined (context) || is_forced ()); } @@ -357,31 +383,49 @@ void init_persistent (void) { - if (! is_defined (xcurrent_context)) + if (! is_defined ()) { mark_persistent (); - varref (xcurrent_context) = symbol_table::persistent_varval (name); + varref () = symbol_table::persistent_varval (name); } // FIXME -- this causes trouble with recursive calls. // else // error ("unable to declare existing variable persistent"); } + void invalidate (void) + { + valid = false; + } + void erase_persistent (void) { unmark_persistent (); symbol_table::erase_persistent (name); } - symbol_record_rep *dup (void) const + context_id active_context (void) const; + + scope_id scope (void) const { return decl_scope; } + + void set_curr_fcn (octave_user_function *fcn) { - return new symbol_record_rep (name, varval (xcurrent_context), + curr_fcn = fcn; + } + + symbol_record_rep *dup (scope_id new_scope) const + { + return new symbol_record_rep (new_scope, name, varval (), storage_class); } void dump (std::ostream& os, const std::string& prefix) const; + scope_id decl_scope; + + octave_user_function* curr_fcn; + std::string name; std::deque value_stack; @@ -390,6 +434,8 @@ fcn_info *finfo; + bool valid; + octave_refcount count; private: @@ -403,10 +449,11 @@ public: - symbol_record (const std::string& nm = std::string (), + symbol_record (scope_id s = xcurrent_scope, + const std::string& nm = std::string (), const octave_value& v = octave_value (), unsigned int sc = local) - : rep (new symbol_record_rep (nm, v, sc)) { } + : rep (new symbol_record_rep (s, nm, v, sc)) { } symbol_record (const symbol_record& sr) : rep (sr.rep) @@ -434,39 +481,50 @@ delete rep; } - symbol_record dup (void) const { return symbol_record (rep->dup ()); } + symbol_record dup (scope_id new_scope) const + { + return symbol_record (rep->dup (new_scope)); + } std::string name (void) const { return rep->name; } - octave_value find (const octave_value_list& args = octave_value_list ()) const; - - void force_variable (context_id context = xcurrent_context) + octave_value + find (const octave_value_list& args = octave_value_list ()) const; + + void force_variable (context_id context = xdefault_context) { rep->force_variable (context); } - octave_value& varref (context_id context = xcurrent_context) + octave_value& varref (context_id context = xdefault_context) { return rep->varref (context); } - octave_value varval (context_id context = xcurrent_context) const + octave_value varval (context_id context = xdefault_context) const { return rep->varval (context); } - void push_context (void) { rep->push_context (); } - - size_t pop_context (void) { return rep->pop_context (); } + void push_context (scope_id s) { rep->push_context (s); } + + size_t pop_context (scope_id s) { return rep->pop_context (s); } void clear (void) { rep->clear (); } - bool is_defined (context_id context = xcurrent_context) const + void clear (scope_id s) { rep->clear (s); } + + bool is_defined (context_id context = xdefault_context) const { return rep->is_defined (context); } - bool is_variable (context_id context = xcurrent_context) const + bool is_valid (void) const + { + return rep->is_valid (); + } + + bool is_variable (context_id context = xdefault_context) const { return rep->is_variable (context); } @@ -502,8 +560,16 @@ void erase_persistent (void) { rep->erase_persistent (); } + void invalidate (void) { rep->invalidate (); } + + context_id active_context (void) const { return rep->active_context (); } + + scope_id scope (void) const { return rep->scope (); } + unsigned int xstorage_class (void) const { return rep->storage_class; } + void set_curr_fcn (octave_user_function *fcn) { rep->set_curr_fcn (fcn); } + void dump (std::ostream& os, const std::string& prefix = std::string ()) const { @@ -930,7 +996,7 @@ if (p == all_instances.end ()) { - symbol_table *inst = new symbol_table (); + symbol_table *inst = new symbol_table (scope); if (inst) all_instances[scope] = instance = inst; @@ -1011,7 +1077,7 @@ { scope_id new_scope = alloc_scope (); - symbol_table *new_symbol_table = new symbol_table (); + symbol_table *new_symbol_table = new symbol_table (scope); if (new_symbol_table) { @@ -1036,7 +1102,8 @@ { symbol_table *inst = get_instance (scope); - return inst ? inst->do_find_symbol (name) : symbol_record (); + return inst ? inst->do_find_symbol (name) : + symbol_record (scope); } static void @@ -1076,7 +1143,7 @@ static void force_variable (const std::string& name, scope_id scope = xcurrent_scope, - context_id context = xcurrent_context) + context_id context = xdefault_context) { symbol_table *inst = get_instance (scope); @@ -1086,7 +1153,7 @@ static octave_value& varref (const std::string& name, scope_id scope = xcurrent_scope, - context_id context = xcurrent_context) + context_id context = xdefault_context) { static octave_value foobar; @@ -1097,7 +1164,7 @@ static octave_value varval (const std::string& name, scope_id scope = xcurrent_scope, - context_id context = xcurrent_context) + context_id context = xdefault_context) { symbol_table *inst = get_instance (scope); @@ -1265,6 +1332,17 @@ } } + static void install_nestfunction (const std::string& name, + const octave_value& fcn, + scope_id parent_scope); + + static void update_nest (scope_id scope) + { + symbol_table *inst = get_instance (scope); + if (inst) + inst->do_update_nest (); + } + static void install_user_function (const std::string& name, const octave_value& fcn) { @@ -1622,7 +1700,7 @@ static std::list all_variables (scope_id scope = xcurrent_scope, - context_id context = xcurrent_context, + context_id context = xdefault_context, bool defined_only = true) { symbol_table *inst = get_instance (scope); @@ -1674,7 +1752,8 @@ // may be handled the same way. if (pat.match (p->first)) - retval.push_back (symbol_record (p->first, p->second, + retval.push_back (symbol_record (xglobal_scope, + p->first, p->second, symbol_record::global)); } @@ -1696,7 +1775,8 @@ // may be handled the same way. if (pat.is_match (p->first)) - retval.push_back (symbol_record (p->first, p->second, + retval.push_back (symbol_record (xglobal_scope, + p->first, p->second, symbol_record::global)); } @@ -1926,7 +2006,8 @@ symbol_table *inst = get_instance (scope); // FIXME: normally, functions should not usurp each other's scope. // If for any incredible reason this is needed, call - // set_user_function (0, scope) first. + // set_user_function (0, scope) first. This may cause problems with + // nested functions, as the curr_fcn of symbol_records must be updated. assert (inst->curr_fcn == 0 || curr_fcn == 0); inst->curr_fcn = curr_fcn; } @@ -1955,6 +2036,9 @@ typedef std::map::const_iterator fcn_table_const_iterator; typedef std::map::iterator fcn_table_iterator; + + // The scope of this symbol table. + scope_id my_scope; // Name for this table (usually the file name of the function // corresponding to the scope); @@ -1963,8 +2047,11 @@ // Map from symbol names to symbol info. std::map table; - // Mutex for symbol table access. - octave_mutex table_mutex; + // Child nested functions. + std::vector nest_children; + + // Parent nested function (may be null). + symbol_table *nest_parent; // The associated user code (may be null). octave_user_function *curr_fcn; @@ -2005,8 +2092,11 @@ static context_id xcurrent_context; - symbol_table (void) - : table_name (), table (), curr_fcn (0), persistent_table () { } + static const context_id xdefault_context = static_cast (-1); + + symbol_table (scope_id scope) + : my_scope (scope), table_name (), table (), nest_children (), nest_parent (0), + curr_fcn (0), persistent_table () { } ~symbol_table (void) { } @@ -2022,7 +2112,7 @@ { if (! instance && create) { - symbol_table *inst = new symbol_table (); + symbol_table *inst = new symbol_table (scope); if (inst) { @@ -2046,7 +2136,7 @@ { if (create) { - retval = new symbol_table (); + retval = new symbol_table (scope); if (retval) all_instances[scope] = retval; @@ -2068,6 +2158,13 @@ return retval; } + void add_nest_child (symbol_table& st) + { + assert (!st.nest_parent); + nest_children.push_back (&st); + st.nest_parent = this; + } + void insert_symbol_record (const symbol_record& sr) { octave_autolock lock (table_mutex); @@ -2079,7 +2176,7 @@ { octave_autolock lock (table_mutex); for (table_const_iterator p = table.begin (); p != table.end (); p++) - new_symbol_table.insert_symbol_record (p->second.dup ()); + new_symbol_table.insert_symbol_record (p->second.dup (new_symbol_table.my_scope)); } symbol_record do_find_symbol (const std::string& name) @@ -2135,8 +2232,17 @@ octave_autolock lock (table_mutex); table_iterator p = table.find (name); - return p == table.end () - ? (table[name] = symbol_record (name)) : p->second; + if (p == table.end ()) + { + symbol_record parent_symbol; + + if (nest_parent && nest_parent->look_nonlocal (name, parent_symbol)) + return table[name] = parent_symbol; + else + return table[name] = symbol_record (my_scope, name, octave_value ()); + } + else + return p->second; } void do_force_variable (const std::string& name, context_id context) @@ -2223,7 +2329,7 @@ { octave_autolock lock (table_mutex); for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.push_context (); + p->second.push_context (my_scope); } void do_pop_context (void) @@ -2231,8 +2337,8 @@ octave_autolock lock (table_mutex); for (table_iterator p = table.begin (); p != table.end (); ) { - if (p->second.pop_context () == 0) - table.erase (p++); + if (p->second.pop_context (my_scope) == 0) + table.erase (p++); else p++; } @@ -2242,7 +2348,7 @@ { octave_autolock lock (table_mutex); for (table_iterator p = table.begin (); p != table.end (); p++) - p->second.clear (); + p->second.clear (my_scope); } void do_clear_objects (void) @@ -2253,7 +2359,7 @@ symbol_record& sr = p->second; octave_value& val = sr.varref (); if (val.is_object()) - p->second.clear (); + p->second.clear (my_scope); } } @@ -2290,7 +2396,7 @@ table_iterator p = table.find (name); if (p != table.end ()) - p->second.clear (); + p->second.clear (my_scope); } void do_clear_global_pattern (const std::string& pat) @@ -2332,7 +2438,7 @@ if (sr.is_defined () || sr.is_global ()) { if (pattern.match (sr.name ())) - sr.clear (); + sr.clear (my_scope); } } } @@ -2349,7 +2455,7 @@ if (sr.is_defined () || sr.is_global ()) { if (pattern.is_match (sr.name ())) - sr.clear (); + sr.clear (my_scope); } } } @@ -2493,6 +2599,25 @@ void do_dump (std::ostream& os); void do_cache_name (const std::string& name) { table_name = name; } + + void do_update_nest (void); + + bool look_nonlocal (const std::string& name, symbol_record& result) + { + table_iterator p = table.find (name); + if (p == table.end ()) + { + if (nest_parent) + return nest_parent->look_nonlocal (name, result); + } + else if (! p->second.is_automatic ()) + { + result = p->second; + return true; + } + + return false; + } }; extern bool out_of_date_check (octave_value& function, diff --git a/src/version.h.in b/src/version.in.h rename from src/version.h.in rename to src/version.in.h diff --git a/test/Makefile.am b/test/Makefile.am --- a/test/Makefile.am +++ b/test/Makefile.am @@ -51,10 +51,12 @@ test_while.m include bug-35448/module.mk +include bug-36025/module.mk include classes/module.mk include class-concat/module.mk include ctor-vs-method/module.mk include fcn-handle-derived-resolution/module.mk +include nest/module.mk check: test_sparse.m test_bc_overloads.m $(top_builddir)/run-octave --norc --silent --no-history $(srcdir)/fntests.m $(srcdir) diff --git a/test/bug-35448/module.mk b/test/bug-35448/module.mk --- a/test/bug-35448/module.mk +++ b/test/bug-35448/module.mk @@ -2,6 +2,6 @@ bug-35448/fA.m \ bug-35448/fB.m \ bug-35448/fC.m \ - class-concat/test_bug_35448.m + bug-35448/test_bug_35448.m FCN_FILES += $(bug_35448_FCN_FILES) diff --git a/test/bug-36025/@testclass/one.m b/test/bug-36025/@testclass/one.m new file mode 100644 --- /dev/null +++ b/test/bug-36025/@testclass/one.m @@ -0,0 +1,4 @@ +% function ONE return item "X" + +function a=one(m) + a=m.x; diff --git a/test/bug-36025/@testclass/testclass.m b/test/bug-36025/@testclass/testclass.m new file mode 100644 --- /dev/null +++ b/test/bug-36025/@testclass/testclass.m @@ -0,0 +1,3 @@ +function m=testclass(x,y) +m=struct('x',x,'y',y); +m=class(m,"testclass"); diff --git a/test/bug-36025/@testclass/two.m b/test/bug-36025/@testclass/two.m new file mode 100644 --- /dev/null +++ b/test/bug-36025/@testclass/two.m @@ -0,0 +1,4 @@ +% function TWO returns item "Y" + +function a=one(m) + a=m.y; diff --git a/test/bug-36025/module.mk b/test/bug-36025/module.mk new file mode 100644 --- /dev/null +++ b/test/bug-36025/module.mk @@ -0,0 +1,7 @@ +bug_36025_FCN_FILES = \ + bug-36025/@testclass/one.m \ + bug-36025/@testclass/testclass.m \ + bug-36025/@testclass/two.m \ + bug-36025/test_bug_36025.m + +FCN_FILES += $(bug_36025_FCN_FILES) diff --git a/test/bug-36025/test_bug_36025.m b/test/bug-36025/test_bug_36025.m new file mode 100644 --- /dev/null +++ b/test/bug-36025/test_bug_36025.m @@ -0,0 +1,9 @@ +%!test +%! warning off Octave:function-name-clash +%! f = testclass (1, 2); +%! assert (one (f), 1); +%! assert (two (f), 2); +%! rehash (); +%! assert (one (f), 1); +%! assert (two (f), 2); +%! assert (two (f), 2); diff --git a/test/nest/arg_nest.m b/test/nest/arg_nest.m new file mode 100644 --- /dev/null +++ b/test/nest/arg_nest.m @@ -0,0 +1,8 @@ +# arg_nest.m +function x = arg_nest + x = 1; + A (x); + function A (x) + x = 2; + endfunction +endfunction diff --git a/test/nest/arg_ret.m b/test/nest/arg_ret.m new file mode 100644 --- /dev/null +++ b/test/nest/arg_ret.m @@ -0,0 +1,7 @@ +function a = arg_ret + a = 10; + f; + function a = f + a = 5; + endfunction +endfunction diff --git a/test/nest/module.mk b/test/nest/module.mk new file mode 100644 --- /dev/null +++ b/test/nest/module.mk @@ -0,0 +1,20 @@ +nest_FCN_FILES = \ + nest/arg_nest.m \ + nest/arg_ret.m \ + nest/no_closure.m \ + nest/persistent_nest.m \ + nest/recursive_nest.m \ + nest/recursive_nest2.m \ + nest/recursive_nest3.m \ + nest/scope0.m \ + nest/scope1.m \ + nest/scope2.m \ + nest/scope3.m \ + nest/script_nest.m \ + nest/script_nest_script.m \ + nest/test_nest.m \ + nest/varg_nest.m \ + nest/varg_nest2.m + +FCN_FILES += $(nest_FCN_FILES) + diff --git a/test/nest/no_closure.m b/test/nest/no_closure.m new file mode 100644 --- /dev/null +++ b/test/nest/no_closure.m @@ -0,0 +1,11 @@ +# no_closure.m +function no_closure (n) + if n == 0 + x = @no_closure; + else + f = @no_closure; + endif + + function f + endfunction +endfunction diff --git a/test/nest/persistent_nest.m b/test/nest/persistent_nest.m new file mode 100644 --- /dev/null +++ b/test/nest/persistent_nest.m @@ -0,0 +1,10 @@ +# persistent_nest +function y = persistent_nest () + persistent x = 0; + g; + y = x; + + function g + x = x + 1; + end +end diff --git a/test/nest/recursive_nest.m b/test/nest/recursive_nest.m new file mode 100644 --- /dev/null +++ b/test/nest/recursive_nest.m @@ -0,0 +1,13 @@ +# recursive_nest.m +function x = recursive_nest () + global recursive_nest_inc = 1 + x = 5; + f (20); + + function f (n) + if n > 0 + x = x + recursive_nest_inc; + f (n - 1); + end + endfunction +endfunction diff --git a/test/nest/recursive_nest2.m b/test/nest/recursive_nest2.m new file mode 100644 --- /dev/null +++ b/test/nest/recursive_nest2.m @@ -0,0 +1,21 @@ +# recursive_nest2.m +function x = recursive_nest2 () + x = B (20); + function v = B (n) + Y = 0; + BB (n); + C; + v = Y; + function BB (m) + if m > 0 + Y = Y + 1; + BB(m - 1); + C; + end + endfunction + endfunction + + function C + Y = 0; + endfunction +endfunction diff --git a/test/nest/recursive_nest3.m b/test/nest/recursive_nest3.m new file mode 100644 --- /dev/null +++ b/test/nest/recursive_nest3.m @@ -0,0 +1,13 @@ +function x = recursive_nest3 () + y = 5; + f (y); + x = y; + g (x); + function f (y) + y = 10; + endfunction + + function g (x) + x = 10; + endfunction +endfunction diff --git a/test/nest/scope0.m b/test/nest/scope0.m new file mode 100644 --- /dev/null +++ b/test/nest/scope0.m @@ -0,0 +1,16 @@ +# scope0.m +function scope0 + C; + function A + B; + function B + endfunction + endfunction + + function C + D; + function D + A; + endfunction + endfunction +endfunction diff --git a/test/nest/scope1.m b/test/nest/scope1.m new file mode 100644 --- /dev/null +++ b/test/nest/scope1.m @@ -0,0 +1,20 @@ +# scope1.m +function scope1 (n) + value = n; + if value + C; + end + function A + B; + function B + scope1 (0); + endfunction + endfunction + + function C + D; + function D + A; + endfunction + endfunction +endfunction diff --git a/test/nest/scope2.m b/test/nest/scope2.m new file mode 100644 --- /dev/null +++ b/test/nest/scope2.m @@ -0,0 +1,17 @@ +# scope2.m +function scope2 + C; + function A + B; + function B + D; + endfunction + endfunction + + function C + D; + function D + A; + endfunction + endfunction +endfunction diff --git a/test/nest/scope3.m b/test/nest/scope3.m new file mode 100644 --- /dev/null +++ b/test/nest/scope3.m @@ -0,0 +1,19 @@ +# scope3.m +function scope3 + C; + function A + B; + function B + E; + endfunction + function E + endfunction + endfunction + + function C + D; + function D + A; + endfunction + endfunction +endfunction diff --git a/test/nest/script_nest.m b/test/nest/script_nest.m new file mode 100644 --- /dev/null +++ b/test/nest/script_nest.m @@ -0,0 +1,11 @@ +# script_nest.m +function x = script_nest + A (5) + function A (n) + if n <= 0 + script_nest_script; + else + A (n - 1); + endif + endfunction +endfunction diff --git a/test/nest/script_nest_script.m b/test/nest/script_nest_script.m new file mode 100644 --- /dev/null +++ b/test/nest/script_nest_script.m @@ -0,0 +1,2 @@ +# script_nest_script.m +x = 5; diff --git a/test/nest/test_nest.m b/test/nest/test_nest.m new file mode 100644 --- /dev/null +++ b/test/nest/test_nest.m @@ -0,0 +1,53 @@ +## Copyright (C) 2006-2012 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 3 of the License, 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, see +## . + +################################################################################ +## This file actually executes the tests on nested functions. +## +## It relies on the function files defined in the nest/ directory. +################################################################################ + +%!assert (recursive_nest (), 25) + +%!assert (recursive_nest2 (), 20) + +%!assert (recursive_nest3 (), 5) + +%!assert (script_nest (), 5) + +%!assert (arg_ret (), 10) + +%!assert (arg_nest, 1) + +%!assert (varg_nest (-1), 6) + +%!assert (varg_nest2, 5) + +%!test +%! scope0; + +%!test +%! scope1 (1); + +%!test +%! scope3; + +%!error scope2 +%!error no_closure (0) +%!error no_closure (1) + diff --git a/test/nest/varg_nest.m b/test/nest/varg_nest.m new file mode 100644 --- /dev/null +++ b/test/nest/varg_nest.m @@ -0,0 +1,11 @@ +function x = varg_nest (varargin) + x = abs (f (-5)) + g; + + function x = f (varargin) + x = abs (varargin{1}); + endfunction + + function x = g + x = abs (varargin{1}); + endfunction +endfunction diff --git a/test/nest/varg_nest2.m b/test/nest/varg_nest2.m new file mode 100644 --- /dev/null +++ b/test/nest/varg_nest2.m @@ -0,0 +1,14 @@ +function x = varg_nest2 + [a, b] = f; + x = a; + + if nargout == 1 + x = a; + endif + + function a, b = f + if nargout == 2 + a = b = 5; + endif + endfunction +endfunction