Mercurial > hg > octave-nkf
changeset 13836:519390f1b67f
maint: periodic merge of stable to default.
author | Rik <octave@nomad.inbox5.com> |
---|---|
date | Sun, 06 Nov 2011 21:22:49 -0800 |
parents | fc9f34e17486 (diff) 5289d7c2460d (current diff) |
children | 2c80bbd87f5d |
files | scripts/optimization/optimset.m scripts/statistics/base/var.m |
diffstat | 902 files changed, 28391 insertions(+), 13504 deletions(-) [+] |
line wrap: on
line diff
--- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,5 +1,10 @@ -((nil . ((indent-tabs-mode . nil) - (fill-column . 72))) - (c-default-mode "gnu") +((nil . + ((c-file-style . "gnu") + (indent-tabs-mode . nil) + (fill-column . 72) + (eval . (when (string-match "\\.h\\'" (buffer-file-name)) + (unless (string-match "/gnulib/" (buffer-file-name)) + (c++-mode) + (c-set-style "gnu")))))) (change-log-mode . ((indent-tabs-mode . t))) (makefile-mode . ((indent-tabs-mode . t))))
--- a/NEWS +++ b/NEWS @@ -1,8 +1,112 @@ +Summary of important user-visible changes for version 3.6: +--------------------------------------------------------- + + ** The PCRE library is now required to build Octave. + + ** Octave now features a profiler, thanks to the work of Daniel Kraft + under the Google Summer of Code mentorship program. The manual has + been updated to reflect this addition. The new user-visible + functions are profexplore, profile, and profshow. + + ** Overhaul of statistical distribution functions + + Functions now return "single" outputs for inputs of class "single". + + 75% reduction in memory usage through use of logical indexing. + + Random sample functions now use the same syntax as rand() and accept + a comma separated list of dimensions or a dimension vector. + + Functions have been made Matlab-compatible with regard to special + cases (probability on boundaries, probabilities for values outside + distribution, etc.). This may cause subtle changes to existing + scripts. + + negative binomial function has been extended to real, non-integer inputs. + discrete_inv() now returns v(1) for 0 instead of NaN. + nbincdf() recoded to use closed form solution with betainc(). + + ** strread, textscan, and textread have been completely revamped. + + They now support nearly all Matlab functionality including: + + * ML-compatible whitespace and delimiter defaults + + * ML-compatible options: 'whitespace', treatasempty', + format string repeat count, user-specified comment style, uneven-length + output arrays, %n and %u conversion specifiers (provisionally) + + ** All .m string functions have been modified for better performance or greater + Matlab compatibility. Performance gains of 15X-30X have been demonstrated. + Operations on cell array of strings no longer pay quite as high a penalty + as those on 2-D character arrays. + + deblank: Now requires character or cellstr input. + strtrim: Now requires character or cellstr input. + No longer trims nulls ("\0") from string for ML compatibility. + strmatch: Follows documentation precisely and ignores trailing spaces + in pattern and in string. Note that Matlab documents this + behavior but the implementation does *not* always follow it. + substr: Now possible to specify a negative LEN option which extracts + to within LEN of the end of the string. + strtok: Now accepts cellstr input. + base2dec, bin2dec, hex2dec: Now accept cellstr inputs. + dec2base, dec2bin, dec2hex: Now accept cellstr inputs. + index, rindex: Now accept 2-D character array input. + strsplit: Now accepts 2-D character array input. + + ** Geometry functions derived from Qhull (convhull, delaunay, voronoi) + have been revamped. The options passed to the underlying qhull command + have been changed for better results or for Matlab compatibility. + + convhull : Default options are "Qt" for 2D, 3D, 4D inputs + Default options are "Qt Qx" for 5D and higher + delaunay : Default options are "Qt Qbb Qc Qz" for 2D and 3D inputs + Default options are "Qt Qbb Qc Qx" for 4D and higher + voronoi : No default arguments + + ** Matlab-compatible preference functions added: + + addpref getpref ispref rmpref setpref + + ** Other new functions added in 3.6.0: + + is_dq_string python zscore + is_sq_string usejava + nthargout waitbar + + ** Deprecated functions. + + The following functions were deprecated in Octave 3.2 and have been + removed from Octave 3.6. + + create_set spcholinv splu + dmult spcumprod spmax + iscommand spcumsum spmin + israwcommand spdet spprod + lchol spdiag spqr + loadimage spfind spsum + mark_as_command sphcat spsumsq + mark_as_rawcommand spinv spvcat + spatan2 spkron str2mat + spchol splchol unmark_command + spchol2inv split unmark_rawcommand + + The following functions have been deprecated in Octave 3.6 and will + be removed from Octave 3.10 (or whatever version is the second major + release after 3.6): + + cut is_duplicate_entry + cor polyderiv + corrcoef studentize + __error_text__ sylvester_matrix + error_text + Summary of important user-visible changes for version 3.4.3: ----------------------------------------------------------- ** Octave 3.4.3 is a bug fixing release. - + Summary of important user-visible changes for version 3.4.2: -----------------------------------------------------------
--- a/build-aux/bootstrap +++ b/build-aux/bootstrap @@ -1,6 +1,6 @@ #! /bin/sh # Print a version string. -scriptversion=2011-01-21.16; # UTC +scriptversion=2011-08-11.17; # UTC # Bootstrap this package from checked-out sources. @@ -130,18 +130,7 @@ m4_base=m4 doc_base=doc tests_base=tests - -# Extra files from gnulib, which override files from other sources. -gnulib_extra_files=" - $build_aux/install-sh - $build_aux/missing - $build_aux/mdate-sh - $build_aux/texinfo.tex - $build_aux/depcomp - $build_aux/config.guess - $build_aux/config.sub - doc/INSTALL -" +gnulib_extra_files='' # Additional gnulib-tool options to use. Use "\newline" to break lines. gnulib_tool_option_extras= @@ -229,6 +218,18 @@ *) test -r "$0.conf" && . ./"$0.conf" ;; esac +# Extra files from gnulib, which override files from other sources. +test -z "${gnulib_extra_files}" && \ + gnulib_extra_files=" + $build_aux/install-sh + $build_aux/missing + $build_aux/mdate-sh + $build_aux/texinfo.tex + $build_aux/depcomp + $build_aux/config.guess + $build_aux/config.sub + doc/INSTALL +" if test "$vc_ignore" = auto; then vc_ignore= @@ -278,14 +279,29 @@ exit 1 fi +# Ensure that lines starting with ! sort last, per gitignore conventions +# for whitelisting exceptions after a more generic blacklist pattern. +sort_patterns() { + sort -u "$@" | sed '/^!/ { + H + d + } + $ { + P + x + s/^\n// + }' | sed '/^$/d' +} + # If $STR is not already on a line by itself in $FILE, insert it, # sorting the new contents of the file and replacing $FILE with the result. insert_sorted_if_absent() { file=$1 str=$2 test -f $file || touch $file - echo "$str" | sort -u - $file | cmp - $file > /dev/null \ - || echo "$str" | sort -u - $file -o $file \ + echo "$str" | sort_patterns - $file | cmp - $file > /dev/null \ + || { echo "$str" | sort_patterns - $file > $file.bak \ + && mv $file.bak $file; } \ || exit 1 } @@ -405,18 +421,32 @@ # Honor $APP variables ($TAR, $AUTOCONF, etc.) appvar=`echo $app | tr '[a-z]-' '[A-Z]_'` test "$appvar" = TAR && appvar=AMTAR - eval "app=\${$appvar-$app}" - inst_ver=$(get_version $app) - if [ ! "$inst_ver" ]; then - echo "$me: Error: '$app' not found" >&2 - ret=1 - elif [ ! "$req_ver" = "-" ]; then - latest_ver=$(sort_ver $req_ver $inst_ver | cut -d' ' -f2) - if [ ! "$latest_ver" = "$inst_ver" ]; then - echo "$me: Error: '$app' version == $inst_ver is too old" >&2 - echo " '$app' version >= $req_ver is required" >&2 + case $appvar in + GZIP) ;; # Do not use $GZIP: it contains gzip options. + *) eval "app=\${$appvar-$app}" ;; + esac + if [ "$req_ver" = "-" ]; then + # Merely require app to exist; not all prereq apps are well-behaved + # so we have to rely on $? rather than get_version. + $app --version >/dev/null 2>&1 + if [ 126 -le $? ]; then + echo "$me: Error: '$app' not found" >&2 ret=1 fi + else + # Require app to produce a new enough version string. + inst_ver=$(get_version $app) + if [ ! "$inst_ver" ]; then + echo "$me: Error: '$app' not found" >&2 + ret=1 + else + latest_ver=$(sort_ver $req_ver $inst_ver | cut -d' ' -f2) + if [ ! "$latest_ver" = "$inst_ver" ]; then + echo "$me: Error: '$app' version == $inst_ver is too old" >&2 + echo " '$app' version >= $req_ver is required" >&2 + ret=1 + fi + fi fi done @@ -640,10 +670,18 @@ cp -fp "$src" "$dst" } else + # Leave any existing symlink alone, if it already points to the source, + # so that broken build tools that care about symlink times + # aren't confused into doing unnecessary builds. Conversely, if the + # existing symlink's time stamp is older than the source, make it afresh, + # so that broken tools aren't confused into skipping needed builds. See + # <http://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00326.html>. test -h "$dst" && src_ls=`ls -diL "$src" 2>/dev/null` && set $src_ls && src_i=$1 && dst_ls=`ls -diL "$dst" 2>/dev/null` && set $dst_ls && dst_i=$1 && - test "$src_i" = "$dst_i" || { + test "$src_i" = "$dst_i" && + both_ls=`ls -dt "$src" "$dst"` && + test "X$both_ls" = "X$dst$nl$src" || { dot_dots= case $src in /*) ;; @@ -762,20 +800,7 @@ echo "$me: $dir/$file overrides $1/$dir/$file" else copied=$copied$sep$file; sep=$nl - if test $file = gettext.m4; then - echo "$me: patching m4/gettext.m4 to remove need for intl/* ..." - rm -f $dir/$file - sed ' - /^AC_DEFUN(\[AM_INTL_SUBDIR],/,/^]/c\ - AC_DEFUN([AM_INTL_SUBDIR], []) - /^AC_DEFUN(\[gt_INTL_SUBDIR_CORE],/,/^]/c\ - AC_DEFUN([gt_INTL_SUBDIR_CORE], []) - $a\ - AC_DEFUN([gl_LOCK_EARLY], []) - ' $1/$dir/$file >$dir/$file - else - cp_mark_as_generated $1/$dir/$file $dir/$file - fi + cp_mark_as_generated $1/$dir/$file $dir/$file fi || exit done @@ -874,7 +899,7 @@ for command in \ libtool \ - "${ACLOCAL-aclocal} --force -I m4 $ACLOCAL_FLAGS" \ + "${ACLOCAL-aclocal} --force -I '$m4_base' $ACLOCAL_FLAGS" \ "${AUTOCONF-autoconf} --force" \ "${AUTOHEADER-autoheader} --force" \ "${AUTOMAKE-automake} --add-missing --copy --force-missing" @@ -885,7 +910,7 @@ command="${LIBTOOLIZE-libtoolize} -c -f" fi echo "$0: $command ..." - $command || exit + eval "$command" || exit done
--- a/build-aux/bootstrap.conf +++ b/build-aux/bootstrap.conf @@ -20,6 +20,8 @@ gnulib_modules=" c-strcase copysign + copysignf + closedir crypto/md5 fclose fcntl @@ -42,6 +44,7 @@ mktime nanosleep nproc + opendir pathmax progname readlink
--- a/build-aux/common.mk +++ b/build-aux/common.mk @@ -162,8 +162,6 @@ RDYNAMIC_FLAG = @RDYNAMIC_FLAG@ -RLD_FLAG = @RLD_FLAG@ - FLIBS = @FLIBS@ LIBOCTINTERP = @LIBOCTINTERP@ @@ -535,8 +533,12 @@ -e "s|%OCTAVE_CONF_MAGICK_LDFLAGS%|\"${MAGICK_LDFLAGS}\"|" \ -e "s|%OCTAVE_CONF_MAGICK_LIBS%|\"${MAGICK_LIBS}\"|" \ -e 's|%OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS%|\"@MKOCTFILE_DL_LDFLAGS@\"|' \ + -e "s|%OCTAVE_CONF_OCTAVE_LINK_DEPS%|\"${OCTAVE_LINK_DEPS}\"|" \ + -e "s|%OCTAVE_CONF_OCTAVE_LINK_OPTS%|\"${OCTAVE_LINK_OPTS}\"|" \ -e "s|%OCTAVE_CONF_OCTINCLUDEDIR%|\"${octincludedir}\"|" \ -e "s|%OCTAVE_CONF_OCTLIBDIR%|\"${octlibdir}\"|" \ + -e "s|%OCTAVE_CONF_OCT_LINK_DEPS%|\"${OCT_LINK_DEPS}\"|" \ + -e "s|%OCTAVE_CONF_OCT_LINK_OPTS%|\"${OCT_LINK_OPTS}\"|" \ -e "s|%OCTAVE_CONF_OPENGL_LIBS%|\"${OPENGL_LIBS}\"|" \ -e "s|%OCTAVE_CONF_PREFIX%|\"${prefix}\"|" \ -e "s|%OCTAVE_CONF_PTHREAD_CFLAGS%|\"${PTHREAD_CFLAGS}\"|" \ @@ -551,7 +553,6 @@ -e "s|%OCTAVE_CONF_RDYNAMIC_FLAG%|\"${RDYNAMIC_FLAG}\"|" \ -e "s|%OCTAVE_CONF_READLINE_LIBS%|\"${READLINE_LIBS}\"|" \ -e "s|%OCTAVE_CONF_REGEX_LIBS%|\"${REGEX_LIBS}\"|" \ - -e "s|%OCTAVE_CONF_RLD_FLAG%|\"${RLD_FLAG}\"|" \ -e "s|%OCTAVE_CONF_SED%|\"${SED}\"|" \ -e "s|%OCTAVE_CONF_SHARED_LIBS%|\"${SHARED_LIBS}\"|" \ -e "s|%OCTAVE_CONF_SHLEXT%|\"${SHLEXT}\"|" \
--- a/configure.ac +++ b/configure.ac @@ -27,13 +27,13 @@ EXTERN_CFLAGS="$CFLAGS" EXTERN_CXXFLAGS="$CXXFLAGS" -AC_INIT([GNU Octave], [3.4.3], [http://octave.org/bugs.html], [octave]) +AC_INIT([GNU Octave], [3.5.0+], [http://octave.org/bugs.html], [octave]) dnl PACKAGE_VERSION is set by the AC_INIT VERSION arg OCTAVE_VERSION="$PACKAGE_VERSION" OCTAVE_API_VERSION_NUMBER="45" OCTAVE_API_VERSION="api-v$OCTAVE_API_VERSION_NUMBER+" -OCTAVE_RELEASE_DATE="2011-10-10" +OCTAVE_RELEASE_DATE="2011-01-22" OCTAVE_COPYRIGHT="Copyright (C) 2011 John W. Eaton and others." AC_SUBST(OCTAVE_VERSION) AC_SUBST(OCTAVE_API_VERSION_NUMBER) @@ -1157,7 +1157,7 @@ AC_ARG_ENABLE([dl], [AS_HELP_STRING([--enable-dl], - [create shared libraries (not all systems)])], [ + [allow loading of dynamically linked modules (not all systems)])], [ case "${enableval}" in yes) ENABLE_DYNAMIC_LINKING=true ;; no) ENABLE_DYNAMIC_LINKING=false ;; @@ -1170,16 +1170,6 @@ AC_MSG_ERROR([You can't disable building static AND shared libraries!]) fi -AC_ARG_ENABLE(rpath, - [AS_HELP_STRING([--enable-rpath], - [override the default link options for rpath; e.g., --enable-rpath='-rpath $(octlibdir)'])], - [ if test "$enableval" = no; then use_rpath=false; - else - use_rpath=true - if test "$enableval" = yes; then true; - else enable_rpath_arg="$enableval"; fi - fi], [use_rpath=true]) - CPICFLAG=-fPIC CXXPICFLAG=-fPIC FPICFLAG=-fPIC @@ -1200,7 +1190,6 @@ DL_LDFLAGS='$(SH_LDFLAGS)' MKOCTFILE_DL_LDFLAGS='$(DL_LDFLAGS)' SONAME_FLAGS= -RLD_FLAG= NO_OCT_FILE_STRIP=false TEMPLATE_AR='$(AR)' TEMPLATE_ARFLAGS="$ARFLAGS" @@ -1221,14 +1210,12 @@ ;; *-*-freebsd*) SH_LDFLAGS="-shared -Wl,-x" - RLD_FLAG='-Wl,-rpath -Wl,$(octlibdir)' ;; alpha*-dec-osf*) CPICFLAG= CXXPICFLAG= FPICFLAG= SH_LDFLAGS="-shared -Wl,-expect_unresolved -Wl,'*'" - RLD_FLAG='-Wl,-rpath -Wl,$(octlibdir)' ;; *-*-darwin*) DL_LDFLAGS='-bundle -bundle_loader $(top_builddir)/src/octave $(LDFLAGS)' @@ -1335,11 +1322,9 @@ *-*-linux* | *-*-gnu*) MKOCTFILE_DL_LDFLAGS="-shared -Wl,-Bsymbolic" SONAME_FLAGS='-Wl,-soname -Wl,$@' - RLD_FLAG='-Wl,-rpath -Wl,$(octlibdir)' ;; i[[3456]]86-*-sco3.2v5*) SONAME_FLAGS='-Wl,-h -Wl,$@' - RLD_FLAG= SH_LDFLAGS=-G ;; rs6000-ibm-aix* | powerpc-ibm-aix*) @@ -1356,7 +1341,6 @@ fi SHLEXT=sl SH_LDFLAGS="-shared -fPIC" - RLD_FLAG='-Wl,+b -Wl,$(octlibdir)' library_path_var=SHLIB_PATH ;; ia64*-hp-hpux*) @@ -1366,13 +1350,11 @@ FPICFLAG=+Z fi SH_LDFLAGS="-shared -fPIC" - RLD_FLAG='-Wl,+b -Wl,$(octlibdir)' ;; *-sgi-*) CPICFLAG= CXXPICFLAG= FPICFLAG= - RLD_FLAG='-rpath $(octlibdir)' ;; sparc-sun-sunos4*) if test "$ac_cv_f77_compiler_gnu" = yes; then @@ -1382,7 +1364,6 @@ fi SH_LD=ld SH_LDFLAGS="-assert nodefinitions" - RLD_FLAG='-L$(octlibdir)' ;; sparc-sun-solaris2* | i386-pc-solaris2*) if test "$ac_cv_f77_compiler_gnu" = yes; then @@ -1402,7 +1383,6 @@ CXXPICFLAG=-KPIC SH_LDFLAGS=-G fi - RLD_FLAG='-R $(octlibdir)' ## Template closures in archive libraries need a different mechanism. if test "$GXX" = yes; then true @@ -1416,14 +1396,6 @@ AM_CONDITIONAL([AMCOND_BUILD_COMPILED_AUX_PROGRAMS], [test x$BUILD_COMPILED_AUX_PROGRAMS = xtrue]) -if $use_rpath; then - if test -n "$enable_rpath_arg"; then - RLD_FLAG="$enable_rpath_arg" - fi -else - RLD_FLAG="" -fi - AC_MSG_NOTICE([defining FPICFLAG to be $FPICFLAG]) AC_MSG_NOTICE([defining CPICFLAG to be $CPICFLAG]) AC_MSG_NOTICE([defining CXXPICFLAG to be $CXXPICFLAG]) @@ -1445,7 +1417,6 @@ AC_MSG_NOTICE([defining MKOCTFILE_DL_LDFLAGS to be $MKOCTFILE_DL_LDFLAGS]) AC_MSG_NOTICE([defining SONAME_FLAGS to be $SONAME_FLAGS]) AC_MSG_NOTICE([defining NO_OCT_FILE_STRIP to be $NO_OCT_FILE_STRIP]) -AC_MSG_NOTICE([defining RLD_FLAG to be $RLD_FLAG]) AC_MSG_NOTICE([defining TEMPLATE_AR to be $TEMPLATE_AR]) AC_MSG_NOTICE([defining TEMPLATE_ARFLAGS to be $TEMPLATE_ARFLAGS]) AC_MSG_NOTICE([defining CRUFT_DLL_DEFS to be $CRUFT_DLL_DEFS]) @@ -1474,7 +1445,6 @@ AC_SUBST(MKOCTFILE_DL_LDFLAGS) AC_SUBST(SONAME_FLAGS) AC_SUBST(NO_OCT_FILE_STRIP) -AC_SUBST(RLD_FLAG) AC_SUBST(TEMPLATE_AR) AC_SUBST(TEMPLATE_ARFLAGS) AC_SUBST(CRUFT_DLL_DEFS) @@ -1488,28 +1458,42 @@ AC_CHECK_FUNCS(getpwnam, [], [AC_CHECK_LIB(sun, getpwnam)]) -NO_UNDEFINED_LDFLAG= case "$canonical_host_type" in *-*-mingw*) if test "$have_msvc" = "yes"; then AC_CHECK_LIB(dirent, opendir) LIBS="$LIBS -ladvapi32 -lgdi32 -lws2_32 -luser32 -lkernel32" - NO_UNDEFINED_LDFLAG=-no-undefined else LIBS="$LIBS -lgdi32 -lws2_32 -luser32 -lkernel32" - NO_UNDEFINED_LDFLAG=-no-undefined fi LIBS="$LIBS -lgdi32 -lws2_32 -luser32 -lkernel32" - NO_UNDEFINED_LDFLAG=-no-undefined ;; *-*-msdosmsvc*) AC_CHECK_LIB(dirent, opendir) LIBS="$LIBS -ladvapi32 -lgdi32 -lws2_32 -luser32 -lkernel32" - NO_UNDEFINED_LDFLAG=-no-undefined ;; esac + +AC_ARG_ENABLE([no-undefined], + [AS_HELP_STRING([--enable-no-undefined], + [pass -no-undefined to libtool when linking linking Octave and its shared libraries (on by default)])], + [case "${enableval}" in + yes) NO_UNDEFINED_LDFLAG="-no-undefined" ;; + no) NO_UNDEFINED_LDFLAG="" ;; + *) AC_MSG_ERROR([bad value ${enableval} for --enable-link-all-depenencies]) ;; + esac], [NO_UNDEFINED_LDFLAG="-no-undefined"]) AC_SUBST(NO_UNDEFINED_LDFLAG) +AC_ARG_ENABLE([link-all-dependencies], + [AS_HELP_STRING([--enable-link-all-dependencies], + [link Octave and its shared libraries with all dependencies, not just those immediately referenced (should not be needed on most systems)])], + [case "${enableval}" in + yes) link_all_deps=true ;; + no) link_all_deps=false ;; + *) AC_MSG_ERROR([bad value ${enableval} for --enable-link-all-depenencies]) ;; + esac], [link_all_deps=false]) +AM_CONDITIONAL([AMCOND_LINK_ALL_DEPS], [test x$link_all_deps = xtrue]) + ### Type stuff. AC_TYPE_MODE_T @@ -1564,6 +1548,26 @@ AC_LANG_PUSH(C++) AC_CHECK_HEADERS(sstream) +AC_CHECK_HEADERS([unordered_map], [], [ + AC_CHECK_HEADERS([tr1/unordered_map])]) +AC_MSG_CHECKING([whether unordered_map requires tr1 namespace]) +unordered_map_requires_tr1_namespace=no +if test "$ac_cv_header_unordered_map" = "yes"; then + ### Have <unordered_map>, but still have to check whether + ### tr1 namespace is required (like MSVC, for instance). + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM([ + #include <unordered_map> + ], [ + 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 +fi +if test "$unordered_map_requires_tr1_namespace" = "yes"; then + AC_DEFINE(USE_UNORDERED_MAP_WITH_TR1, 1, [Defines whether unordered_map requires the use of tr1 namespace.]) +fi +AC_MSG_RESULT([$unordered_map_requires_tr1_namespace]) AC_LANG_POP(C++) have_termios_h=no @@ -1704,12 +1708,18 @@ DL_LIBS="$lt_cv_dlopen_libs" AC_SUBST(DL_LIBS) + ## Disable dynamic linking if capability is not present. if $dlopen_api || $shl_load_api || $loadlibrary_api || $dyld_api; then - ENABLE_DYNAMIC_LINKING=true - AC_DEFINE(ENABLE_DYNAMIC_LINKING, 1, [Define if using dynamic linking]) + true + else + ENABLE_DYNAMIC_LINKING=false fi fi +if $ENABLE_DYNAMIC_LINKING; then + AC_DEFINE(ENABLE_DYNAMIC_LINKING, 1, [Define if using dynamic linking]) +fi + AM_CONDITIONAL([AMCOND_ENABLE_DYNAMIC_LINKING], [test x$ENABLE_DYNAMIC_LINKING = xtrue])
--- a/doc/faq/OctaveFAQ.texi +++ b/doc/faq/OctaveFAQ.texi @@ -63,7 +63,7 @@ * Getting Octave:: * Installation:: * Common problems:: -* How do I ...?:: +* Using Octave:: * @sc{Matlab} compatibility:: * Index:: @end menu @@ -780,15 +780,16 @@ @end itemize @end itemize -@node How do I ...? -@chapter How do I ...? +@node Using Octave +@chapter Using Octave @menu * How do I set the number of displayed decimals?:: +* How does Octave solve linear systems?:: @end menu @cindex Tips and tricks -@cindex How do I @dots{} ? +@cindex Using Octave @node How do I set the number of displayed decimals? @section How do I set the number of displayed decimals? @@ -804,6 +805,18 @@ @end group @end example +@node How does Octave solve linear systems? +@section How does Octave solve linear systems? + +@cindex backslash operator + +In addition to consulting Octave's source for the precise details, the +Octave manual contains a complete high-level description of the +algorithm that Octave uses to decide how to solve a particular linear +system, e.g. how the backslash operator @code{A\x} will be interpreted. +Sections ``Techniques Used for Linear Algebra'' and ``Linear Algebra on +Sparse Matrices'' from the manual describe this procedure. + @node @sc{Matlab} compatibility @chapter Porting programs from @sc{Matlab} to Octave
--- a/doc/interpreter/container.txi +++ b/doc/interpreter/container.txi @@ -563,16 +563,11 @@ @example @group c@{1:2@} + @result{} ans = a string @result{} ans = - (, - [1] = a string - [2] = - 0.593993 0.627732 0.377037 0.033643 - - ,) @end group @end example
--- a/doc/interpreter/contributors.in +++ b/doc/interpreter/contributors.in @@ -1,5 +1,6 @@ Ben Abbott Andy Adler +Giles Anderson Joel Andersson Muthiah Annamalai Shai Ayal @@ -8,6 +9,7 @@ Alexander Barth David Bateman Heinz Bauschke +Roman Belov Karl Berry David Billinghurst Don Bindner @@ -143,14 +145,17 @@ G. D. McBain Alexander Mamonov Christoph Mayer +Júlio Hoffimann Mendes Thorsten Meyer Petr Mikulik Stefan Monnier Antoine Moreau Kai P. Mueller +Hannes Müller Victor Munoz Carmen Navarrete Todd Neal +Philip Nienhuis Al Niessner Rick Niles Takuji Nishimura @@ -206,6 +211,7 @@ Daniel J. Sebald Dmitri A. Sergatskov Baylis Shanks +Andriy Shinkarchuck Joseph P. Skudlarek John Smith Julius Smith @@ -232,6 +238,7 @@ Frederick Umminger Utkarsh Upadhyay Stefan van der Walt +David Wells Peter Van Wieren James R. Van Zandt Gregory Vanuxem @@ -244,6 +251,7 @@ Andreas Weingessel Michael Weitzel Fook Fah Yap +Sean Young Michael Zeising Federico Zenith Alex Zvoleff
--- a/doc/interpreter/debug.txi +++ b/doc/interpreter/debug.txi @@ -35,6 +35,8 @@ * Breakpoints:: * Debug Mode:: * Call Stack:: +* Profiling:: +* Profiler Example:: @end menu @node Entering Debug Mode @@ -182,3 +184,258 @@ @DOCSTRING(dbup) @DOCSTRING(dbdown) + +@node Profiling +@section Profiling +@cindex profiler +@cindex code profiling + +Octave supports profiling of code execution on a per-function level. If +profiling is enabled, each call to a function (supporting built-ins, +operators, functions in oct- and mex-files, user-defined functions in +Octave code and anonymous functions) is recorded while running Octave +code. After that, this data can aid in analyzing the code behaviour, and +is in particular helpful for finding ``hot spots'' in the code which use +up a lot of computation time and are the best targets to spend +optimization efforts on. + +The main command for profiling is @code{profile}, which can be used to +start or stop the profiler and also to query collected data afterwards. +The data is returned in an Octave data structure which can then be +examined or further processed by other routines or tools. + +@DOCSTRING(profile) + +An easy way to get an overview over the collected data is +@code{profshow}. This function takes the profiler data returned by +@code{profile} as input and prints a flat profile, for instance: + +@example +@group + Function Attr Time (s) Calls +---------------------------------------- + >myfib R 2.195 13529 +binary <= 0.061 13529 + binary - 0.050 13528 + binary + 0.026 6764 +@end group +@end example + +This shows that most of the runtime was spent executing the function +@samp{myfib}, and some minor proportion evaluating the listed binary +operators. Furthermore, it is shown how often the function was called +and the profiler also records that it is recursive. + +@DOCSTRING(profshow) + +@DOCSTRING(profexplore) + +@node Profiler Example +@section Profiler Example + +Below, we will give a short example of a profiler session. See also +@ref{Profiling} for the documentation of the profiler functions in +detail. Consider the code: + +@example +@group +global N A; + +N = 300; +A = rand (N, N); + +function xt = timesteps (steps, x0, expM) + global N; + + if (steps == 0) + xt = NA (N, 0); + else + xt = NA (N, steps); + x1 = expM * x0; + xt(:, 1) = x1; + xt(:, 2 : end) = timesteps (steps - 1, x1, expM); + endif +endfunction + +function foo () + global N A; + + initial = @@(x) sin (x); + x0 = (initial (linspace (0, 2 * pi, N)))'; + + expA = expm (A); + xt = timesteps (100, x0, expA); +endfunction + +function fib = bar (N) + if (N <= 2) + fib = 1; + else + fib = bar (N - 1) + bar (N - 2); + endif +endfunction +@end group +@end example + +If we execute the two main functions, we get: + +@example +@group +tic; foo; toc; +@result{} Elapsed time is 2.37338 seconds. + +tic; bar (20); toc; +@result{} Elapsed time is 2.04952 seconds. +@end group +@end example + +But this does not give much information about where this time is spent; +for instance, whether the single call to @code{expm} is more expensive +or the recursive time-stepping itself. To get a more detailed picture, +we can use the profiler. + +@example +@group +profile on; +foo; +profile off; + +data = profile ('info'); +profshow (data, 10); +@end group +@end example + +This prints a table like: + +@example +@group + # Function Attr Time (s) Calls +--------------------------------------------- + 7 expm 1.034 1 + 3 binary * 0.823 117 + 41 binary \ 0.188 1 + 38 binary ^ 0.126 2 + 43 timesteps R 0.111 101 + 44 NA 0.029 101 + 39 binary + 0.024 8 + 34 norm 0.011 1 + 40 binary - 0.004 101 + 33 balance 0.003 1 +@end group +@end example + +The entries are the individual functions which have been executed (only +the 10 most important ones), together with some information for each of +them. The entries like @samp{binary *} denote operators, while other +entries are ordinary functions. They include both built-ins like +@code{expm} and our own routines (for instance @code{timesteps}). From +this profile, we can immediately deduce that @code{expm} uses up the +largest proportion of the processing time, even though it is only called +once. The second expensive operation is the matrix-vector product in the +routine @code{timesteps}. @footnote{We only know it is the binary +multiplication operator, but fortunately this operator appears only at +one place in the code and thus we know which occurence takes so much +time. If there were multiple places, we would have to use the +hierarchical profile to find out the exact place which uses up the time +which is not covered in this example.} + +Timing, however, is not the only information available from the profile. +The attribute column shows us that @code{timesteps} calls itself +recursively. This may not be that remarkable in this example (since it's +clear anyway), but could be helpful in a more complex setting. As to the +question of why is there a @samp{binary \} in the output, we can easily +shed some light on that too. Note that @code{data} is a structure array +(@ref{Structure Arrays}) which contains the field @code{FunctionTable}. +This stores the raw data for the profile shown. The number in the first +column of the table gives the index under which the shown function can +be found there. Looking up @code{data.FunctionTable(41)} gives: + +@example +@group + scalar structure containing the fields: + + FunctionName = binary \ + TotalTime = 0.18765 + NumCalls = 1 + IsRecursive = 0 + Parents = 7 + Children = [](1x0) +@end group +@end example + +Here we see the information from the table again, but have additional +fields @code{Parents} and @code{Children}. Those are both arrays, which +contain the indices of functions which have directly called the function +in question (which is entry 7, @code{expm}, in this case) or been called +by it (no functions). Hence, the backslash operator has been used +internally by @code{expm}. + +Now let's take a look at @code{bar}. For this, we start a fresh +profiling session (@code{profile on} does this; the old data is removed +before the profiler is restarted): + +@example +@group +profile on; +bar (20); +profile off; + +profshow (profile ('info')); +@end group +@end example + +This gives: + +@example + # Function Attr Time (s) Calls +------------------------------------------------------- + 1 bar R 2.091 13529 + 2 binary <= 0.062 13529 + 3 binary - 0.042 13528 + 4 binary + 0.023 6764 + 5 profile 0.000 1 + 8 false 0.000 1 + 6 nargin 0.000 1 + 7 binary != 0.000 1 + 9 __profiler_enable__ 0.000 1 +@end example + +Unsurprisingly, @code{bar} is also recursive. It has been called 13,529 +times in the course of recursively calculating the Fibonacci number in a +suboptimal way, and most of the time was spent in @code{bar} itself. + +Finally, let's say we want to profile the execution of both @code{foo} +and @code{bar} together. Since we already have the runtime data +collected for @code{bar}, we can restart the profiler without clearing +the existing data and collect the missing statistics about @code{foo}. +This is done by: + +@example +@group +profile resume; +foo; +profile off; + +profshow (profile ('info'), 10); +@end group +@end example + +As you can see in the table below, now we have both profiles mixed +together. + +@example +@group + # Function Attr Time (s) Calls +--------------------------------------------- + 1 bar R 2.091 13529 + 16 expm 1.122 1 + 12 binary * 0.798 117 + 46 binary \ 0.185 1 + 45 binary ^ 0.124 2 + 48 timesteps R 0.115 101 + 2 binary <= 0.062 13529 + 3 binary - 0.045 13629 + 4 binary + 0.041 6772 + 49 NA 0.036 101 +@end group +@end example
deleted file mode 100644 --- a/doc/interpreter/dir +++ /dev/null @@ -1,14 +0,0 @@ --*- Text -*- -This is the file .../info/dir, which contains the topmost node of the -Info hierarchy. The first time you invoke Info you start off -looking at that node, which is (dir)Top. - -File: dir Node: Top This is the top of the INFO tree - This (the Directory node) gives a menu of major topics. - Typing "d" returns here, "q" exits, "?" lists all INFO commands, "h" - gives a primer for first-timers, "mItem<Return>" visits the menu - item named `Item', etc. - -* Menu: The list of major topics begins on the next line. - -* Octave: (octave). Interactive language for numerical computations.
--- a/doc/interpreter/doccheck/mk_undocumented_list +++ b/doc/interpreter/doccheck/mk_undocumented_list @@ -82,7 +82,6 @@ comma debug dbnext -error_text exit F_DUPFD F_GETFD
deleted file mode 100644 --- a/doc/interpreter/eos.txi +++ /dev/null @@ -1,515 +0,0 @@ -@c Copyright (C) 1996-2011 Kurt Hornik -@c -@c This file is part of Octave. -@c -@c Octave is free software; you can redistribute it and/or modify it -@c under the terms of the GNU General Public License as published by the -@c Free Software Foundation; either version 3 of the License, or (at -@c your option) any later version. -@c -@c Octave is distributed in the hope that it will be useful, but WITHOUT -@c ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -@c FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -@c for more details. -@c -@c You should have received a copy of the GNU General Public License -@c along with Octave; see the file COPYING. If not, see -@c <http://www.gnu.org/licenses/>. - -@c Written by Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> on 1996/05/17. -@c Last updated by KH on 1997/07/31. - -@node Emacs -@chapter Emacs Octave Support - -The development of Octave code can greatly be facilitated using Emacs -with Octave mode -automatically indent the code, do some of the typing (with Abbrev mode) -and show keywords, comments, strings, etc.@: in different faces (with -Font-lock mode on devices that support it). - -It is also possible to run Octave from within Emacs, either by directly -entering commands at the prompt in a buffer in Inferior Octave mode, or -by interacting with Octave from within a file with Octave code. This is -useful in particular for debugging Octave code. - -Finally, you can convince Octave to use the Emacs info reader for -@kbd{help -i}. - -All functionality is provided by the Emacs Lisp package EOS (for ``Emacs -Octave Support''). This chapter describes how to set up and use this -package. - -Please contact @email{Kurt.Hornik@@wu-wien.ac.at} if you have any questions -or suggestions on using EOS. - -@menu -* Installing EOS:: -* Using Octave Mode:: -* Running Octave From Within Emacs:: -* Using the Emacs Info Reader for Octave:: -@end menu - -@node Installing EOS -@section Installing EOS - -The Emacs package EOS consists of the three files @file{octave-mod.el}, -@file{octave-inf.el}, and @file{octave-hlp.el}. These files, or better -yet their byte-compiled versions, should be somewhere in your Emacs -load-path. - -If you have GNU Emacs with a version number at least as high as 19.35, -you are all set up, because EOS is respectively will be part of GNU -Emacs as of version 19.35. - -Otherwise, copy the three files from the @file{emacs} subdirectory of -the Octave distribution to a place where Emacs can find them (this -depends on how your Emacs was installed). Byte-compile them for speed -if you want. - -@node Using Octave Mode -@section Using Octave Mode - -If you are lucky, your sysadmins have already arranged everything so -that Emacs automatically goes into Octave mode whenever you visit an -Octave code file as characterized by its extension @file{.m}. If not, -proceed as follows. - -@enumerate -@item -To begin using Octave mode for all @file{.m} files you visit, add the -following lines to a file loaded by Emacs at startup time, typically -your @file{~/.emacs} file: - -@lisp -(autoload 'octave-mode "octave-mod" nil t) -(setq auto-mode-alist - (cons '(\"\\\\.m$\" . octave-mode) auto-mode-alist)) -@end lisp - -@item -Finally, to turn on the abbrevs, auto-fill and font-lock features -automatically, also add the following lines to one of the Emacs startup -files: -@lisp -(add-hook 'octave-mode-hook - (lambda () - (abbrev-mode 1) - (auto-fill-mode 1) - (if (eq window-system 'x) - (font-lock-mode 1)))) -@end lisp -See the Emacs manual for more information about how to customize -Font-lock mode. -@end enumerate - -In Octave mode, the following special Emacs commands can be used in -addition to the standard Emacs commands. - -@table @kbd -@item C-h m -Describe the features of Octave mode. - -@item LFD -Reindent the current Octave line, insert a newline and indent the new -line (@code{octave-reindent-then-newline-and-indent}). An abbrev before -point is expanded if @code{abbrev-mode} is non-@code{nil}. - -@item TAB -Indents current Octave line based on its contents and on previous -lines (@code{indent-according-to-mode}). - -@item ; -Insert an ``electric'' semicolon (@code{octave-electric-semi}). If -@code{octave-auto-indent} is non-@code{nil}, reindent the current line. -If @code{octave-auto-newline} is non-@code{nil}, automagically insert a -newline and indent the new line. - -@item ` -Start entering an abbreviation (@code{octave-abbrev-start}). If Abbrev -mode is turned on, typing @kbd{`C-h} or @kbd{`?} lists all abbrevs. -Any other key combination is executed normally. Note that all Octave -abbrevs start with a grave accent. - -@item M-LFD -Break line at point and insert continuation marker and alignment -(@code{octave-split-line}). - -@item M-TAB -Perform completion on Octave symbol preceding point, comparing that -symbol against Octave's reserved words and built-in variables -(@code{octave-complete-symbol}). - -@item M-C-a -Move backward to the beginning of a function -(@code{octave-beginning-of-defun}). -With prefix argument @var{N}, do it that many times if @var{N} is -positive; otherwise, move forward to the @var{N}-th following beginning -of a function. - -@item M-C-e -Move forward to the end of a function (@code{octave-end-of-defun}). -With prefix argument @var{N}, do it that many times if @var{N} is -positive; otherwise, move back to the @var{N}-th preceding end of a -function. - -@item M-C-h -Puts point at beginning and mark at the end of the current Octave -function, i.e., the one containing point or following point -(@code{octave-mark-defun}). - -@item M-C-q -Properly indents the Octave function which contains point -(@code{octave-indent-defun}). - -@item M-; -If there is no comment already on this line, create a code-level comment -(started by two comment characters) if the line is empty, or an in-line -comment (started by one comment character) otherwise -(@code{octave-indent-for-comment}). -Point is left after the start of the comment which is properly aligned. - -@item C-c ; -Puts the comment character @samp{#} (more precisely, the string value of -@code{octave-comment-start}) at the beginning of every line in the -region (@code{octave-comment-region}). With just @kbd{C-u} prefix -argument, uncomment each line in the region. A numeric prefix argument -@var{N} means use @var{N} comment characters. - -@item C-c : -Uncomments every line in the region (@code{octave-uncomment-region}). - -@item C-c C-p -Move one line of Octave code backward, skipping empty and comment lines -(@code{octave-previous-code-line}). With numeric prefix argument -@var{N}, move that many code lines backward (forward if @var{N} is -negative). - -@item C-c C-n -Move one line of Octave code forward, skipping empty and comment lines -(@code{octave-next-code-line}). With numeric prefix argument @var{N}, -move that many code lines forward (backward if @var{N} is negative). - -@item C-c C-a -Move to the `real' beginning of the current line -(@code{octave-beginning-of-line}). If point is in an empty or comment -line, simply go to its beginning; otherwise, move backwards to the -beginning of the first code line which is not inside a continuation -statement, i.e., which does not follow a code line ending in @samp{...} -or @samp{\}, or is inside an open parenthesis list. - -@item C-c C-e -Move to the `real' end of the current line (@code{octave-end-of-line}). -If point is in a code line, move forward to the end of the first Octave -code line which does not end in @samp{...} or @samp{\} or is inside an -open parenthesis list. Otherwise, simply go to the end of the current -line. - -@item C-c M-C-n -Move forward across one balanced begin-end block of Octave code -(@code{octave-forward-block}). With numeric prefix argument @var{N}, -move forward across @var{n} such blocks (backward if @var{N} is -negative). - -@item C-c M-C-p -Move back across one balanced begin-end block of Octave code -(@code{octave-backward-block}). With numeric prefix argument @var{N}, -move backward across @var{N} such blocks (forward if @var{N} is -negative). - -@item C-c M-C-d -Move forward down one begin-end block level of Octave code -(@code{octave-down-block}). With numeric prefix argument, do it that -many times; a negative argument means move backward, but still go down -one level. - -@item C-c M-C-u -Move backward out of one begin-end block level of Octave code -(@code{octave-backward-up-block}). With numeric prefix argument, do it -that many times; a negative argument means move forward, but still to a -less deep spot. - -@item C-c M-C-h -Put point at the beginning of this block, mark at the end -(@code{octave-mark-block}). -The block marked is the one that contains point or follows point. - -@item C-c ] -Close the current block on a separate line (@code{octave-close-block}). -An error is signaled if no block to close is found. - -@item C-c f -Insert a function skeleton, prompting for the function's name, arguments -and return values which have to be entered without parentheses -(@code{octave-insert-defun}). - -@item C-c C-h -Search the function, operator and variable indices of all info files -with documentation for Octave for entries (@code{octave-help}). If used -interactively, the entry is prompted for with completion. If multiple -matches are found, one can cycle through them using the standard -@samp{,} (@code{Info-index-next}) command of the Info reader. - -The variable @code{octave-help-files} is a list of files to search -through and defaults to @code{'("octave")}. If there is also an Octave -Local Guide with corresponding info file, say, @file{octave-LG}, you can -have @code{octave-help} search both files by -@lisp -(setq octave-help-files '("octave" "octave-LG")) -@end lisp -@noindent -in one of your Emacs startup files. - -@end table - -A common problem is that the @key{RET} key does @emph{not} indent the -line to where the new text should go after inserting the newline. This -is because the standard Emacs convention is that @key{RET} (aka -@kbd{C-m}) just adds a newline, whereas @key{LFD} (aka @kbd{C-j}) adds a -newline and indents it. This is particularly inconvenient for users with -keyboards which do not have a special @key{LFD} key at all; in such -cases, it is typically more convenient to use @key{RET} as the @key{LFD} -key (rather than typing @kbd{C-j}). - -You can make @key{RET} do this by adding -@lisp -(define-key octave-mode-map "\C-m" - 'octave-reindent-then-newline-and-indent) -@end lisp -@noindent -to one of your Emacs startup files. Another, more generally applicable -solution is -@lisp -(defun RET-behaves-as-LFD () - (let ((x (key-binding "\C-j"))) - (local-set-key "\C-m" x))) -(add-hook 'octave-mode-hook 'RET-behaves-as-LFD) -@end lisp -@noindent -(this works for all modes by adding to the startup hooks, without having -to know the particular binding of @key{RET} in that mode!). Similar -considerations apply for using @key{M-RET} as @key{M-LFD}. As Barry -A. Warsaw @email{bwarsaw@@cnri.reston.va.us} says in the documentation for his -@code{cc-mode}, ``This is a very common question. @code{:-)} If you want -this to be the default behavior, don't lobby me, lobby RMS!'' - -The following variables can be used to customize Octave mode. - -@table @code -@item octave-auto-indent -Non-@code{nil} means auto-indent the current line after a semicolon or -space. Default is @code{nil}. - -@item octave-auto-newline -Non-@code{nil} means auto-insert a newline and indent after semicolons -are typed. The default value is @code{nil}. - -@item octave-blink-matching-block -Non-@code{nil} means show matching begin of block when inserting a space, -newline or @samp{;} after an else or end keyword. Default is @code{t}. -This is an extremely useful feature for automatically verifying that the -keywords match---if they don't, an error message is displayed. - -@item octave-block-offset -Extra indentation applied to statements in block structures. -Default is 2. - -@item octave-continuation-offset -Extra indentation applied to Octave continuation lines. -Default is 4. - -@item octave-continuation-string -String used for Octave continuation lines. -Normally @samp{\}. - -@item octave-mode-startup-message -If @code{t} (default), a startup message is displayed when Octave mode -is called. - -@end table - -If Font Lock mode is enabled, Octave mode will display -@itemize @bullet -@item -strings in @code{font-lock-string-face} - -@item -comments in @code{font-lock-comment-face} - -@item -the Octave reserved words (such as all block keywords) and the text -functions (such as @samp{cd} or @samp{who}) which are also reserved -using @code{font-lock-keyword-face} - -@item -the built-in operators (@samp{&&}, @samp{==}, @dots{}) using -@code{font-lock-reference-face} - -@item -and the function names in function declarations in -@code{font-lock-function-name-face}. -@end itemize - -There is also rudimentary support for Imenu (currently, function names -can be indexed). - -Customization of Octave mode can be performed by modification of the -variable @code{octave-mode-hook}. It the value of this variable is -non-@code{nil}, turning on Octave mode calls its value. - -If you discover a problem with Octave mode, you can conveniently send a -bug report using @kbd{C-c C-b} (@code{octave-submit-bug-report}). This -automatically sets up a mail buffer with version information already -added. You just need to add a description of the problem, including a -reproducible test case and send the message. - -@node Running Octave From Within Emacs -@section Running Octave From Within Emacs - -The package @file{octave} provides commands for running an inferior -Octave process in a special Emacs buffer. Use -@lisp -M-x run-octave -@end lisp -@noindent -to directly start an inferior Octave process. If Emacs does not know -about this command, add the line -@lisp -(autoload 'run-octave "octave-inf" nil t) -@end lisp -@noindent -to your @file{.emacs} file. - -This will start Octave in a special buffer the name of which is -specified by the variable @code{inferior-octave-buffer} and defaults to -@code{"*Inferior Octave*"}. From within this buffer, you can -interact with the inferior Octave process `as usual', i.e., by entering -Octave commands at the prompt. The buffer is in Inferior Octave mode, -which is derived from the standard Comint mode, a major mode for -interacting with an inferior interpreter. See the documentation for -@code{comint-mode} for more details, and use @kbd{C-h b} to find out -about available special keybindings. - -You can also communicate with an inferior Octave process from within -files with Octave code (i.e., buffers in Octave mode), using the -following commands. - -@table @kbd -@item C-c i l -Send the current line to the inferior Octave process -(@code{octave-send-line}). -With positive prefix argument @var{N}, send that many lines. -If @code{octave-send-line-auto-forward} is non-@code{nil}, go to the -next unsent code line. - -@item C-c i b -Send the current block to the inferior Octave process -(@code{octave-send-block}). - -@item C-c i f -Send the current function to the inferior Octave process -(@code{octave-send-defun}). - -@item C-c i r -Send the region to the inferior Octave process -(@code{octave-send-region}). - -@item C-c i s -Make sure that `inferior-octave-buffer' is displayed -(@code{octave-show-process-buffer}). - -@item C-c i h -Delete all windows that display the inferior Octave buffer -(@code{octave-hide-process-buffer}). - -@item C-c i k -Kill the inferior Octave process and its buffer -(@code{octave-kill-process}). -@end table - -The effect of the commands which send code to the Octave process can be -customized by the following variables. -@table @code -@item octave-send-echo-input -Non-@code{nil} means echo input sent to the inferior Octave process. -Default is @code{t}. - -@item octave-send-show-buffer -Non-@code{nil} means display the buffer running the Octave process after -sending a command (but without selecting it). -Default is @code{t}. -@end table - -If you send code and there is no inferior Octave process yet, it will be -started automatically. - -The startup of the inferior Octave process is highly customizable. -The variable @code{inferior-octave-startup-args} can be used for -specifying command lines arguments to be passed to Octave on startup -as a list of strings. For example, to suppress the startup message and -use `traditional' mode, set this to @code{'("-q" "--traditional")}. -You can also specify a startup file of Octave commands to be loaded on -startup; note that these commands will not produce any visible output -in the process buffer. Which file to use is controlled by the variable -@code{inferior-octave-startup-file}. If this is @code{nil}, the file -@file{~/.emacs-octave} is used if it exists. - -And finally, @code{inferior-octave-mode-hook} is run after starting the -process and putting its buffer into Inferior Octave mode. Hence, if you -like the up and down arrow keys to behave in the interaction buffer as -in the shell, and you want this buffer to use nice colors, add -@lisp -(add-hook 'inferior-octave-mode-hook - (lambda () - (turn-on-font-lock) - (define-key inferior-octave-mode-map [up] - 'comint-previous-input) - (define-key inferior-octave-mode-map [down] - 'comint-next-input))) -@end lisp -@noindent -to your @file{.emacs} file. You could also swap the roles of @kbd{C-a} -(@code{beginning-of-line}) and @code{C-c C-a} (@code{comint-bol}) using -this hook. - -@quotation -@strong{Note:} -If you set your Octave prompts to something different from the defaults, -make sure that @code{inferior-octave-prompt} matches them. -Otherwise, @emph{nothing} will work, because Emacs will have no idea -when Octave is waiting for input, or done sending output. -@end quotation - -@node Using the Emacs Info Reader for Octave -@section Using the Emacs Info Reader for Octave - -You can also set up the Emacs Info reader for dealing with the results -of Octave's @samp{help -i}. For this, the package @file{gnuserv} needs -to be installed, which unfortunately still does not come with GNU Emacs -(it does with XEmacs). It can be retrieved from any GNU Emacs Lisp Code -Directory archive, e.g.@: -@url{ftp://ftp.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive}, -in the @file{packages} subdirectory. The alpha version of an enhanced -version of gnuserv is available at -@url{ftp://ftp.wellfleet.com/netman/psmith/emacs/gnuserv-2.1alpha.tar.gz}. - -If @file{gnuserv} is installed, add the lines -@lisp -(autoload 'octave-help "octave-hlp" nil t) -(require 'gnuserv) -(gnuserv-start) -@end lisp -@noindent -to your @file{.emacs} file. - -You can use either `plain' Emacs Info or the function @code{octave-help} -as your Octave info reader (for @samp{help -i}). In the former case, -set the Octave variable @w{@env{INFO_PROGRAM}} to @code{"info-emacs-info"}. -The latter is perhaps more attractive because it allows to look up keys -in the indices of @emph{several} info files related to Octave (provided -that the Emacs variable @code{octave-help-files} is set correctly). In -this case, set @w{@env{INFO_PROGRAM}} to @code{"info-emacs-octave-help"}. - -If you use Octave from within Emacs, these settings are best done in the -@file{~/.emacs-octave} startup file (or the file pointed to by the Emacs -variable @code{inferior-octave-startup-file}).
--- a/doc/interpreter/expr.txi +++ b/doc/interpreter/expr.txi @@ -425,7 +425,7 @@ The following arithmetic operators are available, and work on scalars and matrices. -@table @code +@table @asis @item @var{x} + @var{y} @opindex + Addition. If both operands are matrices, the number of rows and columns @@ -1239,51 +1239,62 @@ any such mistake. When operators of equal precedence are used together, the leftmost -operator groups first, except for the assignment and exponentiation -operators, which group in the opposite order. Thus, the expression -@code{a - b + c} groups as @code{(a - b) + c}, but the expression -@code{a = b = c} groups as @code{a = (b = c)}. +operator groups first, except for the assignment operators, which group +in the opposite order. Thus, the expression @code{a - b + c} groups as +@code{(a - b) + c}, but the expression @code{a = b = c} groups as +@code{a = (b = c)}. The precedence of prefix unary operators is important when another operator follows the operand. For example, @code{-x^2} means @code{-(x^2)}, because @samp{-} has lower precedence than @samp{^}. -Here is a table of the operators in Octave, in order of increasing -precedence. +Here is a table of the operators in Octave, in order of decreasing +precedence. Unless noted, all operators group left to right. @table @code -@item statement separators -@samp{;}, @samp{,}. +@item function call and array indexing, cell array indexing, and structure element indexing +@samp{()} @samp{@{@}} @samp{.} + +@item postfix increment, and postfix decrement +@samp{++} @samp{--} + +These operators group right to left. + +@item transpose and exponentiation +@samp{'} @samp{.'} @samp{^} @samp{**} @samp{.^} @samp{.**} -@item assignment -@samp{=}, @samp{+=}, @samp{-=}, @samp{*=},@samp{/=}. This operator -groups right to left. +@item unary plus, unary minus, prefix increment, prefix decrement, and logical "not" +@samp{+} @samp{-} @samp{++} @samp{--} @samp{~} @samp{!} + +@item multiply and divide +@samp{*} @samp{/} @samp{\} @samp{.\} @samp{.*} @samp{./} -@item logical "or" and "and" -@samp{||}, @samp{&&}. +@item add, subtract +@samp{+} @samp{-} -@item element-wise "or" and "and" -@samp{|}, @samp{&}. +@item colon +@samp{:} @item relational -@samp{<}, @samp{<=}, @samp{==}, @samp{>=}, @samp{>}, @samp{!=}, -@samp{~=}. +@samp{<} @samp{<=} @samp{==} @samp{>=} @samp{>} @samp{!=} +@samp{~=} -@item colon -@samp{:}. +@item element-wise "and" +@samp{&} -@item add, subtract -@samp{+}, @samp{-}. +@item element-wise "or" +@samp{|} -@item multiply, divide -@samp{*}, @samp{/}, @samp{\}, @samp{.\}, @samp{.*}, @samp{./}. +@item logical "and" +@samp{&&} -@item transpose -@samp{'}, @samp{.'} +@item logical "or" +@samp{||} -@item unary plus, minus, increment, decrement, and ``not'' -@samp{+}, @samp{-}, @samp{++}, @samp{--}, @samp{!}, @samp{~}. +@item assignment +@samp{=} @samp{+=} @samp{-=} @samp{*=} @samp{/=} @samp{\=} +@samp{^=} @samp{.*=} @samp{./=} @samp{.\=} @samp{.^=} @samp{|=} +@samp{&=} -@item exponentiation -@samp{^}, @samp{**}, @samp{.^}, @samp{.**}. +These operators group right to left. @end table
--- a/doc/interpreter/func.txi +++ b/doc/interpreter/func.txi @@ -289,6 +289,12 @@ dimensions, and it is often desirable to give the individual return values distinct names. +It is possible to use the @code{nthargout} function to obtain only some +of the return values or several at once in a cell array. @ref{Cell Array +Objects} + +@DOCSTRING(nthargout) + In addition to setting @code{nargin} each time a function is called, Octave also automatically initializes @code{nargout} to the number of values that are expected to be returned. This allows you to write
--- a/doc/interpreter/install.txi +++ b/doc/interpreter/install.txi @@ -32,7 +32,7 @@ under the terms of the GNU General Public License as published by the Free Software Foundation. -@strong{Note:} This file is automatically generated from +@strong{Note}: This file is automatically generated from @file{doc/interpreter/install.txi} in the Octave sources. To update the documentation make changes to the .txi source file rather than this derived file.
--- a/doc/interpreter/linalg.txi +++ b/doc/interpreter/linalg.txi @@ -187,6 +187,8 @@ @node Specialized Solvers @section Specialized Solvers +@DOCSTRING(bicg) + @DOCSTRING(bicgstab) @DOCSTRING(cgs)
--- a/doc/interpreter/matrix.txi +++ b/doc/interpreter/matrix.txi @@ -257,8 +257,6 @@ @DOCSTRING(rosser) -@DOCSTRING(sylvester_matrix) - @DOCSTRING(toeplitz) @DOCSTRING(vander)
--- a/doc/interpreter/mk_doc_cache.m +++ b/doc/interpreter/mk_doc_cache.m @@ -30,7 +30,7 @@ ## It is more efficient to fork to shell for makeinfo only once on large data nfiles = numel (docstrings_files); -text = cell (1, nfiles+1); +text = cell (1, nfiles); for i = 1:nfiles file = docstrings_files{i}; fid = fopen (file, "r"); @@ -39,16 +39,17 @@ else tmp = fread (fid, Inf, "*char")'; ## Strip off header lines - [null, text{i}] = strtok (tmp, doc_delim); + [~, text{i}] = strtok (tmp, doc_delim); endif endfor text = [text{:}, doc_delim]; ## Modify Octave-specific macros before passing to makeinfo +text = regexprep (text, "-\\*- texinfo -\\*-[ \t]*[\r\n]*", ""); text = regexprep (text, '@seealso *\{([^}]*)\}', "See also: $1."); text = regexprep (text, '@nospell *\{([^}]*)\}', "$1"); -text = regexprep (text, "-\\*- texinfo -\\*-[ \t]*[\r\n]*", ""); -text = regexprep (text, '@', "@@"); +text = regexprep (text, '@xcode *\{([^}]*)\}', "$1"); +text = strrep (text, '@', "@@"); ## Write data to temporary file for input to makeinfo [fid, name, msg] = mkstemp ("octave_doc_XXXXXX", true); @@ -58,17 +59,14 @@ fwrite (fid, text, "char"); fclose (fid); -cmd = sprintf ("%s --no-headers --no-warn --force --no-validate --fill-column=1024 %s", - makeinfo_program (), name); +cmd = [makeinfo_program() " --no-headers --no-warn --force --no-validate --fill-column=1024 " name]; [status, formatted_text] = system (cmd); ## Did we get the help text? if (status != 0) error ("makeinfo failed with exit status %d!", status); -endif - -if (isempty (formatted_text)) +elseif (isempty (formatted_text)) error ("makeinfo produced no output!"); endif @@ -85,42 +83,32 @@ [symbol, doc] = strtok (block, "\r\n"); - doc = regexprep (doc, "^[\r\n]+", ''); - ## Skip internal functions that start with __ as these aren't ## indexed by lookfor. if (length (symbol) > 2 && regexp (symbol, '^__.+__$')) continue; endif + doc = regexprep (doc, "^[\r\n]+", '', 'once'); + if (isempty (doc)) continue; endif - tmp = doc; - found = 0; - do - [s, e] = regexp (tmp, "^ -- [^\r\n]*[\r\n]"); - if (! isempty(s)) - found = 1; - tmp = tmp(e+1:end); - endif - until (isempty (s)) + tmp = regexprep (doc, "^ -- .*$[\r\n]", '', 'lineanchors', 'dotexceptnewline'); - if (! found) + if (isempty (tmp)) continue; endif end_of_first_sentence = regexp (tmp, "(\\.|[\r\n][\r\n])", "once"); if (isempty (end_of_first_sentence)) end_of_first_sentence = length (tmp); - else - end_of_first_sentence = end_of_first_sentence; endif first_sentence = tmp(1:end_of_first_sentence); first_sentence = regexprep (first_sentence, "([\r\n]| {2,})", " "); - first_sentence = regexprep (first_sentence, '^ +', ""); + first_sentence = regexprep (first_sentence, '^ +', "", 'once'); cache{1,k} = symbol; cache{2,k} = doc;
--- a/doc/interpreter/mkoctfile.1 +++ b/doc/interpreter/mkoctfile.1 @@ -95,28 +95,29 @@ Print configuration variable \fIVAR\fP. Recognized variables are: .RS .Vb - ALL_CFLAGS FFTW3F_LDFLAGS - ALL_CXXFLAGS FFTW3F_LIBS - ALL_FFLAGS FLIBS - ALL_LDFLAGS FPICFLAG - BLAS_LIBS INCFLAGS - CC LAPACK_LIBS - CFLAGS LDFLAGS - CPICFLAG LD_CXX - CPPFLAGS LD_STATIC_FLAG - CXX LFLAGS - CXXFLAGS LIBCRUFT - CXXPICFLAG LIBOCTAVE - DEPEND_EXTRA_SED_PATTERN LIBOCTINTERP - DEPEND_FLAGS LIBS - DL_LD OCTAVE_LIBS - DL_LDFLAGS RDYNAMIC_FLAG - EXEEXT READLINE_LIBS - F77 RLD_FLAG - F77_INTEGER_8_FLAG SED - FFLAGS XTRA_CFLAGS - FFTW3_LDFLAGS XTRA_CXXFLAGS - FFTW3_LIBS + ALL_CFLAGS FFTW3F_LIBS + ALL_CXXFLAGS FLIBS + ALL_FFLAGS FPICFLAG + ALL_LDFLAGS INCFLAGS + BLAS_LIBS LAPACK_LIBS + CC LDFLAGS + CFLAGS LD_CXX + CPICFLAG LD_STATIC_FLAG + CPPFLAGS LFLAGS + CXX LIBCRUFT + CXXFLAGS LIBOCTAVE + CXXPICFLAG LIBOCTINTERP + DEPEND_EXTRA_SED_PATTERN LIBS + DEPEND_FLAGS OCTAVE_LIBS + DL_LD OCTAVE_LINK_DEPS + DL_LDFLAGS OCT_LINK_DEPS + EXEEXT RDYNAMIC_FLAG + F77 READLINE_LIBS + F77_INTEGER_8_FLAG SED + FFLAGS XTRA_CFLAGS + FFTW3_LDFLAGS XTRA_CXXFLAGS + FFTW3_LIBS + FFTW3F_LDFLAGS .Ve .RE .TP
--- a/doc/interpreter/octave.texi +++ b/doc/interpreter/octave.texi @@ -46,6 +46,20 @@ \arg\ @end macro +@c The following macro works around a situation where the Info/plain text +@c expansion of the @code{XXX} macro is `XXX'. The use of the apostrophe +@c can be confusing if the code segment itself ends with a transpose operator. +@ifinfo +@macro xcode{arg} +\arg\ +@end macro +@end ifinfo +@ifnotinfo +@macro xcode{arg} +@code{\arg\} +@end macro +@end ifnotinfo + @ifinfo @format START-INFO-DIR-ENTRY
--- a/doc/interpreter/plot.txi +++ b/doc/interpreter/plot.txi @@ -2396,7 +2396,11 @@ may override the factory defaults. Although default values may be set for any object, they are set in -parent objects and apply to child objects. For example, +parent objects and apply to child objects, of the specified object type. +For example, seeting the default @code{color} property of @code{line} +objects to "green", for the @code{root} object, will result in all +@code{line} objects inheriting the @code{color} "green" as the default +value. @example set (0, "defaultlinecolor", "green");
--- a/doc/interpreter/sparse.txi +++ b/doc/interpreter/sparse.txi @@ -241,7 +241,7 @@ @group ri = ci = d = []; for j = 1:c - ri = [ri; randperm(r)(1:n)']; + ri = [ri; randperm(r,n)']; ci = [ci; j*ones(n,1)]; d = [d; rand(n,1)]; endfor
--- a/doc/interpreter/stats.txi +++ b/doc/interpreter/stats.txi @@ -114,7 +114,7 @@ @DOCSTRING(center) -@DOCSTRING(studentize) +@DOCSTRING(zscore) @DOCSTRING(histc) @@ -168,9 +168,7 @@ @DOCSTRING(cov) -@DOCSTRING(cor) - -@DOCSTRING(corrcoef) +@DOCSTRING(corr) @DOCSTRING(spearman)
--- a/doc/refcard/refcard.tex +++ b/doc/refcard/refcard.tex @@ -863,14 +863,14 @@ gray2ind ({\it i}, {\it n})&convert gray scale to Octave image\cr image ({\it img}, {\it zoom})&display an Octave image matrix\cr imagesc ({\it img}, {\it zoom})&display scaled matrix as image\cr +imread ({\it file})&load an image file\cr imshow ({\it img}, {\it map})&display Octave image\cr imshow ({\it i}, {\it n})&display gray scale image\cr imshow ({\it r}, {\it g}, {\it b})&display RGB image\cr +imwrite ({\it img}, {\it file})&write images in various file formats\cr ind2gray ({\it img}, {\it map})&convert Octave image to gray scale\cr ind2rgb ({\it img}, {\it map})&convert indexed image to RGB\cr -loadimage ({\it file})&load an image file\cr rgb2ind ({\it r}, {\it g}, {\it b})&convert RGB to Octave image\cr -\omit\tt saveimage ({\it file}, {\it img}, {\it fmt}, {\it map})\quad\rm save a matrix to {\it file}\span\cr \endsec
--- a/etc/OLD-ChangeLogs/ChangeLog +++ b/etc/OLD-ChangeLogs/ChangeLog @@ -2,6 +2,10 @@ * NEWS: Add colstyle to list of new functions for 3.4 +2011-04-08 Rik <octave@nomad.inbox5.com> + + * NEWS: Deprecate studentize(), add new function zscore(). + 2011-04-04 Rik <octave@nomad.inbox5.com> * NEWS: Add perror, strerror to list of functions deprecated in 3.4 @@ -88,6 +92,11 @@ * NEWS: Use indentation of 2 spaces rather than 3 in code examples. +2011-02-08 John W. Eaton <jwe@octave.org> + + * NEWS: New section for 3.6. List deprecated functions that + have been removed for 3.6. + 2011-02-08 Ben Abbott <bpabbott@mac.com> * README.MacOS: Add detail.
--- a/etc/OLD-ChangeLogs/doc-ChangeLog +++ b/etc/OLD-ChangeLogs/doc-ChangeLog @@ -1,3 +1,7 @@ +2011-04-16 Ben Abbott <bpabbott@mac.com> + + * interpreter/plot.txi: Clarify that inheritance of default property + values only applies to the named object type. 2011-04-14 Rik <octave@nomad.inbox5.com> * interpreter/plot.txi: Add colstyle function to documentation. @@ -16,6 +20,11 @@ * interpreter/func.txi: Add discussion of isargout to Ignoring Arguments section of documentation. +2011-04-08 Rik <octave@nomad.inbox5.com> + + * interpreter/stats.txi: Deprecate studentize(), replace with + zscore(). + 2011-04-07 Rik <octave@nomad.inbox5.com> * interpreter/Makefile.am: Add spellcheck target to documentation @@ -42,7 +51,7 @@ 2011-04-04 Rik <octave@nomad.inbox5.com> - * interpreter/doccheck/aspell-octave.en.pws, interpreter/nonlin.txi, + * interpreter/doccheck/aspell-octave.en.pws, interpreter/nonlin.txi, interpreter/tips.txi: Spellcheck documentation for 3.4.1 release. 2011-04-04 Rik <octave@nomad.inbox5.com>
--- a/etc/OLD-ChangeLogs/liboctave-ChangeLog +++ b/etc/OLD-ChangeLogs/liboctave-ChangeLog @@ -1,3 +1,7 @@ +2011-04-12 Rik <octave@nomad.inbox5.com> + + * LSODE.cc: Add semicolon to error messages to prevent run-together text. + 2011-04-01 Jordi Gutiérrez Hermoso <jordigh@gmail.com> * MatrixType (MatrixType::operator =): Plug memory leak due to
--- a/etc/OLD-ChangeLogs/scripts-ChangeLog +++ b/etc/OLD-ChangeLogs/scripts-ChangeLog @@ -1,8 +1,47 @@ +2011-04-18 Paul Boven <p.boven@xs4all.nl> + + * image/image.m: Fixed naming of variables in texinfo + +2011-04-17 Patrick Häcker <magicmuscleman> + + * strings/mat2str.m: Limit the number of digits to one less than + available for double. + +2011-04-15 Kai Habel <kai.habel@gmx.de> + + * general/interp1.m, polynomial/mkpp.m, polynomial/pchip.m, + polynomial/ppder.m, polynomial/ppint.m, polynomial/ppjumps.m, + polynomial/ppval.m, polynomial/spline.m, polynomial/unmkpp.m: + Make functions more compatible with respect to handling of + picewise polynoms (pp). Rename pp-struct elements. + Handle nD-arguments correctly. Tests added. + (bugs #32040, #32045) + 2011-04-13 David Bateman <dbateman@free.fr> * plot/colstyle.m : New function. * plot/module.mk plot_FCN_FILES) : Add it here. +2011-04-13 Rik <octave@nomad.inbox5.com> + + * help/__makeinfo__.m: Simplify function by using regular expressions. + Eliminate third input argument see_also function. + +2011-04-13 Rik <octave@nomad.inbox5.com> + + * general/isdir.m, general/isequal.m, general/isequalwithequalnans.m, + general/isscalar.m, general/issquare.m, general/isvector.m: Refactor + code to put input validation first. + + * general/iscolumn.m, general/isrow.m : Remove useless initialization + of output variable. + + * general/isa.m: Add additional tests for various classes. + +2011-04-13 Rik <octave@nomad.inbox5.com> + + * ChangeLog: Remove results of bad merge in ChangeLog. + 2011-04-12 Ben Abbott <bpabbott@mac.com> * miscellaneous/getappdata.m: If no property name is provided, return @@ -20,10 +59,21 @@ 2011-04-08 Rik <octave@nomad.inbox5.com> + * deprecated/module.mk, statistics/base/center.m, + statistics/base/module.mk: Deprecate studentize(), replace with + zscore(). + +2011-04-08 Rik <octave@nomad.inbox5.com> + * linear-algebra/cond.m, linear-algebra/expm.m, linear-algebra/logm.m, linear-algebra/null.m, linear-algebra/orth.m, linear-algebra/rank.m, linear-algebra/rref.m: Improve docstrings. +2011-04-08 Rik <octave@nomad.inbox5.com> + + * statistics/base/mode.m, statistics/base/quantile.m: Return output + of same class as input. + 2011-04-06 Rik <octave@nomad.inbox5.com> * miscellaneous/pack.m: Improve docstring. @@ -397,6 +447,25 @@ * plot/__go_draw_axes__.m: Properly set fontspec for legends. +2011-02-08 John W. Eaton <jwe@octave.org> + + * deprecated/complement.m, deprecated/create_set.m, + deprecated/dmult.m, deprecated/iscommand.m, + deprecated/israwcommand.m, deprecated/lchol.m, + deprecated/loadimage.m, deprecated/mark_as_command.m, + deprecated/mark_as_rawcommand.m, deprecated/spatan2.m, + deprecated/spchol2inv.m, deprecated/spcholinv.m, + deprecated/spchol.m, deprecated/spcumprod.m, + deprecated/spcumsum.m, deprecated/spdet.m, deprecated/spdiag.m, + deprecated/spfind.m, deprecated/spinv.m, deprecated/spkron.m, + deprecated/splchol.m, deprecated/split.m, deprecated/splu.m, + deprecated/spmax.m, deprecated/spmin.m, deprecated/spprod.m, + deprecated/spqr.m, deprecated/spsum.m, deprecated/spsumsq.m, + deprecated/str2mat.m, deprecated/unmark_command.m, + deprecated/unmark_rawcommand.m: + Remove functions deprecated in version 3.2. + * module.mk (deprecated_FCN_FILES): Remove them from the list. + 2011-02-05 David Bateman <dbateman@free.fr> * plot/legend.m: Allow the location and orientation to be set
--- a/etc/OLD-ChangeLogs/src-ChangeLog +++ b/etc/OLD-ChangeLogs/src-ChangeLog @@ -1,10 +1,15 @@ +2011-04-19 Kai Habel <kai.habel@gmx.de> + + * src/DLD-FUNCTIONS/__init_fltk__.cc(plot_window::plot_window): + Instantiate canvas before uimenu. + 2011-04-13 Rik <octave@nomad.inbox5.com> * help.cc: Add spaces after commas in @seealso blocks. 2011-04-12 Rik <octave@nomad.inbox5.com> - * load-path.cc (restoredefaultpath): Correct use of it's -> its in + * load-path.cc (restoredefaultpath): Correct use of it's -> its in documentation. 2011-04-10 John Eaton <jwe@octave.org> @@ -90,7 +95,7 @@ * DLD-FUNCTIONS/inv.cc (inv, inverse), DLD-FUNCTIONS/tril.cc (tril), data.cc (cumsum, szie), file-io.cc (fgets), ov-typeinfo.cc (typeinfo), - ov-usr-fcn.cc (nargout), utils.cc (make_absolute_filename), + ov-usr-fcn.cc (nargout), utils.cc (make_absolute_filename), variables.cc (who): Improve docstrings 2011-03-25 John W. Eaton <jwe@octave.org> @@ -342,6 +347,10 @@ 2011-02-08 John W. Eaton <jwe@octave.org> + * DLD-FUNCTIONS/chol.cc: Delete obsolete test of spcholinv. + +2011-02-08 John W. Eaton <jwe@octave.org> + * oct-parse.yy (parse_fcn_file): Don't warn about coercing nested functions to subfunctions if yyparse failed.
--- a/etc/OLD-ChangeLogs/test-ChangeLog +++ b/etc/OLD-ChangeLogs/test-ChangeLog @@ -1,3 +1,9 @@ +2011-04-11 Rik <octave@nomad.inbox5.com> + + * fntests.m: Remove deprecated and private functions from list of + functions requiring tests. Count functions with %!demo blocks as + having tests. + 2011-04-03 Rik <octave@nomad.inbox5.com> * test_diag_perm.m: Reverse previous changeset. Return 3-input form
--- a/etc/README.MacOS +++ b/etc/README.MacOS @@ -334,67 +334,83 @@ includes a port file for octave-devel. To build and run the most recent development snapshots, enter the commands below. - sudo port selfupdate - sudo port install octave-devel + sudo port selfupdate + sudo port install octave-devel To build the developers sources in one's own way, or if MacPorts' version is outdated, a custom port file can be added. This requires setting up a local port file repository (link below). - http://guide.macports.org/#development.local-repositories + http://guide.macports.org/#development.local-repositories The octave-devel port file may be used as an initial starting point. The port file is accessible from the web at the link below. - http://trac.macports.org/browser/trunk/dports/math/octave-devel/Portfile + http://trac.macports.org/browser/trunk/dports/math/octave-devel/Portfile It is also available locally at the location below. The parameter ${prefix} is corresponds to where MacPorts is install, which by default is "/opt/local". - ${prefix}/var/macports/sources/rsync.macports.org/release/ports/math/octave-devel/Portfile + ${prefix}/var/macports/sources/rsync.macports.org/release/ports/math/octave-devel/Portfile + +If the Portfile is missing the dependencies, epstools, epstoedit, and transfig, +those should be installed manually or added to the Portfile. To install +manually, type the command below. + + sudo port install epstools epstoedit transfig The local source tarball must be placed in the location below, where ${name} and ${distname} are each specified in the port file. - ${prefix}/var/macports/distfiles/${name}/${disname}.tar.gz + ${prefix}/var/macports/distfiles/${name}/${disname}.tar.gz 2.4.2 Building for Active Development of Octave ----------------------------------------------- -To satisfy Octave's dependencies, first install the octave-devel port. - - sudo port selfupdate - sudo port install octave-devel +To satisfy most of Octave's dependencies, first install the octave-devel port. -Next run octave to determine the configure options needed to build Octave -using MacPorts. At Octave's prompt type the command below and make note of -the result, ${config_opts}. - - octave:1> octave_config_info.config_opts + sudo port selfupdate + sudo port install octave-devel Now uninstall the Octave port. - sudo port deactivate octave-devel + sudo port deactivate octave-devel + +This will remove Octave and leave its dependencies in place. Some additional +dependencies may be needed. + + sudo port install epstools epstoedit transfig + +Octave may now be built from a local mercurial archive by typing the commands +below (these assume gcc-4.4 is installed by macports). -This will remove Octave and leave its dependencies in place. Now Octave may -be built from the local mercurial archive by typing the commands below, where -the configure options mentioned above are substituted for the parameter -${config_opts}. If the sources being built are from the mercurial archive, -then ./autogen.sh must be run prior to ./configure. - - ./configure ${config_opts} - make + ./autogen.sh + export PREFIX=/opt/local + export CC=/opt/local/bin/gcc-mp-4.4 + export CXX=/opt/local/bin/g++-mp-4.4 + export CXXCPP="/opt/local/bin/g++-mp-4.4 -E" + export F77=/opt/local/bin/gfortran-mp-4.4 + export FC=/opt/local/bin/gfortran-mp-4.4 + export CXXFLAGS="-pipe -O2 -m64" + export FFLAGS="$CXXFLAGS -D_THREAD_SAFE -pthread" + export CFLAGS="$FFLAGS -lstdc++" + export LDFLAGS=-L$PREFIX/lib + export CPPFLAGS=-I$PREFIX/include + export BLAS_LIBS="-lcblas -lf77blas -latlas" + export LAPACK_LIBS=-llapack + ./configure --prefix="/opt/local" --without-framework-carbon --with-x + make Octave's integrated tests may be run. - make check + make check -However, "make install" should not be run as it may damage or corrupt the -MacPorts installation. To run Octave, type the command below from the root of -the mercurial archive. +"make install" should not be run as it will bypass the macports package +management. To run Octave, type the command below from the root of the +mercurial archive. - ./run-octave + ./run-octave John W. Eaton
--- a/etc/gdbinit +++ b/etc/gdbinit @@ -1,5 +1,6 @@ ## Helpful macros for debugging Octave. +############################################################ ## Display a dim-vector object. define display-dims @@ -11,6 +12,12 @@ dont-repeat end +document display-dims +Usage: display-dims DIM_VECTOR +Display the contents of an Octave dimension vector. +end + +############################################################ ## Display a dense array object. define display-dense-array @@ -26,6 +33,15 @@ dont-repeat end +document display-dense-array +Usage: display-dense-array ARRAY +Display the contents of an ordinary, i.e., dense Octave array. + +See also [display-sparse-array] for showing the contents +of sparse Octave arrays. +end + +############################################################ ## Display a sparse array object. define display-sparse-array @@ -46,3 +62,28 @@ echo \n dont-repeat end + +document display-sparse-array +Usage: display-sparse-array SPARSE_ARRAY +Display the contents of a sparse Octave array. + +See also [display-dense-array] for showing the contents +of ordinary Octave arrays. +end + +############################################################ + +## Display Octave debugging stack + +define show-octave-dbstack + call show_octave_dbstack () +end + +document show-octave-dbstack +Usage: show-octave-dbstack +Display the contents of the current Octave debugging stack. + +This is the function stack that the Octave interpreter is processing +and will be different from the C++ stack being debugged with gdb. +end +
--- a/libcruft/Makefile.am +++ b/libcruft/Makefile.am @@ -3,17 +3,17 @@ # Copyright (C) 1993-2011 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 # <http://www.gnu.org/licenses/>. @@ -34,6 +34,13 @@ @CRUFT_DLL_DEFS@ \ $(AM_CPPFLAGS) +include link-deps.mk + +libcruft_la_LIBADD = \ + libranlib.la \ + ../libgnu/libgnu.la \ + $(LIBCRUFT_LINK_DEPS) + # Increment these as needed and according to the rules in the libtool # manual: libcruft_current = 0 @@ -46,13 +53,8 @@ -version-info $(libcruft_version_info) \ $(NO_UNDEFINED_LDFLAG) \ @XTRA_CRUFT_SH_LDFLAGS@ \ - -bindir $(bindir) - -libcruft_la_LIBADD = \ - ../libgnu/libgnu.la \ - libranlib.la \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(FLIBS) + -bindir $(bindir) \ + $(LIBCRUFT_LINK_OPTS) libcruft_la_DEPENDENCIES = cruft.def
--- a/libcruft/blas-xtra/cdotc3.f +++ b/libcruft/blas-xtra/cdotc3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine cdotc3(m,n,k,a,b,c) -c purpose: a 3-dimensional dot product. +c purpose: a 3-dimensional dot product. c c = sum (conj (a) .* b, 2), where a and b are 3d arrays. c arguments: c m,n,k (in) the dimensions of a and b
--- a/libcruft/blas-xtra/cmatm3.f +++ b/libcruft/blas-xtra/cmatm3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine cmatm3(m,n,k,np,a,b,c) -c purpose: a 3-dimensional matrix product. +c purpose: a 3-dimensional matrix product. c given a (m,k,np) array a and (k,n,np) array b, c calculates a (m,n,np) array c such that c for i = 1:np @@ -28,8 +28,8 @@ c arguments: c m,n,k (in) the dimensions c np (in) number of multiplications -c a (in) a complex input array, size (m,k,np) -c b (in) a complex input array, size (k,n,np) +c a (in) a complex input array, size (m,k,np) +c b (in) a complex input array, size (k,n,np) c c (out) a complex output array, size (m,n,np) integer m,n,k,np complex a(m*k,np),b(k*n,np)
--- a/libcruft/blas-xtra/ddot3.f +++ b/libcruft/blas-xtra/ddot3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine ddot3(m,n,k,a,b,c) -c purpose: a 3-dimensional dot product. +c purpose: a 3-dimensional dot product. c c = sum (a .* b, 2), where a and b are 3d arrays. c arguments: c m,n,k (in) the dimensions of a and b
--- a/libcruft/blas-xtra/dmatm3.f +++ b/libcruft/blas-xtra/dmatm3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine dmatm3(m,n,k,np,a,b,c) -c purpose: a 3-dimensional matrix product. +c purpose: a 3-dimensional matrix product. c given a (m,k,np) array a and (k,n,np) array b, c calculates a (m,n,np) array c such that c for i = 1:np @@ -28,8 +28,8 @@ c arguments: c m,n,k (in) the dimensions c np (in) number of multiplications -c a (in) a double prec. input array, size (m,k,np) -c b (in) a double prec. input array, size (k,n,np) +c a (in) a double prec. input array, size (m,k,np) +c b (in) a double prec. input array, size (k,n,np) c c (out) a double prec. output array, size (m,n,np) integer m,n,k,np double precision a(m*k,np),b(k*n,np)
--- a/libcruft/blas-xtra/sdot3.f +++ b/libcruft/blas-xtra/sdot3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine sdot3(m,n,k,a,b,c) -c purpose: a 3-dimensional dot product. +c purpose: a 3-dimensional dot product. c c = sum (a .* b, 2), where a and b are 3d arrays. c arguments: c m,n,k (in) the dimensions of a and b
--- a/libcruft/blas-xtra/smatm3.f +++ b/libcruft/blas-xtra/smatm3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine smatm3(m,n,k,np,a,b,c) -c purpose: a 3-dimensional matrix product. +c purpose: a 3-dimensional matrix product. c given a (m,k,np) array a and (k,n,np) array b, c calculates a (m,n,np) array c such that c for i = 1:np @@ -28,8 +28,8 @@ c arguments: c m,n,k (in) the dimensions c np (in) number of multiplications -c a (in) a real input array, size (m,k,np) -c b (in) a real input array, size (k,n,np) +c a (in) a real input array, size (m,k,np) +c b (in) a real input array, size (k,n,np) c c (out) a real output array, size (m,n,np) integer m,n,k,np real a(m*k,np),b(k*n,np)
--- a/libcruft/blas-xtra/zdotc3.f +++ b/libcruft/blas-xtra/zdotc3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine zdotc3(m,n,k,a,b,c) -c purpose: a 3-dimensional dot product. +c purpose: a 3-dimensional dot product. c c = sum (conj (a) .* b, 2), where a and b are 3d arrays. c arguments: c m,n,k (in) the dimensions of a and b
--- a/libcruft/blas-xtra/zmatm3.f +++ b/libcruft/blas-xtra/zmatm3.f @@ -19,7 +19,7 @@ c <http://www.gnu.org/licenses/>. c subroutine zmatm3(m,n,k,np,a,b,c) -c purpose: a 3-dimensional matrix product. +c purpose: a 3-dimensional matrix product. c given a (m,k,np) array a and (k,n,np) array b, c calculates a (m,n,np) array c such that c for i = 1:np @@ -28,8 +28,8 @@ c arguments: c m,n,k (in) the dimensions c np (in) number of multiplications -c a (in) a double complex input array, size (m,k,np) -c b (in) a double complex input array, size (k,n,np) +c a (in) a double complex input array, size (m,k,np) +c b (in) a double complex input array, size (k,n,np) c c (out) a double complex output array, size (m,n,np) integer m,n,k,np double complex a(m*k,np),b(k*n,np)
--- a/libcruft/lapack-xtra/crsf2csf.f +++ b/libcruft/lapack-xtra/crsf2csf.f @@ -32,7 +32,7 @@ y = t(j+1,j) if (y /= 0) then -c 2x2 block, form Givens rotation [c, i*s; i*s, c] +c 2x2 block, form Givens rotation [c, i*s; i*s, c] x = t(j,j) z = t(j,j+1) c(j) = sqrt(z/(z-y)) @@ -42,7 +42,7 @@ c apply all rotations to t(1:j+1,j+1) call crcrot1(j+1,t(1,j+1),c,s) c apply new rotation to columns j,j+1 - call crcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) + call crcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) c zero subdiagonal entry, skip next row t(j+1,j) = 0 c(j+1) = 1
--- a/libcruft/lapack-xtra/zrsf2csf.f +++ b/libcruft/lapack-xtra/zrsf2csf.f @@ -32,7 +32,7 @@ y = t(j+1,j) if (y /= 0) then -c 2x2 block, form Givens rotation [c, i*s; i*s, c] +c 2x2 block, form Givens rotation [c, i*s; i*s, c] x = t(j,j) z = t(j,j+1) c(j) = sqrt(z/(z-y)) @@ -42,7 +42,7 @@ c apply all rotations to t(1:j+1,j+1) call zrcrot1(j+1,t(1,j+1),c,s) c apply new rotation to columns j,j+1 - call zrcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) + call zrcrot2(j+1,t(1,j),t(1,j+1),c(j),s(j)) c zero subdiagonal entry, skip next row t(j+1,j) = 0 c(j+1) = 1
new file mode 100644 --- /dev/null +++ b/libcruft/link-deps.mk @@ -0,0 +1,30 @@ +## The following libraries may be needed to satisfy gnulib dependencies: +## +## $(COPYSIGN_LIBM) +## $(FLOOR_LIBM) +## $(GETHOSTNAME_LIB) +## $(LIBSOCKET) +## $(LIB_NANOSLEEP) +## $(LTLIBINTL) +## $(ROUNDF_LIBM) +## $(ROUND_LIBM) +## $(TRUNCF_LIBM) +## $(TRUNC_LIBM) + +LIBCRUFT_LINK_DEPS = \ + $(COPYSIGN_LIBM) \ + $(FLOOR_LIBM) \ + $(GETHOSTNAME_LIB) \ + $(LIBSOCKET) \ + $(LIB_NANOSLEEP) \ + $(LTLIBINTL) \ + $(ROUNDF_LIBM) \ + $(ROUND_LIBM) \ + $(TRUNCF_LIBM) \ + $(TRUNC_LIBM) \ + $(LAPACK_LIBS) \ + $(BLAS_LIBS) \ + $(FLIBS) \ + $(LIBS) + +LIBCRUFT_LINK_OPTS =
--- a/liboctave/Array.cc +++ b/liboctave/Array.cc @@ -2485,7 +2485,7 @@ } else { - // Create diag matrix from vector + // Create diag matrix from vector octave_idx_type roff = 0; octave_idx_type coff = 0; if (k > 0)
--- a/liboctave/CColVector.cc +++ b/liboctave/CColVector.cc @@ -242,7 +242,7 @@ ComplexColumnVector conj (const ComplexColumnVector& a) { - return do_mx_unary_map<Complex, Complex, std::conj> (a); + return do_mx_unary_map<Complex, Complex, std::conj<double> > (a); } // resize is the destructive equivalent for this one
--- a/liboctave/CMatrix.cc +++ b/liboctave/CMatrix.cc @@ -921,7 +921,7 @@ ComplexMatrix conj (const ComplexMatrix& a) { - return do_mx_unary_map<Complex, Complex, std::conj> (a); + return do_mx_unary_map<Complex, Complex, std::conj<double> > (a); } // resize is the destructive equivalent for this one @@ -1571,6 +1571,9 @@ { ComplexDET retval (1.0); + info = 0; + rcon = 0.0; + octave_idx_type nr = rows (); octave_idx_type nc = cols (); @@ -1599,7 +1602,6 @@ ComplexMatrix atmp = *this; Complex *tmp_data = atmp.fortran_vec (); - info = 0; double anorm = 0; if (calc_cond) anorm = xnorm (*this, 1); @@ -3795,7 +3797,7 @@ octave_idx_type lda = a.rows (), tda = a.cols (); octave_idx_type ldb = b.rows (), tdb = b.cols (); - retval = ComplexMatrix (a_nr, b_nc); + retval = ComplexMatrix (a_nr, b_nc, 0.0); Complex *c = retval.fortran_vec (); if (b_nc == 1 && a_nr == 1)
--- a/liboctave/CNDArray.cc +++ b/liboctave/CNDArray.cc @@ -760,7 +760,7 @@ ComplexNDArray conj (const ComplexNDArray& a) { - return do_mx_unary_map<Complex, Complex, std::conj> (a); + return do_mx_unary_map<Complex, Complex, std::conj<double> > (a); } ComplexNDArray&
--- a/liboctave/CRowVector.cc +++ b/liboctave/CRowVector.cc @@ -234,7 +234,7 @@ ComplexRowVector conj (const ComplexRowVector& a) { - return do_mx_unary_map<Complex, Complex, std::conj> (a); + return do_mx_unary_map<Complex, Complex, std::conj<double> > (a); } // resize is the destructive equivalent for this one
--- a/liboctave/CRowVector.h +++ b/liboctave/CRowVector.h @@ -125,9 +125,9 @@ // row vector by column vector -> scalar -Complex operator * (const ComplexRowVector& a, const ColumnVector& b); +Complex OCTAVE_API operator * (const ComplexRowVector& a, const ColumnVector& b); -Complex operator * (const ComplexRowVector& a, const ComplexColumnVector& b); +Complex OCTAVE_API operator * (const ComplexRowVector& a, const ComplexColumnVector& b); // other operations
--- a/liboctave/DASPK-opts.in +++ b/liboctave/DASPK-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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 # <http://www.gnu.org/licenses/>. @@ -262,7 +262,7 @@ A vector of the same length as the state specifying the type of inequality constraint. Each element of the vector corresponds to an element of the state and should be assigned one of the following -codes +codes @table @asis @item -2
--- a/liboctave/DASRT-opts.in +++ b/liboctave/DASRT-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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 # <http://www.gnu.org/licenses/>.
--- a/liboctave/DASSL-opts.in +++ b/liboctave/DASSL-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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 # <http://www.gnu.org/licenses/>.
--- a/liboctave/LSODE-opts.in +++ b/liboctave/LSODE-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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 # <http://www.gnu.org/licenses/>.
--- a/liboctave/LSODE.cc +++ b/liboctave/LSODE.cc @@ -292,7 +292,7 @@ case -2: // excess accuracy requested (tolerances too small). case -3: // invalid input detected (see printed message). case -4: // repeated error test failures (check all inputs). - case -5: // repeated convergence failures (perhaps bad jacobian + case -5: // repeated convergence failures (perhaps bad Jacobian // supplied or wrong choice of mf or tolerances). case -6: // error weight became zero during problem. (solution // component i vanished, and atol or atol(i) = 0.) @@ -349,13 +349,13 @@ case -4: retval = std::string ("repeated error test failures (t = ") - + t_curr + "check all inputs)"; + + t_curr + "; check all inputs)"; break; case -5: retval = std::string ("repeated convergence failures (t = ") + t_curr - + "perhaps bad jacobian supplied or wrong choice of integration method or tolerances)"; + + "; perhaps bad Jacobian supplied or wrong choice of integration method or tolerances)"; break; case -6:
--- a/liboctave/MArray-i.cc +++ b/liboctave/MArray-i.cc @@ -34,6 +34,13 @@ template class OCTAVE_API MArray<int>; template class OCTAVE_API MArray<long>; +// Explicit instantiation, as this seems to be required by weird compilers +// like MSVC. This should be harmless on other compilers. +template int xmin<int> (int, int); +template int xmax<int> (int, int); +template long xmin<long> (long, long); +template long xmax<long> (long, long); + INSTANTIATE_MARRAY_FRIENDS (int, OCTAVE_API) INSTANTIATE_MARRAY_FRIENDS (long, OCTAVE_API)
--- a/liboctave/MArray-s.cc +++ b/liboctave/MArray-s.cc @@ -31,6 +31,11 @@ template class OCTAVE_API MArray<short>; +// Explicit instantiation, as this seems to be required by weird compilers +// like MSVC. This should be harmless on other compilers. +template short xmin<short> (short, short); +template short xmax<short> (short, short); + INSTANTIATE_MARRAY_FRIENDS (short, OCTAVE_API) #include "MDiagArray2.h"
--- a/liboctave/MArray.cc +++ b/liboctave/MArray.cc @@ -264,7 +264,7 @@ if (a.is_shared ()) a = a + b; else - do_mm_inplace_op<T, T> (a, b, mx_inline_add2, "+="); + do_mm_inplace_op<T, T> (a, b, mx_inline_add2, mx_inline_add2, "+="); return a; } @@ -275,7 +275,7 @@ if (a.is_shared ()) a = a - b; else - do_mm_inplace_op<T, T> (a, b, mx_inline_sub2, "-="); + do_mm_inplace_op<T, T> (a, b, mx_inline_sub2, mx_inline_sub2, "-="); return a; } @@ -287,7 +287,7 @@ if (a.is_shared ()) return a = product (a, b); else - do_mm_inplace_op<T, T> (a, b, mx_inline_mul2, ".*="); + do_mm_inplace_op<T, T> (a, b, mx_inline_mul2, mx_inline_mul2, ".*="); return a; } @@ -298,7 +298,7 @@ if (a.is_shared ()) return a = quotient (a, b); else - do_mm_inplace_op<T, T> (a, b, mx_inline_div2, "./="); + do_mm_inplace_op<T, T> (a, b, mx_inline_div2, mx_inline_div2, "./="); return a; } @@ -339,7 +339,7 @@ MArray<T> \ FCN (const MArray<T>& a, const MArray<T>& b) \ { \ - return do_mm_binary_op<T, T, T> (a, b, FN, #FCN); \ + return do_mm_binary_op<T, T, T> (a, b, FN, FN, FN, #FCN); \ } MARRAY_NDND_OP (operator +, +, mx_inline_add)
--- a/liboctave/MDiagArray2.cc +++ b/liboctave/MDiagArray2.cc @@ -82,7 +82,7 @@ { \ if (a.d1 != b.d1 || a.d2 != b.d2) \ gripe_nonconformant (#FCN, a.d1, a.d2, b.d1, b.d2); \ - return MDiagArray2<T> (do_mm_binary_op<T, T, T> (a, b, FN, #FCN), a.d1, a.d2); \ + return MDiagArray2<T> (do_mm_binary_op<T, T, T> (a, b, FN, FN, FN, #FCN), a.d1, a.d2); \ } MARRAY_DADA_OP (operator +, +, mx_inline_add)
--- a/liboctave/MSparse.cc +++ b/liboctave/MSparse.cc @@ -25,6 +25,8 @@ #include <config.h> #endif +#include <functional> + #include "quit.h" #include "lo-error.h" #include "MArray.h" @@ -37,9 +39,9 @@ // Element by element MSparse by MSparse ops. -template <class T> +template <class T, class OP> MSparse<T>& -operator += (MSparse<T>& a, const MSparse<T>& b) +plus_or_minus (MSparse<T>& a, const MSparse<T>& b, OP op, const char* op_name) { MSparse<T> r; @@ -50,80 +52,7 @@ octave_idx_type b_nc = b.cols (); if (a_nr != b_nr || a_nc != b_nc) - gripe_nonconformant ("operator +=" , a_nr, a_nc, b_nr, b_nc); - else - { - r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); - - octave_idx_type jx = 0; - for (octave_idx_type i = 0 ; i < a_nc ; i++) - { - octave_idx_type ja = a.cidx(i); - octave_idx_type ja_max = a.cidx(i+1); - bool ja_lt_max= ja < ja_max; - - octave_idx_type jb = b.cidx(i); - octave_idx_type jb_max = b.cidx(i+1); - bool jb_lt_max = jb < jb_max; - - while (ja_lt_max || jb_lt_max ) - { - octave_quit (); - if ((! jb_lt_max) || - (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) - { - r.ridx(jx) = a.ridx(ja); - r.data(jx) = a.data(ja) + 0.; - jx++; - ja++; - ja_lt_max= ja < ja_max; - } - else if (( !ja_lt_max ) || - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) - { - r.ridx(jx) = b.ridx(jb); - r.data(jx) = 0. + b.data(jb); - jx++; - jb++; - jb_lt_max= jb < jb_max; - } - else - { - if ((a.data(ja) + b.data(jb)) != 0.) - { - r.data(jx) = a.data(ja) + b.data(jb); - r.ridx(jx) = a.ridx(ja); - jx++; - } - ja++; - ja_lt_max= ja < ja_max; - jb++; - jb_lt_max= jb < jb_max; - } - } - r.cidx(i+1) = jx; - } - - a = r.maybe_compress (); - } - - return a; -} - -template <class T> -MSparse<T>& -operator -= (MSparse<T>& a, const MSparse<T>& b) -{ - MSparse<T> r; - - octave_idx_type a_nr = a.rows (); - octave_idx_type a_nc = a.cols (); - - octave_idx_type b_nr = b.rows (); - octave_idx_type b_nc = b.cols (); - - if (a_nr != b_nr || a_nc != b_nc) - gripe_nonconformant ("operator -=" , a_nr, a_nc, b_nr, b_nc); + gripe_nonconformant (op_name , a_nr, a_nc, b_nr, b_nc); else { r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); @@ -146,7 +75,7 @@ (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) { r.ridx(jx) = a.ridx(ja); - r.data(jx) = a.data(ja) - 0.; + r.data(jx) = op (a.data(ja), 0.); jx++; ja++; ja_lt_max= ja < ja_max; @@ -155,16 +84,16 @@ (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) { r.ridx(jx) = b.ridx(jb); - r.data(jx) = 0. - b.data(jb); + r.data(jx) = op (0., b.data(jb)); jx++; jb++; jb_lt_max= jb < jb_max; } else { - if ((a.data(ja) - b.data(jb)) != 0.) + if (op (a.data(ja), b.data(jb)) != 0.) { - r.data(jx) = a.data(ja) - b.data(jb); + r.data(jx) = op (a.data(ja), b.data(jb)); r.ridx(jx) = a.ridx(ja); jx++; } @@ -183,435 +112,506 @@ return a; } +template <typename T> +MSparse<T>& +operator += (MSparse<T>& a, const MSparse<T>& b) +{ + return plus_or_minus (a, b, std::plus<T> (), "operator +="); +} + +template <typename T> +MSparse<T>& +operator -= (MSparse<T>& a, const MSparse<T>& b) +{ + return plus_or_minus (a, b, std::minus<T> (), "operator -="); +} + + // Element by element MSparse by scalar ops. -#define SPARSE_A2S_OP_1(OP) \ - template <class T> \ - MArray<T> \ - operator OP (const MSparse<T>& a, const T& s) \ - { \ - octave_idx_type nr = a.rows (); \ - octave_idx_type nc = a.cols (); \ - \ - MArray<T> r (dim_vector (nr, nc), (0.0 OP s)); \ - \ - for (octave_idx_type j = 0; j < nc; j++) \ - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) \ - r.elem (a.ridx (i), j) = a.data (i) OP s; \ - return r; \ - } +template <class T, class OP> +MArray<T> +plus_or_minus (const MSparse<T>& a, const T& s, OP op) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + MArray<T> r (dim_vector (nr, nc), op (0.0, s)); -#define SPARSE_A2S_OP_2(OP) \ - template <class T> \ - MSparse<T> \ - operator OP (const MSparse<T>& a, const T& s) \ - { \ - octave_idx_type nr = a.rows (); \ - octave_idx_type nc = a.cols (); \ - octave_idx_type nz = a.nnz (); \ - \ - MSparse<T> r (nr, nc, nz); \ - \ - for (octave_idx_type i = 0; i < nz; i++) \ - { \ - r.data(i) = a.data(i) OP s; \ - r.ridx(i) = a.ridx(i); \ - } \ - for (octave_idx_type i = 0; i < nc + 1; i++) \ - r.cidx(i) = a.cidx(i); \ - r.maybe_compress (true); \ - return r; \ - } + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + r.elem (a.ridx (i), j) = op (a.data (i), s); + return r; +} + +template <typename T> +MArray<T> +operator + (const MSparse<T>& a, const T& s) +{ + return plus_or_minus (a, s, std::plus<T> ()); +} + +template <typename T> +MArray<T> +operator - (const MSparse<T>& a, const T& s) +{ + return plus_or_minus (a, s, std::minus<T> ()); +} -SPARSE_A2S_OP_1 (+) -SPARSE_A2S_OP_1 (-) -SPARSE_A2S_OP_2 (*) -SPARSE_A2S_OP_2 (/) +template <class T, class OP> +MSparse<T> +times_or_divide (const MSparse<T>& a, const T& s, OP op) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + octave_idx_type nz = a.nnz (); + + MSparse<T> r (nr, nc, nz); + + for (octave_idx_type i = 0; i < nz; i++) + { + r.data(i) = op (a.data(i), s); + r.ridx(i) = a.ridx(i); + } + for (octave_idx_type i = 0; i < nc + 1; i++) + r.cidx(i) = a.cidx(i); + r.maybe_compress (true); + return r; +} + +template <typename T> +MSparse<T> +operator * (const MSparse<T>& a, const T& s) +{ + return times_or_divide (a, s, std::multiplies<T> ()); +} + +template <typename T> +MSparse<T> +operator / (const MSparse<T>& a, const T& s) +{ + return times_or_divide (a, s, std::divides<T> ()); +} + // Element by element scalar by MSparse ops. -#define SPARSE_SA2_OP_1(OP) \ - template <class T> \ - MArray<T> \ - operator OP (const T& s, const MSparse<T>& a) \ - { \ - octave_idx_type nr = a.rows (); \ - octave_idx_type nc = a.cols (); \ - \ - MArray<T> r (dim_vector (nr, nc), (s OP 0.0)); \ - \ - for (octave_idx_type j = 0; j < nc; j++) \ - for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) \ - r.elem (a.ridx (i), j) = s OP a.data (i); \ - return r; \ - } +template <class T, class OP> +MArray<T> +plus_or_minus (const T& s, const MSparse<T>& a, OP op) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + + MArray<T> r (dim_vector (nr, nc), op (s, 0.0)); + + for (octave_idx_type j = 0; j < nc; j++) + for (octave_idx_type i = a.cidx(j); i < a.cidx(j+1); i++) + r.elem (a.ridx (i), j) = op (s, a.data (i)); + return r; +} + +template <typename T> +MArray<T> +operator + (const T& s, const MSparse<T>& a) +{ + return plus_or_minus (s, a, std::plus<T> ()); +} + +template <typename T> +MArray<T> +operator - (const T& s, const MSparse<T>& a) +{ + return plus_or_minus (s, a, std::minus<T> ()); +} -#define SPARSE_SA2_OP_2(OP) \ - template <class T> \ - MSparse<T> \ - operator OP (const T& s, const MSparse<T>& a) \ - { \ - octave_idx_type nr = a.rows (); \ - octave_idx_type nc = a.cols (); \ - octave_idx_type nz = a.nnz (); \ - \ - MSparse<T> r (nr, nc, nz); \ - \ - for (octave_idx_type i = 0; i < nz; i++) \ - { \ - r.data(i) = s OP a.data(i); \ - r.ridx(i) = a.ridx(i); \ - } \ - for (octave_idx_type i = 0; i < nc + 1; i++) \ - r.cidx(i) = a.cidx(i); \ - r.maybe_compress (true); \ - return r; \ - } +template <class T, class OP> +MSparse<T> +times_or_divides (const T& s, const MSparse<T>& a, OP op) +{ + octave_idx_type nr = a.rows (); + octave_idx_type nc = a.cols (); + octave_idx_type nz = a.nnz (); + + MSparse<T> r (nr, nc, nz); -SPARSE_SA2_OP_1 (+) -SPARSE_SA2_OP_1 (-) -SPARSE_SA2_OP_2 (*) -SPARSE_SA2_OP_2 (/) + for (octave_idx_type i = 0; i < nz; i++) + { + r.data(i) = op (s, a.data(i)); + r.ridx(i) = a.ridx(i); + } + for (octave_idx_type i = 0; i < nc + 1; i++) + r.cidx(i) = a.cidx(i); + r.maybe_compress (true); + return r; +} + +template <class T> +MSparse<T> +operator * (const T& s, const MSparse<T>& a) +{ + return times_or_divides (s, a, std::multiplies<T> ()); +} + +template <class T> +MSparse<T> +operator / (const T& s, const MSparse<T>& a) +{ + return times_or_divides (s, a, std::divides<T> ()); +} + // Element by element MSparse by MSparse ops. -#define SPARSE_A2A2_OP(OP) \ - template <class T> \ - MSparse<T> \ - operator OP (const MSparse<T>& a, const MSparse<T>& b) \ - { \ - MSparse<T> r; \ - \ - octave_idx_type a_nr = a.rows (); \ - octave_idx_type a_nc = a.cols (); \ - \ - octave_idx_type b_nr = b.rows (); \ - octave_idx_type b_nc = b.cols (); \ - \ - if (a_nr == 1 && a_nc == 1) \ - { \ - if (a.elem(0,0) == 0.) \ - r = OP MSparse<T> (b); \ - else \ - { \ - r = MSparse<T> (b_nr, b_nc, a.data(0) OP 0.); \ - \ - for (octave_idx_type j = 0 ; j < b_nc ; j++) \ - { \ - octave_quit (); \ - octave_idx_type idxj = j * b_nr; \ - for (octave_idx_type i = b.cidx(j) ; i < b.cidx(j+1) ; i++) \ - { \ - octave_quit (); \ - r.data(idxj + b.ridx(i)) = a.data(0) OP b.data(i); \ - } \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (b_nr == 1 && b_nc == 1) \ - { \ - if (b.elem(0,0) == 0.) \ - r = MSparse<T> (a); \ - else \ - { \ - r = MSparse<T> (a_nr, a_nc, 0. OP b.data(0)); \ - \ - for (octave_idx_type j = 0 ; j < a_nc ; j++) \ - { \ - octave_quit (); \ - octave_idx_type idxj = j * a_nr; \ - for (octave_idx_type i = a.cidx(j) ; i < a.cidx(j+1) ; i++) \ - { \ - octave_quit (); \ - r.data(idxj + a.ridx(i)) = a.data(i) OP b.data(0); \ - } \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (a_nr != b_nr || a_nc != b_nc) \ - gripe_nonconformant ("operator " # OP, a_nr, a_nc, b_nr, b_nc); \ - else \ - { \ - r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); \ - \ - octave_idx_type jx = 0; \ - r.cidx (0) = 0; \ - for (octave_idx_type i = 0 ; i < a_nc ; i++) \ - { \ - octave_idx_type ja = a.cidx(i); \ - octave_idx_type ja_max = a.cidx(i+1); \ - bool ja_lt_max= ja < ja_max; \ - \ - octave_idx_type jb = b.cidx(i); \ - octave_idx_type jb_max = b.cidx(i+1); \ - bool jb_lt_max = jb < jb_max; \ - \ - while (ja_lt_max || jb_lt_max ) \ - { \ - octave_quit (); \ - if ((! jb_lt_max) || \ - (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) \ - { \ - r.ridx(jx) = a.ridx(ja); \ - r.data(jx) = a.data(ja) OP 0.; \ - jx++; \ - ja++; \ - ja_lt_max= ja < ja_max; \ - } \ - else if (( !ja_lt_max ) || \ - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) \ - { \ - r.ridx(jx) = b.ridx(jb); \ - r.data(jx) = 0. OP b.data(jb); \ - jx++; \ - jb++; \ - jb_lt_max= jb < jb_max; \ - } \ - else \ - { \ - if ((a.data(ja) OP b.data(jb)) != 0.) \ - { \ - r.data(jx) = a.data(ja) OP b.data(jb); \ - r.ridx(jx) = a.ridx(ja); \ - jx++; \ - } \ - ja++; \ - ja_lt_max= ja < ja_max; \ - jb++; \ - jb_lt_max= jb < jb_max; \ - } \ - } \ - r.cidx(i+1) = jx; \ - } \ - \ - r.maybe_compress (); \ - } \ - \ - return r; \ - } +template <class T, class OP> +MSparse<T> +plus_or_minus (const MSparse<T>& a, const MSparse<T>& b, OP op, + const char* op_name, bool negate) +{ + MSparse<T> r; + + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (a_nr == 1 && a_nc == 1) + { + if (a.elem(0,0) == 0.) + if (negate) + r = -MSparse<T> (b); + else + r = MSparse<T> (b); + else + { + r = MSparse<T> (b_nr, b_nc, op (a.data(0), 0.)); + + for (octave_idx_type j = 0 ; j < b_nc ; j++) + { + octave_quit (); + octave_idx_type idxj = j * b_nr; + for (octave_idx_type i = b.cidx(j) ; i < b.cidx(j+1) ; i++) + { + octave_quit (); + r.data(idxj + b.ridx(i)) = op (a.data(0), b.data(i)); + } + } + r.maybe_compress (); + } + } + else if (b_nr == 1 && b_nc == 1) + { + if (b.elem(0,0) == 0.) + r = MSparse<T> (a); + else + { + r = MSparse<T> (a_nr, a_nc, op (0.0, b.data(0))); + + for (octave_idx_type j = 0 ; j < a_nc ; j++) + { + octave_quit (); + octave_idx_type idxj = j * a_nr; + for (octave_idx_type i = a.cidx(j) ; i < a.cidx(j+1) ; i++) + { + octave_quit (); + r.data(idxj + a.ridx(i)) = op (a.data(i), b.data(0)); + } + } + r.maybe_compress (); + } + } + else if (a_nr != b_nr || a_nc != b_nc) + gripe_nonconformant (op_name, a_nr, a_nc, b_nr, b_nc); + else + { + r = MSparse<T> (a_nr, a_nc, (a.nnz () + b.nnz ())); + + octave_idx_type jx = 0; + r.cidx (0) = 0; + for (octave_idx_type i = 0 ; i < a_nc ; i++) + { + octave_idx_type ja = a.cidx(i); + octave_idx_type ja_max = a.cidx(i+1); + bool ja_lt_max= ja < ja_max; + + octave_idx_type jb = b.cidx(i); + octave_idx_type jb_max = b.cidx(i+1); + bool jb_lt_max = jb < jb_max; + + while (ja_lt_max || jb_lt_max ) + { + octave_quit (); + if ((! jb_lt_max) || + (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) + { + r.ridx(jx) = a.ridx(ja); + r.data(jx) = op (a.data(ja), 0.); + jx++; + ja++; + ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) + { + r.ridx(jx) = b.ridx(jb); + r.data(jx) = op (0., b.data(jb)); + jx++; + jb++; + jb_lt_max= jb < jb_max; + } + else + { + if (op (a.data(ja), b.data(jb)) != 0.) + { + r.data(jx) = op (a.data(ja), b.data(jb)); + r.ridx(jx) = a.ridx(ja); + jx++; + } + ja++; + ja_lt_max= ja < ja_max; + jb++; + jb_lt_max= jb < jb_max; + } + } + r.cidx(i+1) = jx; + } + + r.maybe_compress (); + } + + return r; +} + +template <class T> +MSparse<T> +operator+ (const MSparse<T>& a, const MSparse<T>& b) +{ + return plus_or_minus (a, b, std::plus<T> (), "operator +", false); +} + +template <class T> +MSparse<T> +operator- (const MSparse<T>& a, const MSparse<T>& b) +{ + return plus_or_minus (a, b, std::minus<T> (), "operator -", true); +} + +template <class T> +MSparse<T> +product (const MSparse<T>& a, const MSparse<T>& b) +{ + MSparse<T> r; + + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); + + if (a_nr == 1 && a_nc == 1) + { + if (a.elem(0,0) == 0.) + r = MSparse<T> (b_nr, b_nc); + else + { + r = MSparse<T> (b); + octave_idx_type b_nnz = b.nnz(); + + for (octave_idx_type i = 0 ; i < b_nnz ; i++) + { + octave_quit (); + r.data (i) = a.data(0) * r.data(i); + } + r.maybe_compress (); + } + } + else if (b_nr == 1 && b_nc == 1) + { + if (b.elem(0,0) == 0.) + r = MSparse<T> (a_nr, a_nc); + else + { + r = MSparse<T> (a); + octave_idx_type a_nnz = a.nnz(); -#define SPARSE_A2A2_FCN_1(FCN, OP) \ - template <class T> \ - MSparse<T> \ - FCN (const MSparse<T>& a, const MSparse<T>& b) \ - { \ - MSparse<T> r; \ - \ - octave_idx_type a_nr = a.rows (); \ - octave_idx_type a_nc = a.cols (); \ - \ - octave_idx_type b_nr = b.rows (); \ - octave_idx_type b_nc = b.cols (); \ - \ - if (a_nr == 1 && a_nc == 1) \ - { \ - if (a.elem(0,0) == 0.) \ - r = MSparse<T> (b_nr, b_nc); \ - else \ - { \ - r = MSparse<T> (b); \ - octave_idx_type b_nnz = b.nnz(); \ - \ - for (octave_idx_type i = 0 ; i < b_nnz ; i++) \ - { \ - octave_quit (); \ - r.data (i) = a.data(0) OP r.data(i); \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (b_nr == 1 && b_nc == 1) \ - { \ - if (b.elem(0,0) == 0.) \ - r = MSparse<T> (a_nr, a_nc); \ - else \ - { \ - r = MSparse<T> (a); \ - octave_idx_type a_nnz = a.nnz(); \ - \ - for (octave_idx_type i = 0 ; i < a_nnz ; i++) \ - { \ - octave_quit (); \ - r.data (i) = r.data(i) OP b.data(0); \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (a_nr != b_nr || a_nc != b_nc) \ - gripe_nonconformant (#FCN, a_nr, a_nc, b_nr, b_nc); \ - else \ - { \ - r = MSparse<T> (a_nr, a_nc, (a.nnz () > b.nnz () ? a.nnz () : b.nnz ())); \ - \ - octave_idx_type jx = 0; \ - r.cidx (0) = 0; \ - for (octave_idx_type i = 0 ; i < a_nc ; i++) \ - { \ - octave_idx_type ja = a.cidx(i); \ - octave_idx_type ja_max = a.cidx(i+1); \ - bool ja_lt_max= ja < ja_max; \ - \ - octave_idx_type jb = b.cidx(i); \ - octave_idx_type jb_max = b.cidx(i+1); \ - bool jb_lt_max = jb < jb_max; \ - \ - while (ja_lt_max || jb_lt_max ) \ - { \ - octave_quit (); \ - if ((! jb_lt_max) || \ - (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) \ - { \ - ja++; ja_lt_max= ja < ja_max; \ - } \ - else if (( !ja_lt_max ) || \ - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) \ - { \ - jb++; jb_lt_max= jb < jb_max; \ - } \ - else \ - { \ - if ((a.data(ja) OP b.data(jb)) != 0.) \ - { \ - r.data(jx) = a.data(ja) OP b.data(jb); \ - r.ridx(jx) = a.ridx(ja); \ - jx++; \ - } \ - ja++; ja_lt_max= ja < ja_max; \ - jb++; jb_lt_max= jb < jb_max; \ - } \ - } \ - r.cidx(i+1) = jx; \ - } \ - \ - r.maybe_compress (); \ - } \ - \ - return r; \ - } + for (octave_idx_type i = 0 ; i < a_nnz ; i++) + { + octave_quit (); + r.data (i) = r.data(i) * b.data(0); + } + r.maybe_compress (); + } + } + else if (a_nr != b_nr || a_nc != b_nc) + gripe_nonconformant ("product", a_nr, a_nc, b_nr, b_nc); + else + { + r = MSparse<T> (a_nr, a_nc, (a.nnz () > b.nnz () ? a.nnz () : b.nnz ())); + + octave_idx_type jx = 0; + r.cidx (0) = 0; + for (octave_idx_type i = 0 ; i < a_nc ; i++) + { + octave_idx_type ja = a.cidx(i); + octave_idx_type ja_max = a.cidx(i+1); + bool ja_lt_max= ja < ja_max; + + octave_idx_type jb = b.cidx(i); + octave_idx_type jb_max = b.cidx(i+1); + bool jb_lt_max = jb < jb_max; + + while (ja_lt_max || jb_lt_max ) + { + octave_quit (); + if ((! jb_lt_max) || + (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) + { + ja++; ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) + { + jb++; jb_lt_max= jb < jb_max; + } + else + { + if ((a.data(ja) * b.data(jb)) != 0.) + { + r.data(jx) = a.data(ja) * b.data(jb); + r.ridx(jx) = a.ridx(ja); + jx++; + } + ja++; ja_lt_max= ja < ja_max; + jb++; jb_lt_max= jb < jb_max; + } + } + r.cidx(i+1) = jx; + } + + r.maybe_compress (); + } + + return r; +} + +template <class T> +MSparse<T> +quotient (const MSparse<T>& a, const MSparse<T>& b) +{ + MSparse<T> r; + T Zero = T (); + + octave_idx_type a_nr = a.rows (); + octave_idx_type a_nc = a.cols (); + + octave_idx_type b_nr = b.rows (); + octave_idx_type b_nc = b.cols (); -#define SPARSE_A2A2_FCN_2(FCN, OP) \ - template <class T> \ - MSparse<T> \ - FCN (const MSparse<T>& a, const MSparse<T>& b) \ - { \ - MSparse<T> r; \ - T Zero = T (); \ - \ - octave_idx_type a_nr = a.rows (); \ - octave_idx_type a_nc = a.cols (); \ - \ - octave_idx_type b_nr = b.rows (); \ - octave_idx_type b_nc = b.cols (); \ - \ - if (a_nr == 1 && a_nc == 1) \ - { \ - T val = a.elem (0,0); \ - T fill = val OP T(); \ - if (fill == T()) \ - { \ - octave_idx_type b_nnz = b.nnz(); \ - r = MSparse<T> (b); \ - for (octave_idx_type i = 0 ; i < b_nnz ; i++) \ - r.data (i) = val OP r.data(i); \ - r.maybe_compress (); \ - } \ - else \ - { \ - r = MSparse<T> (b_nr, b_nc, fill); \ - for (octave_idx_type j = 0 ; j < b_nc ; j++) \ - { \ - octave_quit (); \ - octave_idx_type idxj = j * b_nr; \ - for (octave_idx_type i = b.cidx(j) ; i < b.cidx(j+1) ; i++) \ - { \ - octave_quit (); \ - r.data(idxj + b.ridx(i)) = val OP b.data(i); \ - } \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (b_nr == 1 && b_nc == 1) \ - { \ - T val = b.elem (0,0); \ - T fill = T() OP val; \ - if (fill == T()) \ - { \ - octave_idx_type a_nnz = a.nnz(); \ - r = MSparse<T> (a); \ - for (octave_idx_type i = 0 ; i < a_nnz ; i++) \ - r.data (i) = r.data(i) OP val; \ - r.maybe_compress (); \ - } \ - else \ - { \ - r = MSparse<T> (a_nr, a_nc, fill); \ - for (octave_idx_type j = 0 ; j < a_nc ; j++) \ - { \ - octave_quit (); \ - octave_idx_type idxj = j * a_nr; \ - for (octave_idx_type i = a.cidx(j) ; i < a.cidx(j+1) ; i++) \ - { \ - octave_quit (); \ - r.data(idxj + a.ridx(i)) = a.data(i) OP val; \ - } \ - } \ - r.maybe_compress (); \ - } \ - } \ - else if (a_nr != b_nr || a_nc != b_nc) \ - gripe_nonconformant (#FCN, a_nr, a_nc, b_nr, b_nc); \ - else \ - { \ - r = MSparse<T>( a_nr, a_nc, (Zero OP Zero)); \ - \ - for (octave_idx_type i = 0 ; i < a_nc ; i++) \ - { \ - octave_idx_type ja = a.cidx(i); \ - octave_idx_type ja_max = a.cidx(i+1); \ - bool ja_lt_max= ja < ja_max; \ - \ - octave_idx_type jb = b.cidx(i); \ - octave_idx_type jb_max = b.cidx(i+1); \ - bool jb_lt_max = jb < jb_max; \ - \ - while (ja_lt_max || jb_lt_max ) \ - { \ - octave_quit (); \ - if ((! jb_lt_max) || \ - (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) \ - { \ - r.elem (a.ridx(ja),i) = a.data(ja) OP Zero; \ - ja++; ja_lt_max= ja < ja_max; \ - } \ - else if (( !ja_lt_max ) || \ - (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) \ - { \ - r.elem (b.ridx(jb),i) = Zero OP b.data(jb); \ - jb++; jb_lt_max= jb < jb_max; \ - } \ - else \ - { \ - r.elem (a.ridx(ja),i) = a.data(ja) OP b.data(jb); \ - ja++; ja_lt_max= ja < ja_max; \ - jb++; jb_lt_max= jb < jb_max; \ - } \ - } \ - } \ - \ - r.maybe_compress (true); \ - } \ - \ - return r; \ - } + if (a_nr == 1 && a_nc == 1) + { + T val = a.elem (0,0); + T fill = val / T(); + if (fill == T()) + { + octave_idx_type b_nnz = b.nnz(); + r = MSparse<T> (b); + for (octave_idx_type i = 0 ; i < b_nnz ; i++) + r.data (i) = val / r.data(i); + r.maybe_compress (); + } + else + { + r = MSparse<T> (b_nr, b_nc, fill); + for (octave_idx_type j = 0 ; j < b_nc ; j++) + { + octave_quit (); + octave_idx_type idxj = j * b_nr; + for (octave_idx_type i = b.cidx(j) ; i < b.cidx(j+1) ; i++) + { + octave_quit (); + r.data(idxj + b.ridx(i)) = val / b.data(i); + } + } + r.maybe_compress (); + } + } + else if (b_nr == 1 && b_nc == 1) + { + T val = b.elem (0,0); + T fill = T() / val; + if (fill == T()) + { + octave_idx_type a_nnz = a.nnz(); + r = MSparse<T> (a); + for (octave_idx_type i = 0 ; i < a_nnz ; i++) + r.data (i) = r.data(i) / val; + r.maybe_compress (); + } + else + { + r = MSparse<T> (a_nr, a_nc, fill); + for (octave_idx_type j = 0 ; j < a_nc ; j++) + { + octave_quit (); + octave_idx_type idxj = j * a_nr; + for (octave_idx_type i = a.cidx(j) ; i < a.cidx(j+1) ; i++) + { + octave_quit (); + r.data(idxj + a.ridx(i)) = a.data(i) / val; + } + } + r.maybe_compress (); + } + } + else if (a_nr != b_nr || a_nc != b_nc) + gripe_nonconformant ("quotient", a_nr, a_nc, b_nr, b_nc); + else + { + r = MSparse<T>( a_nr, a_nc, (Zero / Zero)); -SPARSE_A2A2_OP (+) -SPARSE_A2A2_OP (-) -SPARSE_A2A2_FCN_1 (product, *) -SPARSE_A2A2_FCN_2 (quotient, /) + for (octave_idx_type i = 0 ; i < a_nc ; i++) + { + octave_idx_type ja = a.cidx(i); + octave_idx_type ja_max = a.cidx(i+1); + bool ja_lt_max= ja < ja_max; + + octave_idx_type jb = b.cidx(i); + octave_idx_type jb_max = b.cidx(i+1); + bool jb_lt_max = jb < jb_max; + + while (ja_lt_max || jb_lt_max ) + { + octave_quit (); + if ((! jb_lt_max) || + (ja_lt_max && (a.ridx(ja) < b.ridx(jb)))) + { + r.elem (a.ridx(ja),i) = a.data(ja) / Zero; + ja++; ja_lt_max= ja < ja_max; + } + else if (( !ja_lt_max ) || + (jb_lt_max && (b.ridx(jb) < a.ridx(ja)) ) ) + { + r.elem (b.ridx(jb),i) = Zero / b.data(jb); + jb++; jb_lt_max= jb < jb_max; + } + else + { + r.elem (a.ridx(ja),i) = a.data(ja) / b.data(jb); + ja++; ja_lt_max= ja < ja_max; + jb++; jb_lt_max= jb < jb_max; + } + } + } + + r.maybe_compress (true); + } + + return r; +} + + // Unary MSparse ops.
--- a/liboctave/MSparse.h +++ b/liboctave/MSparse.h @@ -65,6 +65,8 @@ explicit MSparse (octave_idx_type r, octave_idx_type c, T val) : Sparse<T> (r, c, val) { } + explicit MSparse (const PermMatrix& a) : Sparse<T>(a) { } + MSparse (octave_idx_type r, octave_idx_type c, octave_idx_type num_nz) : Sparse<T> (r, c, num_nz) { } ~MSparse (void) { }
--- a/liboctave/Makefile.am +++ b/liboctave/Makefile.am @@ -3,17 +3,17 @@ # Copyright (C) 1993-2011 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 # <http://www.gnu.org/licenses/>. @@ -188,6 +188,7 @@ base-dae.h \ base-de.h \ base-min.h \ + bsxfun.h \ byte-swap.h \ caseless-str.h \ cmd-edit.h \ @@ -491,21 +492,6 @@ LIBOCT_READLINE_SOURCES = $(LIBOCT_READLINE_CXX_SOURCES) $(LIBOCT_READLINE_C_SOURCES) -LINK_DEPS = \ - $(RLD_FLAG) \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la \ - $(SPARSE_XLIBS) \ - $(ARPACK_LIBS) \ - $(QRUPDATE_LIBS) \ - $(FFTW_XLIBS) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(READLINE_LIBS) $(TERM_LIBS) \ - $(LIBGLOB) $(REGEX_LIBS) $(DL_LIBS) \ - $(FLIBS) \ - $(PTHREAD_LIBS) $(LIBS) - liboctave_la_SOURCES = \ $(LIBOCTAVE_CXX_SOURCES) \ $(LIBOCTAVE_C_SOURCES) \ @@ -516,7 +502,11 @@ nodist_liboctave_la_SOURCES = \ $(BUILT_LIBOCTAVE_CXX_SOURCES) -liboctave_la_LIBADD = $(LINK_DEPS) +include link-deps.mk + +liboctave_la_LIBADD = \ + ../libcruft/libcruft.la \ + $(LIBOCTAVE_LINK_DEPS) liboctave_la_CPPFLAGS = \ @OCTAVE_DLL_DEFS@ \ @@ -537,10 +527,7 @@ -version-info $(liboctave_version_info) \ $(NO_UNDEFINED_LDFLAG) \ -bindir $(bindir) \ - $(SPARSE_XLDFLAGS) \ - $(ARPACK_LDFLAGS) \ - $(QRUPDATE_LDFLAGS) \ - $(FFTW_XLDFLAGS) + $(LIBOCTAVE_LINK_OPTS) octinclude_HEADERS = \ $(INCS) \
--- a/liboctave/Quad-opts.in +++ b/liboctave/Quad-opts.in @@ -1,17 +1,17 @@ # Copyright (C) 2002-2011 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 # <http://www.gnu.org/licenses/>. @@ -33,7 +33,7 @@ NAME = "relative tolerance" DOC_ITEM Non-negative relative tolerance. If the absolute tolerance is zero, -the relative tolerance must be greater than or equal to +the relative tolerance must be greater than or equal to @w{@code{max (50*eps, 0.5e-28)}}. END_DOC_ITEM @@ -45,7 +45,7 @@ OPTION NAME = "single precision absolute tolerance" DOC_ITEM -Absolute tolerance for single precision; may be zero for pure relative +Absolute tolerance for single precision; may be zero for pure relative error test. END_DOC_ITEM @@ -58,7 +58,7 @@ NAME = "single precision relative tolerance" DOC_ITEM Non-negative relative tolerance for single precision. If the absolute -tolerance is zero, the relative tolerance must be greater than or equal to +tolerance is zero, the relative tolerance must be greater than or equal to @w{@code{max (50*eps, 0.5e-28)}}. END_DOC_ITEM TYPE = "float"
--- a/liboctave/Sparse-op-defs.h +++ b/liboctave/Sparse-op-defs.h @@ -1119,7 +1119,7 @@ gripe_nonconformant (#F, m1_nr, m1_nc, m2_nr, m2_nc); \ else \ { \ - if (do_mx_check (m1, mx_inline_all_finite)) \ + if (do_mx_check (m1, mx_inline_all_finite<M1::element_type>)) \ { \ /* Sparsity pattern is preserved. */ \ octave_idx_type m2_nz = m2.nnz (); \ @@ -1335,12 +1335,12 @@ } // sm .* m preserves sparsity if m contains no Infs nor Nans. -#define SPARSE_SMM_BIN_OP_2_CHECK_product \ - do_mx_check (m2, mx_inline_all_finite) +#define SPARSE_SMM_BIN_OP_2_CHECK_product(ET) \ + do_mx_check (m2, mx_inline_all_finite<ET>) // sm ./ m preserves sparsity if m contains no NaNs or zeros. -#define SPARSE_SMM_BIN_OP_2_CHECK_quotient \ - ! do_mx_check (m2, mx_inline_any_nan) && m2.nnz () == m2.numel () +#define SPARSE_SMM_BIN_OP_2_CHECK_quotient(ET) \ + ! do_mx_check (m2, mx_inline_any_nan<ET>) && m2.nnz () == m2.numel () #define SPARSE_SMM_BIN_OP_2(R, F, OP, M1, M2) \ R \ @@ -1360,7 +1360,7 @@ gripe_nonconformant (#F, m1_nr, m1_nc, m2_nr, m2_nc); \ else \ { \ - if (SPARSE_SMM_BIN_OP_2_CHECK_ ## F) \ + if (SPARSE_SMM_BIN_OP_2_CHECK_ ## F(M2::element_type)) \ { \ /* Sparsity pattern is preserved. */ \ octave_idx_type m1_nz = m1.nnz (); \
--- a/liboctave/Sparse-perm-op-defs.h +++ b/liboctave/Sparse-perm-op-defs.h @@ -42,14 +42,14 @@ for (octave_idx_type j = 0; j < nc; j++) { octave_quit (); - + OCTAVE_LOCAL_BUFFER (octave_idx_type, sidx, r.xcidx(j+1) - r.xcidx(j)); for (octave_idx_type i = r.xcidx(j), ii = 0; i < r.xcidx(j+1); i++) { sidx[ii++]=i; r.xridx (i) = pcol[a.ridx (i)]; } - sort.sort (r.xridx() + r.xcidx(j), sidx, r.xcidx(j+1) - r.xcidx(j)); + sort.sort (r.xridx() + r.xcidx(j), sidx, r.xcidx(j+1) - r.xcidx(j)); for (octave_idx_type i = r.xcidx(j), ii = 0; i < r.xcidx(j+1); i++) r.xdata(i) = a.data (sidx[ii++]); }
--- a/liboctave/Sparse.cc +++ b/liboctave/Sparse.cc @@ -50,6 +50,34 @@ #include "oct-spparms.h" #include "mx-inlines.cc" +#include "PermMatrix.h" + +template <class T> +Sparse<T>::Sparse (const PermMatrix& a) + : rep (new typename Sparse<T>::SparseRep (a.rows (), a.cols (), a.rows ())), + dimensions (dim_vector (a.rows (), a.cols())) +{ + octave_idx_type n = a.rows (); + for (octave_idx_type i = 0; i <= n; i++) + cidx (i) = i; + + const Array<octave_idx_type> pv = a.pvec (); + + if (a.is_row_perm ()) + { + for (octave_idx_type i = 0; i < n; i++) + ridx (pv (i)) = i; + } + else + { + for (octave_idx_type i = 0; i < n; i++) + ridx (i) = pv (i); + } + + for (octave_idx_type i = 0; i < n; i++) + data (i) = 1.0; +} + template <class T> T& Sparse<T>::SparseRep::elem (octave_idx_type _r, octave_idx_type _c)
--- a/liboctave/Sparse.h +++ b/liboctave/Sparse.h @@ -41,6 +41,7 @@ #include "oct-mem.h" class idx_vector; +class PermMatrix; // Two dimensional sparse class. Handles the reference counting for // all the derived classes. @@ -195,6 +196,10 @@ : rep (new typename Sparse<T>::SparseRep (nr, nc, nz)), dimensions (dim_vector (nr, nc)) { } + // Both SparseMatrix and SparseBoolMatrix need this ctor, and this + // is their only common ancestor. + explicit Sparse (const PermMatrix& a); + // Type conversion case. Preserves capacity (). template <class U> Sparse (const Sparse<U>& a)
--- a/liboctave/base-lu.cc +++ b/liboctave/base-lu.cc @@ -173,14 +173,18 @@ bool base_lu<lu_type>::regular (void) const { + bool retval = true; + octave_idx_type k = std::min (a_fact.rows (), a_fact.columns ()); - bool retval = true; + for (octave_idx_type i = 0; i < k; i++) - if (a_fact(i, i) == lu_elt_type ()) - { - retval = false; - break; - } + { + if (a_fact(i, i) == lu_elt_type ()) + { + retval = false; + break; + } + } - return true; + return retval; }
--- a/liboctave/base-qr.cc +++ b/liboctave/base-qr.cc @@ -62,15 +62,19 @@ bool base_qr<qr_type>::regular (void) const { + bool retval = true; + octave_idx_type k = std::min (r.rows (), r.columns ()); - bool retval = true; + for (octave_idx_type i = 0; i < k; i++) - if (r(i, i) == qr_elt_type ()) - { - retval = false; - break; - } + { + if (r(i, i) == qr_elt_type ()) + { + retval = false; + break; + } + } - return true; + return retval; }
--- a/liboctave/boolNDArray.cc +++ b/liboctave/boolNDArray.cc @@ -40,7 +40,7 @@ boolNDArray boolNDArray::operator ! (void) const { - return do_mx_unary_op<bool> (*this, mx_inline_not); + return do_mx_unary_op<bool, bool> (*this, mx_inline_not); } boolNDArray& @@ -149,7 +149,8 @@ if (a.is_shared ()) a = mx_el_and (a, b); else - do_mm_inplace_op<bool, bool> (a, b, mx_inline_and2, "operator &="); + do_mm_inplace_op<bool, bool> (a, b, mx_inline_and2, mx_inline_and2, + "operator &="); return a; } @@ -160,7 +161,8 @@ if (a.is_shared ()) a = mx_el_or (a, b); else - do_mm_inplace_op<bool, bool> (a, b, mx_inline_or2, "operator |="); + do_mm_inplace_op<bool, bool> (a, b, mx_inline_or2, mx_inline_or2, + "operator |="); return a; }
--- a/liboctave/boolSparse.h +++ b/liboctave/boolSparse.h @@ -57,6 +57,8 @@ explicit SparseBoolMatrix (const boolNDArray& a) : Sparse<bool> (a) { } + explicit SparseBoolMatrix (const PermMatrix& a) : Sparse<bool> (a) { }; + SparseBoolMatrix (const Array<bool>& a, const idx_vector& r, const idx_vector& c, octave_idx_type nr = -1, octave_idx_type nc = -1, bool sum_terms = true,
--- a/liboctave/bsxfun-decl.h +++ b/liboctave/bsxfun-decl.h @@ -42,6 +42,12 @@ BSXFUN_OP_DECL (min, ARRAY, API) \ BSXFUN_OP_DECL (max, ARRAY, API) +#define BSXFUN_MIXED_INT_DECLS(INT_TYPE, API) \ + BSXFUN_OP2_DECL (pow, INT_TYPE, INT_TYPE, NDArray, API) \ + BSXFUN_OP2_DECL (pow, INT_TYPE, INT_TYPE, FloatNDArray, API) \ + BSXFUN_OP2_DECL (pow, INT_TYPE, NDArray, INT_TYPE, API) \ + BSXFUN_OP2_DECL (pow, INT_TYPE, FloatNDArray, INT_TYPE, API) + #define BSXFUN_STDREL_DECLS(ARRAY, API) \ BSXFUN_REL_DECL (eq, ARRAY, API) \ BSXFUN_REL_DECL (ne, ARRAY, API) \
--- a/liboctave/bsxfun-defs.cc +++ b/liboctave/bsxfun-defs.cc @@ -69,8 +69,7 @@ R *rvec = retval.fortran_vec (); // Fold the common leading dimensions. - int start; - octave_idx_type ldr = 1; + octave_idx_type start, ldr = 1; for (start = 0; start < nd; start++) { if (dvx(start) != dvy(start)) @@ -98,7 +97,7 @@ } dim_vector cdvx = dvx.cumulative (), cdvy = dvy.cumulative (); // Nullify singleton dims to achieve a spread effect. - for (int i = std::max (start, 1); i < nd; i++) + for (int i = std::max (start, octave_idx_type (1)); i < nd; i++) { if (dvx(i) == 1) cdvx(i-1) = 0; @@ -134,6 +133,77 @@ return retval; } +template <class R, class X> +void +do_inplace_bsxfun_op (Array<R>& r, const Array<X>& x, + void (*op_vv) (size_t, R *, const X *), + void (*op_vs) (size_t, R *, X)) +{ + dim_vector dvr = r.dims (), dvx = x.dims (); + octave_idx_type nd = r.ndims (); + dvx.redim (nd); + + const X* xvec = x.fortran_vec (); + R* rvec = r.fortran_vec (); + + // Fold the common leading dimensions. + octave_idx_type start, ldr = 1; + for (start = 0; start < nd; start++) + { + if (dvr(start) != dvx(start)) + break; + ldr *= dvr(start); + } + + if (r.is_empty ()) + ; // do nothing + else if (start == nd) + op_vv (r.numel (), rvec, xvec); + else + { + // Determine the type of the low-level loop. + bool xsing = false; + if (ldr == 1) + { + xsing = dvx(start) == 1; + if (xsing) + { + ldr *= dvr(start) * dvx(start); + start++; + } + } + + dim_vector cdvx = dvx.cumulative (); + // Nullify singleton dims to achieve a spread effect. + for (int i = std::max (start, octave_idx_type (1)); i < nd; i++) + { + if (dvx(i) == 1) + cdvx(i-1) = 0; + } + + octave_idx_type niter = dvr.numel (start); + // The index array. + OCTAVE_LOCAL_BUFFER_INIT (octave_idx_type, idx, nd, 0); + for (octave_idx_type iter = 0; iter < niter; iter++) + { + octave_quit (); + + // Compute indices. + // FIXME: performance impact noticeable? + octave_idx_type xidx = cdvx.cum_compute_index (idx); + octave_idx_type ridx = dvr.compute_index (idx); + + // Apply the low-level loop. + if (xsing) + op_vs (ldr, rvec + ridx, xvec[xidx]); + else + op_vv (ldr, rvec + ridx, xvec + xidx); + + dvr.increment_index (idx + start, start); + } + } +} + #define BSXFUN_OP_DEF(OP, ARRAY) \ ARRAY bsxfun_ ## OP (const ARRAY& x, const ARRAY& y) @@ -174,4 +244,11 @@ BSXFUN_REL_DEF_MXLOOP (gt, ARRAY, mx_inline_gt) \ BSXFUN_REL_DEF_MXLOOP (ge, ARRAY, mx_inline_ge) +//For bsxfun power with mixed integer/float types +#define BSXFUN_POW_MIXED_MXLOOP(INT_TYPE) \ + BSXFUN_OP2_DEF_MXLOOP (pow, INT_TYPE, INT_TYPE, NDArray, mx_inline_pow) \ + BSXFUN_OP2_DEF_MXLOOP (pow, INT_TYPE, INT_TYPE, FloatNDArray, mx_inline_pow)\ + BSXFUN_OP2_DEF_MXLOOP (pow, INT_TYPE, NDArray, INT_TYPE, mx_inline_pow) \ + BSXFUN_OP2_DEF_MXLOOP (pow, INT_TYPE, FloatNDArray, INT_TYPE, mx_inline_pow) + #endif
new file mode 100644 --- /dev/null +++ b/liboctave/bsxfun.h @@ -0,0 +1,68 @@ +/* + +Copyright (C) 2011 Jordi Gutiérrez Hermoso <jordigh@octave.org> + +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 +<http://www.gnu.org/licenses/>. + +*/ +#if !defined (bsxfun_h) +#define bsxfun_h 1 + +#include <algorithm> + +#include "Array.h" +#include "dim-vector.h" + +inline +bool +is_valid_bsxfun (const dim_vector& dx, const dim_vector& dy) +{ + for (int i = 0; i < std::min (dx.length (), dy.length ()); i++) + { + octave_idx_type xk = dx(i), yk = dy(i); + // Check the three conditions for valid bsxfun dims + if (! ( (xk == yk) || (xk == 1 && yk > 1) || (xk > 1 && yk == 1))) + return false; + } + return true; +} + +// since we can't change the size of the assigned-to matrix, we cannot +// apply singleton expansion to it, so the conditions to check are +// different here. +inline +bool +is_valid_inplace_bsxfun (const dim_vector& dr, const dim_vector& dx) +{ + octave_idx_type drl = dr.length (), dxl = dx.length (); + if (drl < dxl) + return false; + + for (int i = 0; i < drl; i++) + { + octave_idx_type rk = dr(i), xk = dx(i); + + // Only two valid canditions to check; can't stretch rk + if (! ( (rk == xk) || (rk > 1 && xk == 1))) + return false; + } + return true; +} + +#include "bsxfun-defs.cc" + +#endif
--- a/liboctave/chMatrix.cc +++ b/liboctave/chMatrix.cc @@ -74,8 +74,8 @@ elem (0, i) = s[i]; } -charMatrix::charMatrix (const string_vector& s) - : Array<char> (dim_vector (s.length (), s.max_length ()), 0) +charMatrix::charMatrix (const string_vector& s, char fill_value) + : Array<char> (dim_vector (s.length (), s.max_length ()), fill_value) { octave_idx_type nr = rows ();
--- a/liboctave/chMatrix.h +++ b/liboctave/chMatrix.h @@ -62,7 +62,7 @@ charMatrix (const std::string& s); - charMatrix (const string_vector& s); + charMatrix (const string_vector& s, char fill_value = '\0'); charMatrix& operator = (const charMatrix& a) {
--- a/liboctave/dMatrix.cc +++ b/liboctave/dMatrix.cc @@ -1239,6 +1239,9 @@ { DET retval (1.0); + info = 0; + rcon = 0.0; + octave_idx_type nr = rows (); octave_idx_type nc = cols (); @@ -1267,7 +1270,6 @@ Matrix atmp = *this; double *tmp_data = atmp.fortran_vec (); - info = 0; double anorm = 0; if (calc_cond) anorm = xnorm (*this, 1); @@ -2655,6 +2657,13 @@ } bool +Matrix::any_element_is_positive (bool neg_zero) const +{ + return (neg_zero ? test_all (xpositive_sign) + : do_mx_check<double> (*this, mx_inline_any_positive)); +} + +bool Matrix::any_element_is_nan (void) const { return do_mx_check<double> (*this, mx_inline_any_nan);
--- a/liboctave/dMatrix.h +++ b/liboctave/dMatrix.h @@ -296,6 +296,7 @@ // other operations bool any_element_is_negative (bool = false) const; + bool any_element_is_positive (bool = false) const; bool any_element_is_nan (void) const; bool any_element_is_inf_or_nan (void) const; bool any_element_not_one_or_zero (void) const;
--- a/liboctave/dNDArray.cc +++ b/liboctave/dNDArray.cc @@ -554,6 +554,13 @@ } bool +NDArray::any_element_is_positive (bool neg_zero) const +{ + return (neg_zero ? test_all (xpositive_sign) + : do_mx_check<double> (*this, mx_inline_any_positive)); +} + +bool NDArray::any_element_is_nan (void) const { return do_mx_check<double> (*this, mx_inline_any_nan); @@ -925,3 +932,5 @@ BSXFUN_OP_DEF_MXLOOP (pow, NDArray, mx_inline_pow) BSXFUN_OP2_DEF_MXLOOP (pow, ComplexNDArray, ComplexNDArray, NDArray, mx_inline_pow) +BSXFUN_OP2_DEF_MXLOOP (pow, ComplexNDArray, NDArray, + ComplexNDArray, mx_inline_pow)
--- a/liboctave/dNDArray.h +++ b/liboctave/dNDArray.h @@ -75,6 +75,7 @@ boolNDArray operator ! (void) const; bool any_element_is_negative (bool = false) const; + bool any_element_is_positive (bool = false) const; bool any_element_is_nan (void) const; bool any_element_is_inf_or_nan (void) const; bool any_element_not_one_or_zero (void) const; @@ -185,5 +186,7 @@ BSXFUN_OP_DECL (pow, NDArray, OCTAVE_API) BSXFUN_OP2_DECL (pow, ComplexNDArray, ComplexNDArray, NDArray, OCTAVE_API) +BSXFUN_OP2_DECL (pow, ComplexNDArray, NDArray, + ComplexNDArray, OCTAVE_API) #endif
--- a/liboctave/dSparse.cc +++ b/liboctave/dSparse.cc @@ -180,29 +180,6 @@ cidx(i) = j; } -SparseMatrix::SparseMatrix (const PermMatrix& a) - : MSparse<double> (a.rows (), a.cols (), a.rows ()) -{ - octave_idx_type n = a.rows (); - for (octave_idx_type i = 0; i <= n; i++) - cidx (i) = i; - const Array<octave_idx_type> pv = a.pvec (); - - if (a.is_row_perm ()) - { - for (octave_idx_type i = 0; i < n; i++) - ridx (pv (i)) = i; - } - else - { - for (octave_idx_type i = 0; i < n; i++) - ridx (i) = pv (i); - } - - for (octave_idx_type i = 0; i < n; i++) - data (i) = 1.0; -} - bool SparseMatrix::operator == (const SparseMatrix& a) const {
--- a/liboctave/dSparse.h +++ b/liboctave/dSparse.h @@ -82,7 +82,7 @@ explicit SparseMatrix (const DiagMatrix& a); - explicit SparseMatrix (const PermMatrix& a); + explicit SparseMatrix (const PermMatrix& a) : MSparse<double>(a) { } SparseMatrix (octave_idx_type r, octave_idx_type c, octave_idx_type num_nz) : MSparse<double> (r, c, num_nz) { }
--- a/liboctave/fCColVector.cc +++ b/liboctave/fCColVector.cc @@ -242,7 +242,7 @@ FloatComplexColumnVector conj (const FloatComplexColumnVector& a) { - return do_mx_unary_map<FloatComplex, FloatComplex, std::conj> (a); + return do_mx_unary_map<FloatComplex, FloatComplex, std::conj<float> > (a); } // resize is the destructive equivalent for this one
--- a/liboctave/fCMatrix.cc +++ b/liboctave/fCMatrix.cc @@ -923,7 +923,7 @@ FloatComplexMatrix conj (const FloatComplexMatrix& a) { - return do_mx_unary_map<FloatComplex, FloatComplex, std::conj> (a); + return do_mx_unary_map<FloatComplex, FloatComplex, std::conj<float> > (a); } // resize is the destructive equivalent for this one @@ -1567,6 +1567,9 @@ { FloatComplexDET retval (1.0); + info = 0; + rcon = 0.0; + octave_idx_type nr = rows (); octave_idx_type nc = cols (); @@ -1595,7 +1598,6 @@ FloatComplexMatrix atmp = *this; FloatComplex *tmp_data = atmp.fortran_vec (); - info = 0; float anorm = 0; if (calc_cond) anorm = xnorm (*this, 1); @@ -3791,7 +3793,7 @@ octave_idx_type lda = a.rows (), tda = a.cols (); octave_idx_type ldb = b.rows (), tdb = b.cols (); - retval = FloatComplexMatrix (a_nr, b_nc); + retval = FloatComplexMatrix (a_nr, b_nc, 0.0); FloatComplex *c = retval.fortran_vec (); if (b_nc == 1 && a_nr == 1)
--- a/liboctave/fCNDArray.cc +++ b/liboctave/fCNDArray.cc @@ -757,7 +757,7 @@ FloatComplexNDArray conj (const FloatComplexNDArray& a) { - return do_mx_unary_map<FloatComplex, FloatComplex, std::conj> (a); + return do_mx_unary_map<FloatComplex, FloatComplex, std::conj<float> > (a); } FloatComplexNDArray&
--- a/liboctave/fCRowVector.cc +++ b/liboctave/fCRowVector.cc @@ -234,7 +234,7 @@ FloatComplexRowVector conj (const FloatComplexRowVector& a) { - return do_mx_unary_map<FloatComplex, FloatComplex, std::conj> (a); + return do_mx_unary_map<FloatComplex, FloatComplex, std::conj<float> > (a); } // resize is the destructive equivalent for this one
--- a/liboctave/fCRowVector.h +++ b/liboctave/fCRowVector.h @@ -129,9 +129,9 @@ // row vector by column vector -> scalar -FloatComplex operator * (const FloatComplexRowVector& a, const ColumnVector& b); +FloatComplex OCTAVE_API operator * (const FloatComplexRowVector& a, const ColumnVector& b); -FloatComplex operator * (const FloatComplexRowVector& a, const FloatComplexColumnVector& b); +FloatComplex OCTAVE_API operator * (const FloatComplexRowVector& a, const FloatComplexColumnVector& b); // other operations
--- a/liboctave/fMatrix.cc +++ b/liboctave/fMatrix.cc @@ -1239,6 +1239,9 @@ { FloatDET retval (1.0); + info = 0; + rcon = 0.0; + octave_idx_type nr = rows (); octave_idx_type nc = cols (); @@ -1267,7 +1270,6 @@ FloatMatrix atmp = *this; float *tmp_data = atmp.fortran_vec (); - info = 0; float anorm = 0; if (calc_cond) anorm = xnorm (*this, 1); @@ -2655,6 +2657,13 @@ } bool +FloatMatrix::any_element_is_positive (bool neg_zero) const +{ + return (neg_zero ? test_all (xpositive_sign) + : do_mx_check<float> (*this, mx_inline_any_positive)); +} + +bool FloatMatrix::any_element_is_nan (void) const { return do_mx_check<float> (*this, mx_inline_any_nan);
--- a/liboctave/fMatrix.h +++ b/liboctave/fMatrix.h @@ -296,6 +296,7 @@ // other operations bool any_element_is_negative (bool = false) const; + bool any_element_is_positive (bool = false) const; bool any_element_is_nan (void) const; bool any_element_is_inf_or_nan (void) const; bool any_element_not_one_or_zero (void) const;
--- a/liboctave/fNDArray.cc +++ b/liboctave/fNDArray.cc @@ -514,6 +514,13 @@ } bool +FloatNDArray::any_element_is_positive (bool neg_zero) const +{ + return (neg_zero ? test_all (xpositive_sign) + : do_mx_check<float> (*this, mx_inline_any_positive)); +} + +bool FloatNDArray::any_element_is_nan (void) const { return do_mx_check<float> (*this, mx_inline_any_nan); @@ -885,3 +892,5 @@ BSXFUN_OP_DEF_MXLOOP (pow, FloatNDArray, mx_inline_pow) BSXFUN_OP2_DEF_MXLOOP (pow, FloatComplexNDArray, FloatComplexNDArray, FloatNDArray, mx_inline_pow) +BSXFUN_OP2_DEF_MXLOOP (pow, FloatComplexNDArray, FloatNDArray, + FloatComplexNDArray, mx_inline_pow)
--- a/liboctave/fNDArray.h +++ b/liboctave/fNDArray.h @@ -72,6 +72,7 @@ boolNDArray operator ! (void) const; bool any_element_is_negative (bool = false) const; + bool any_element_is_positive (bool = false) const; bool any_element_is_nan (void) const; bool any_element_is_inf_or_nan (void) const; bool any_element_not_one_or_zero (void) const; @@ -182,5 +183,7 @@ BSXFUN_OP_DECL (pow, FloatNDArray, OCTAVE_API) BSXFUN_OP2_DECL (pow, FloatComplexNDArray, FloatComplexNDArray, FloatNDArray, OCTAVE_API) +BSXFUN_OP2_DECL (pow, FloatComplexNDArray, FloatNDArray, + FloatComplexNDArray, OCTAVE_API) #endif
--- a/liboctave/idx-vector.cc +++ b/liboctave/idx-vector.cc @@ -27,7 +27,6 @@ #endif #include <cstdlib> -#include <memory> #include <iostream>
--- a/liboctave/idx-vector.h +++ b/liboctave/idx-vector.h @@ -29,6 +29,7 @@ #include <algorithm> #include <iosfwd> +#include <memory> #include "dim-vector.h" #include "oct-inttypes.h" @@ -63,6 +64,8 @@ class_mask }; + template<class T> friend class std::auto_ptr; + private: class OCTAVE_API idx_base_rep
--- a/liboctave/int16NDArray.cc +++ b/liboctave/int16NDArray.cc @@ -54,3 +54,7 @@ BSXFUN_STDOP_DEFS_MXLOOP (int16NDArray) BSXFUN_STDREL_DEFS_MXLOOP (int16NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, int16NDArray, mx_inline_pow) + +BSXFUN_POW_MIXED_MXLOOP (int16NDArray)
--- a/liboctave/int16NDArray.h +++ b/liboctave/int16NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (int16NDArray, octave_int16, OCTAVE_API) BSXFUN_STDOP_DECLS (int16NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(int16NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (int16NDArray, OCTAVE_API) #endif
--- a/liboctave/int32NDArray.cc +++ b/liboctave/int32NDArray.cc @@ -54,3 +54,6 @@ BSXFUN_STDOP_DEFS_MXLOOP (int32NDArray) BSXFUN_STDREL_DEFS_MXLOOP (int32NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, int32NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (int32NDArray)
--- a/liboctave/int32NDArray.h +++ b/liboctave/int32NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (int32NDArray, octave_int32, OCTAVE_API) BSXFUN_STDOP_DECLS (int32NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(int32NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (int32NDArray, OCTAVE_API) #endif
--- a/liboctave/int64NDArray.cc +++ b/liboctave/int64NDArray.cc @@ -54,3 +54,7 @@ BSXFUN_STDOP_DEFS_MXLOOP (int64NDArray) BSXFUN_STDREL_DEFS_MXLOOP (int64NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, int64NDArray, mx_inline_pow) + +BSXFUN_POW_MIXED_MXLOOP (int64NDArray)
--- a/liboctave/int64NDArray.h +++ b/liboctave/int64NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (int64NDArray, octave_int64, OCTAVE_API) BSXFUN_STDOP_DECLS (int64NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(int64NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (int64NDArray, OCTAVE_API) #endif
--- a/liboctave/int8NDArray.cc +++ b/liboctave/int8NDArray.cc @@ -54,3 +54,6 @@ BSXFUN_STDOP_DEFS_MXLOOP (int8NDArray) BSXFUN_STDREL_DEFS_MXLOOP (int8NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, int8NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (int8NDArray)
--- a/liboctave/int8NDArray.h +++ b/liboctave/int8NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (int8NDArray, octave_int8, OCTAVE_API) BSXFUN_STDOP_DECLS (int8NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(int8NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (int8NDArray, OCTAVE_API) #endif
--- a/liboctave/kpse.cc +++ b/liboctave/kpse.cc @@ -49,8 +49,8 @@ #include <fcntl.h> #include <dirent.h> #elif defined(WIN32) +#ifndef _MSC_VER #define __STDC__ 1 -#ifndef _MSC_VER #include "win32lib.h" #endif #endif /* not WIN32 */
new file mode 100644 --- /dev/null +++ b/liboctave/link-deps.mk @@ -0,0 +1,27 @@ +include ../libcruft/link-deps.mk + +LIBOCTAVE_LINK_DEPS = \ + $(SPARSE_XLIBS) \ + $(ARPACK_LIBS) \ + $(QRUPDATE_LIBS) \ + $(FFTW_XLIBS) \ + $(LAPACK_LIBS) \ + $(BLAS_LIBS) \ + $(READLINE_LIBS) \ + $(TERM_LIBS) \ + $(LIBGLOB) \ + $(REGEX_LIBS) \ + $(DL_LIBS) \ + $(PTHREAD_LIBS) \ + $(LIBS) + +LIBOCTAVE_LINK_OPTS = \ + $(SPARSE_XLDFLAGS) \ + $(ARPACK_LDFLAGS) \ + $(QRUPDATE_LDFLAGS) \ + $(FFTW_XLDFLAGS) + +if AMCOND_LINK_ALL_DEPS + LIBOCTAVE_LINK_DEPS += $(LIBCRUFT_LINK_DEPS) + LIBOCTAVE_LINK_OPTS += $(LIBCRUFT_LINK_OPTS) +endif
--- a/liboctave/lo-cieee.c +++ b/liboctave/lo-cieee.c @@ -47,11 +47,6 @@ #define HAVE_FINITE 1 #endif -#if ! defined (HAVE_COPYSIGN) && defined (HAVE__COPYSIGN) -#define copysign _copysign -#define HAVE_COPYSIGN 1 -#endif - #if defined (_AIX) && defined (__GNUG__) #undef finite #define finite(x) ((x) < DBL_MAX && (x) > -DBL_MAX)
--- a/liboctave/lo-mappers.cc +++ b/liboctave/lo-mappers.cc @@ -48,6 +48,12 @@ return gnulib::trunc (x); } +double +xcopysign (double x, double y) +{ + return gnulib::copysign (x, y); +} + double xfloor (double x) { return gnulib::floor (x); @@ -268,6 +274,12 @@ } float +xcopysign (float x, float y) +{ + return gnulib::copysignf (x, y); +} + +float xround (float x) { return gnulib::round (x);
--- a/liboctave/lo-mappers.h +++ b/liboctave/lo-mappers.h @@ -31,7 +31,7 @@ // Double Precision extern OCTAVE_API double xtrunc (double x); -inline double xcopysign (double x, double y) { return copysign (x, y); } +extern OCTAVE_API double xcopysign (double x, double y); inline double xceil (double x) { return ceil (x); } extern OCTAVE_API double xfloor (double x); inline double arg (double x) { return atan2 (0.0, x); } @@ -117,7 +117,7 @@ // Single Precision extern OCTAVE_API float xtrunc (float x); -inline float xcopysign (float x, float y) { return copysignf (x, y); } +extern OCTAVE_API float xcopysign (float x, float y); inline float xceil (float x) { return ceilf (x); } inline float xfloor (float x) { return floorf (x); } inline float arg (float x) { return atan2f (0.0f, x); } @@ -218,6 +218,10 @@ extern OCTAVE_API bool xnegative_sign (double x); extern OCTAVE_API bool xnegative_sign (float x); +// Test for positive sign. +inline bool xpositive_sign (double x) { return ! xnegative_sign (x); } +inline bool xpositive_sign (float x) { return ! xnegative_sign (x); } + // Some old rounding functions. extern OCTAVE_API octave_idx_type NINTbig (double x); @@ -227,7 +231,6 @@ extern OCTAVE_API int NINT (float x); template <typename T> -OCTAVE_API T X_NINT (T x) { @@ -305,7 +308,6 @@ } template <typename T> -OCTAVE_API T xmod (T x, T y) { @@ -353,7 +355,6 @@ } template <typename T> -OCTAVE_API T xrem (T x, T y) {
--- a/liboctave/lo-utils.cc +++ b/liboctave/lo-utils.cc @@ -196,44 +196,57 @@ } static inline double -read_inf_nan_na (std::istream& is, char c, char sign = '+') +read_inf_nan_na (std::istream& is, char c0, char sign = '+') { double d = 0.0; - switch (c) + switch (c0) { case 'i': case 'I': { - c = is.get (); - if (c == 'n' || c == 'N') + char c1 = is.get (); + if (c1 == 'n' || c1 == 'N') { - c = is.get (); - if (c == 'f' || c == 'F') + char c2 = is.get (); + if (c2 == 'f' || c2 == 'F') d = sign == '-' ? -octave_Inf : octave_Inf; else - is.putback (c); + { + is.putback (c2); + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } else - is.putback (c); + { + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } break; case 'n': case 'N': { - c = is.get (); - if (c == 'a' || c == 'A') + char c1 = is.get (); + if (c1 == 'a' || c1 == 'A') { - c = is.get (); - if (c == 'n' || c == 'N') + char c2 = is.get (); + if (c2 == 'n' || c2 == 'N') d = octave_NaN; else { - is.putback (c); + is.putback (c2); d = octave_NA; } } else - is.putback (c); + { + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } break; @@ -244,6 +257,8 @@ return d; } +// Read a double value. Discard any sign on NaN and NA. + template <> double octave_read_value (std::istream& is) @@ -261,7 +276,7 @@ { char c2 = 0; c2 = is.get (); - if (c2 == 'i' || c2 == 'I') + if (c2 == 'i' || c2 == 'I' || c2 == 'n' || c2 == 'N') d = read_inf_nan_na (is, c2, c1); else { @@ -276,7 +291,7 @@ { char c2 = 0; c2 = is.get (); - if (c2 == 'i' || c2 == 'I') + if (c2 == 'i' || c2 == 'I' || c2 == 'n' || c2 == 'N') d = read_inf_nan_na (is, c2, c1); else { @@ -344,44 +359,57 @@ } static inline float -read_float_inf_nan_na (std::istream& is, char c, char sign = '+') +read_float_inf_nan_na (std::istream& is, char c0, char sign = '+') { float d = 0.0; - switch (c) + switch (c0) { case 'i': case 'I': { - c = is.get (); - if (c == 'n' || c == 'N') + char c1 = is.get (); + if (c1 == 'n' || c1 == 'N') { - c = is.get (); - if (c == 'f' || c == 'F') - d = sign == '-' ? -octave_Inf : octave_Inf; + char c2 = is.get (); + if (c2 == 'f' || c2 == 'F') + d = sign == '-' ? -octave_Float_Inf : octave_Float_Inf; else - is.putback (c); + { + is.putback (c2); + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } else - is.putback (c); + { + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } break; case 'n': case 'N': { - c = is.get (); - if (c == 'a' || c == 'A') + char c1 = is.get (); + if (c1 == 'a' || c1 == 'A') { - c = is.get (); - if (c == 'n' || c == 'N') - d = octave_NaN; + char c2 = is.get (); + if (c2 == 'n' || c2 == 'N') + d = octave_Float_NaN; else { - is.putback (c); - d = octave_NA; + is.putback (c2); + d = octave_Float_NA; } } else - is.putback (c); + { + is.putback (c1); + is.putback (c0); + is.setstate (std::ios::failbit); + } } break; @@ -392,6 +420,8 @@ return d; } +// Read a float value. Discard any sign on NaN and NA. + template <> float octave_read_value (std::istream& is) @@ -409,7 +439,7 @@ { char c2 = 0; c2 = is.get (); - if (c2 == 'i' || c2 == 'I') + if (c2 == 'i' || c2 == 'I' || c2 == 'n' || c2 == 'N') d = read_float_inf_nan_na (is, c2, c1); else { @@ -424,7 +454,7 @@ { char c2 = 0; c2 = is.get (); - if (c2 == 'i' || c2 == 'I') + if (c2 == 'i' || c2 == 'I' || c2 == 'n' || c2 == 'N') d = read_float_inf_nan_na (is, c2, c1); else {
--- a/liboctave/mx-inlines.cc +++ b/liboctave/mx-inlines.cc @@ -37,6 +37,8 @@ #include "Array.h" #include "Array-util.h" +#include "bsxfun.h" + // Provides some commonly repeated, basic loop templates. template <class R, class S> @@ -167,6 +169,9 @@ for (size_t i = 0; i < n; i++) \ r[i] OP logical_value (x[i]); \ } \ +template <class X> \ +inline void F (size_t n, bool *r, X x) throw () \ +{ for (size_t i = 0; i < n; i++) r[i] OP x; } DEFMXBOOLOPEQ (mx_inline_and2, &=) DEFMXBOOLOPEQ (mx_inline_or2, |=) @@ -210,6 +215,19 @@ return false; } +template <class T> +inline bool +mx_inline_any_positive (size_t n, const T* x) throw () +{ + for (size_t i = 0; i < n; i++) + { + if (x[i] > 0) + return true; + } + + return false; +} + template<class T> inline bool mx_inline_all_real (size_t n, const std::complex<T>* x) throw () @@ -286,7 +304,10 @@ inline void F (size_t n, R *r, X x, const Y *y) throw () \ { for (size_t i = 0; i < n; i++) r[i] = FUN (x, y[i]); } -DEFMXMAPPER2X (mx_inline_pow, std::pow) +// Let the compiler decide which pow to use, whichever best matches the +// arguments provided. +using std::pow; +DEFMXMAPPER2X (mx_inline_pow, pow) // Arbitrary function appliers. The function is a template parameter to enable // inlining. @@ -336,11 +357,12 @@ return r; } - template <class R, class X, class Y> inline Array<R> do_mm_binary_op (const Array<X>& x, const Array<Y>& y, void (*op) (size_t, R *, const X *, const Y *) throw (), + void (*op1) (size_t, R *, X, const Y *) throw (), + void (*op2) (size_t, R *, const X *, Y) throw (), const char *opname) { dim_vector dx = x.dims (), dy = y.dims (); @@ -350,6 +372,10 @@ op (r.length (), r.fortran_vec (), x.data (), y.data ()); return r; } + else if (is_valid_bsxfun (dx, dy)) + { + return do_bsxfun_op (x, y, op, op1, op2); + } else { gripe_nonconformant (opname, dx, dy); @@ -381,11 +407,18 @@ inline Array<R>& do_mm_inplace_op (Array<R>& r, const Array<X>& x, void (*op) (size_t, R *, const X *) throw (), + void (*op1) (size_t, R *, X) throw (), const char *opname) { dim_vector dr = r.dims (), dx = x.dims (); if (dr == dx) - op (r.length (), r.fortran_vec (), x.data ()); + { + op (r.length (), r.fortran_vec (), x.data ()); + } + else if (is_valid_inplace_bsxfun (dr, dx)) + { + do_inplace_bsxfun_op (r, x, op, op1); + } else gripe_nonconformant (opname, dr, dx); return r;
--- a/liboctave/mx-op-defs.h +++ b/liboctave/mx-op-defs.h @@ -72,7 +72,7 @@ R \ F (const V1& v1, const V2& v2) \ { \ - return do_mm_binary_op<R::element_type, V1::element_type, V2::element_type> (v1, v2, OP, #F); \ + return do_mm_binary_op<R::element_type, V1::element_type, V2::element_type> (v1, v2, OP, OP, OP, #F); \ } #define VV_BIN_OPS(R, V1, V2) \ @@ -173,7 +173,7 @@ R \ OP (const M1& m1, const M2& m2) \ { \ - return do_mm_binary_op<R::element_type, M1::element_type, M2::element_type> (m1, m2, F, #OP); \ + return do_mm_binary_op<R::element_type, M1::element_type, M2::element_type> (m1, m2, F, F, F, #OP); \ } #define MM_BIN_OPS(R, M1, M2) \ @@ -186,7 +186,7 @@ boolMatrix \ F (const M1& m1, const M2& m2) \ { \ - return do_mm_binary_op<bool, M1::element_type, M2::element_type> (m1, m2, OP, #F); \ + return do_mm_binary_op<bool, M1::element_type, M2::element_type> (m1, m2, OP, OP, OP, #F); \ } #define MM_CMP_OPS(M1, M2) \ @@ -203,7 +203,7 @@ { \ MNANCHK (m1, M1::element_type); \ MNANCHK (m2, M2::element_type); \ - return do_mm_binary_op<bool, M1::element_type, M2::element_type> (m1, m2, OP, #F); \ + return do_mm_binary_op<bool, M1::element_type, M2::element_type> (m1, m2, OP, OP, OP, #F); \ } #define MM_BOOL_OPS(M1, M2) \ @@ -310,7 +310,7 @@ R \ OP (const ND1& m1, const ND2& m2) \ { \ - return do_mm_binary_op<R::element_type, ND1::element_type, ND2::element_type> (m1, m2, F, #OP); \ + return do_mm_binary_op<R::element_type, ND1::element_type, ND2::element_type> (m1, m2, F, F, F, #OP); \ } #define NDND_BIN_OPS(R, ND1, ND2) \ @@ -323,7 +323,7 @@ boolNDArray \ F (const ND1& m1, const ND2& m2) \ { \ - return do_mm_binary_op<bool, ND1::element_type, ND2::element_type> (m1, m2, OP, #F); \ + return do_mm_binary_op<bool, ND1::element_type, ND2::element_type> (m1, m2, OP, OP, OP, #F); \ } #define NDND_CMP_OPS(ND1, ND2) \ @@ -340,7 +340,7 @@ { \ MNANCHK (m1, ND1::element_type); \ MNANCHK (m2, ND2::element_type); \ - return do_mm_binary_op<bool, ND1::element_type, ND2::element_type> (m1, m2, OP, #F); \ + return do_mm_binary_op<bool, ND1::element_type, ND2::element_type> (m1, m2, OP, OP, OP, #F); \ } #define NDND_BOOL_OPS(ND1, ND2) \ @@ -583,7 +583,7 @@ T \ FCN (const T& a, const T& b) \ { \ - return do_mm_binary_op<T::element_type, T::element_type, T::element_type> (a, b, mx_inline_x##FCN, #FCN); \ + return do_mm_binary_op<T::element_type, T::element_type, T::element_type> (a, b, mx_inline_x##FCN, mx_inline_x##FCN, mx_inline_x##FCN, #FCN); \ } #define MINMAX_FCNS(T, S) \
--- a/liboctave/oct-binmap.h +++ b/liboctave/oct-binmap.h @@ -27,9 +27,13 @@ #include "Sparse.h" #include "Array-util.h" -// This source implements a general binary maping function for arrays. -// The syntax is binmap<type> (a, b, f, [name]). type denotes the expected -// return type of the operation. a, b, should be one of the 6 combinations: +#include "bsxfun.h" + +// This source file implements a general binary maping function for +// arrays. The syntax is binmap<type> (a, b, f, [name]). type denotes +// the expected return type of the operation. a, b, should be one of +// the 6 combinations: +// // Array-Array // Array-scalar // scalar-Array @@ -37,11 +41,12 @@ // Sparse-scalar // scalar-Sparse // -// If both operands are nonscalar, name must be supplied. It is used as the base for error message -// when operands are nonconforming. +// If both operands are nonscalar, name must be supplied. It is used +// as the base for error message when operands are nonconforming. // -// The operation needs not be homogeneous, i.e. a, b and the result may be of distinct types. -// f can have any of the four signatures: +// The operation needs not be homogeneous, i.e. a, b and the result +// may be of distinct types. f can have any of the four signatures: +// // U f (T, R) // U f (const T&, R) // U f (T, const R&) @@ -49,7 +54,51 @@ // // Additionally, f can be an arbitrary functor object. // -// octave_quit() is called at appropriate places, hence the operation is breakable. +// octave_quit() is called at appropriate places, hence the operation +// is breakable. + +// The following template wrappers are provided for automatic bsxfun +// calls (see the function signature for do_bsxfun_op). + +template<typename R, typename X, typename Y, typename F> +class bsxfun_wrapper +{ +private: + static F f; + +public: + static void + set_f (const F& f_in) + { + f = f_in; + } + + static void + op_mm (size_t n, R* r, const X* x , const Y* y) + { + for (size_t i = 0; i < n; i++) + r[i] = f (x[i], y[i]); + } + + static void + op_sm (size_t n, R* r, X x, const Y* y) + { + for (size_t i = 0; i < n; i++) + r[i] = f (x, y[i]); + } + + static void + op_ms (size_t n , R* r, const X* x, Y y) + { + for (size_t i = 0; i < n; i++) + r[i] = f (x[i], y); + } +}; + +// Static init +template<typename R, typename X, typename Y, typename F> +F bsxfun_wrapper<R, X, Y, F>::f; + // scalar-Array template <class U, class T, class R, class F> @@ -118,12 +167,24 @@ Array<U> binmap (const Array<T>& xa, const Array<R>& ya, F fcn, const char *name) { + dim_vector xad = xa.dims (), yad = ya.dims (); if (xa.numel () == 1) return binmap<U, T, R, F> (xa(0), ya, fcn); else if (ya.numel () == 1) return binmap<U, T, R, F> (xa, ya(0), fcn); - else if (xa.dims () != ya.dims ()) - gripe_nonconformant (name, xa.dims (), ya.dims ()); + else if (xad != yad) + { + if (is_valid_bsxfun (xad, yad)) + { + bsxfun_wrapper<U, T, R, F>::set_f(fcn); + return do_bsxfun_op (xa, ya, + bsxfun_wrapper<U, T, R, F>::op_mm, + bsxfun_wrapper<U, T, R, F>::op_sm, + bsxfun_wrapper<U, T, R, F>::op_ms); + } + else + gripe_nonconformant (name, xad, yad); + } octave_idx_type len = xa.numel (); @@ -273,134 +334,134 @@ fcn, name)); } -// Overloads for function references. +// Overloads for function pointers. // Signature (T, R) template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const Array<R>& ya, U (&fcn) (T, R), const char *name) -{ return binmap<U, T, R, U (&) (T, R)> (xa, ya, fcn, name); } +binmap (const Array<T>& xa, const Array<R>& ya, U (*fcn) (T, R), const char *name) +{ return binmap<U, T, R, U (*) (T, R)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Array<U> -binmap (const T& x, const Array<R>& ya, U (&fcn) (T, R)) -{ return binmap<U, T, R, U (&) (T, R)> (x, ya, fcn); } +binmap (const T& x, const Array<R>& ya, U (*fcn) (T, R)) +{ return binmap<U, T, R, U (*) (T, R)> (x, ya, fcn); } template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const R& y, U (&fcn) (T, R)) -{ return binmap<U, T, R, U (&) (T, R)> (xa, y, fcn); } +binmap (const Array<T>& xa, const R& y, U (*fcn) (T, R)) +{ return binmap<U, T, R, U (*) (T, R)> (xa, y, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (&fcn) (T, R), const char *name) -{ return binmap<U, T, R, U (&) (T, R)> (xa, ya, fcn, name); } +binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (*fcn) (T, R), const char *name) +{ return binmap<U, T, R, U (*) (T, R)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Sparse<U> -binmap (const T& x, const Sparse<R>& ya, U (&fcn) (T, R)) -{ return binmap<U, T, R, U (&) (T, R)> (x, ya, fcn); } +binmap (const T& x, const Sparse<R>& ya, U (*fcn) (T, R)) +{ return binmap<U, T, R, U (*) (T, R)> (x, ya, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const R& y, U (&fcn) (T, R)) -{ return binmap<U, T, R, U (&) (T, R)> (xa, y, fcn); } +binmap (const Sparse<T>& xa, const R& y, U (*fcn) (T, R)) +{ return binmap<U, T, R, U (*) (T, R)> (xa, y, fcn); } // Signature (const T&, const R&) template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const Array<R>& ya, U (&fcn) (const T&, const R&), const char *name) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (xa, ya, fcn, name); } +binmap (const Array<T>& xa, const Array<R>& ya, U (*fcn) (const T&, const R&), const char *name) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Array<U> -binmap (const T& x, const Array<R>& ya, U (&fcn) (const T&, const R&)) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (x, ya, fcn); } +binmap (const T& x, const Array<R>& ya, U (*fcn) (const T&, const R&)) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (x, ya, fcn); } template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const R& y, U (&fcn) (const T&, const R&)) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (xa, y, fcn); } +binmap (const Array<T>& xa, const R& y, U (*fcn) (const T&, const R&)) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (xa, y, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (&fcn) (const T&, const R&), const char *name) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (xa, ya, fcn, name); } +binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (*fcn) (const T&, const R&), const char *name) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Sparse<U> -binmap (const T& x, const Sparse<R>& ya, U (&fcn) (const T&, const R&)) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (x, ya, fcn); } +binmap (const T& x, const Sparse<R>& ya, U (*fcn) (const T&, const R&)) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (x, ya, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const R& y, U (&fcn) (const T&, const R&)) -{ return binmap<U, T, R, U (&) (const T&, const R&)> (xa, y, fcn); } +binmap (const Sparse<T>& xa, const R& y, U (*fcn) (const T&, const R&)) +{ return binmap<U, T, R, U (*) (const T&, const R&)> (xa, y, fcn); } // Signature (const T&, R) template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const Array<R>& ya, U (&fcn) (const T&, R), const char *name) -{ return binmap<U, T, R, U (&) (const T&, R)> (xa, ya, fcn, name); } +binmap (const Array<T>& xa, const Array<R>& ya, U (*fcn) (const T&, R), const char *name) +{ return binmap<U, T, R, U (*) (const T&, R)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Array<U> -binmap (const T& x, const Array<R>& ya, U (&fcn) (const T&, R)) -{ return binmap<U, T, R, U (&) (const T&, R)> (x, ya, fcn); } +binmap (const T& x, const Array<R>& ya, U (*fcn) (const T&, R)) +{ return binmap<U, T, R, U (*) (const T&, R)> (x, ya, fcn); } template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const R& y, U (&fcn) (const T&, R)) -{ return binmap<U, T, R, U (&) (const T&, R)> (xa, y, fcn); } +binmap (const Array<T>& xa, const R& y, U (*fcn) (const T&, R)) +{ return binmap<U, T, R, U (*) (const T&, R)> (xa, y, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (&fcn) (const T&, R), const char *name) -{ return binmap<U, T, R, U (&) (const T&, R)> (xa, ya, fcn, name); } +binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (*fcn) (const T&, R), const char *name) +{ return binmap<U, T, R, U (*) (const T&, R)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Sparse<U> -binmap (const T& x, const Sparse<R>& ya, U (&fcn) (const T&, R)) -{ return binmap<U, T, R, U (&) (const T&, R)> (x, ya, fcn); } +binmap (const T& x, const Sparse<R>& ya, U (*fcn) (const T&, R)) +{ return binmap<U, T, R, U (*) (const T&, R)> (x, ya, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const R& y, U (&fcn) (const T&, R)) -{ return binmap<U, T, R, U (&) (const T&, R)> (xa, y, fcn); } +binmap (const Sparse<T>& xa, const R& y, U (*fcn) (const T&, R)) +{ return binmap<U, T, R, U (*) (const T&, R)> (xa, y, fcn); } // Signature (T, const R&) template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const Array<R>& ya, U (&fcn) (T, const R&), const char *name) -{ return binmap<U, T, R, U (&) (T, const R&)> (xa, ya, fcn, name); } +binmap (const Array<T>& xa, const Array<R>& ya, U (*fcn) (T, const R&), const char *name) +{ return binmap<U, T, R, U (*) (T, const R&)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Array<U> -binmap (const T& x, const Array<R>& ya, U (&fcn) (T, const R&)) -{ return binmap<U, T, R, U (&) (T, const R&)> (x, ya, fcn); } +binmap (const T& x, const Array<R>& ya, U (*fcn) (T, const R&)) +{ return binmap<U, T, R, U (*) (T, const R&)> (x, ya, fcn); } template <class U, class T, class R> inline Array<U> -binmap (const Array<T>& xa, const R& y, U (&fcn) (T, const R&)) -{ return binmap<U, T, R, U (&) (T, const R&)> (xa, y, fcn); } +binmap (const Array<T>& xa, const R& y, U (*fcn) (T, const R&)) +{ return binmap<U, T, R, U (*) (T, const R&)> (xa, y, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (&fcn) (T, const R&), const char *name) -{ return binmap<U, T, R, U (&) (T, const R&)> (xa, ya, fcn, name); } +binmap (const Sparse<T>& xa, const Sparse<R>& ya, U (*fcn) (T, const R&), const char *name) +{ return binmap<U, T, R, U (*) (T, const R&)> (xa, ya, fcn, name); } template <class U, class T, class R> inline Sparse<U> -binmap (const T& x, const Sparse<R>& ya, U (&fcn) (T, const R&)) -{ return binmap<U, T, R, U (&) (T, const R&)> (x, ya, fcn); } +binmap (const T& x, const Sparse<R>& ya, U (*fcn) (T, const R&)) +{ return binmap<U, T, R, U (*) (T, const R&)> (x, ya, fcn); } template <class U, class T, class R> inline Sparse<U> -binmap (const Sparse<T>& xa, const R& y, U (&fcn) (T, const R&)) -{ return binmap<U, T, R, U (&) (T, const R&)> (xa, y, fcn); } +binmap (const Sparse<T>& xa, const R& y, U (*fcn) (T, const R&)) +{ return binmap<U, T, R, U (*) (T, const R&)> (xa, y, fcn); } #endif
--- a/liboctave/oct-inttypes.cc +++ b/liboctave/oct-inttypes.cc @@ -578,6 +578,23 @@ template <class T> octave_int<T> +pow (const float& a, const octave_int<T>& b) +{ return octave_int<T> (pow (a, b.float_value ())); } + +template <class T> +octave_int<T> +pow (const octave_int<T>& a, const float& b) +{ + return ((b >= 0 && b < std::numeric_limits<T>::digits && b == xround (b)) + ? pow (a, octave_int<T> (static_cast<T> (b))) + : octave_int<T> (pow (a.double_value (), static_cast<double> (b)))); +} + +// FIXME: Do we really need a differently named single-precision +// function integer power function here instead of an overloaded +// one? +template <class T> +octave_int<T> powf (const float& a, const octave_int<T>& b) { return octave_int<T> (pow (a, b.float_value ())); } @@ -595,6 +612,8 @@ template OCTAVE_API octave_int<T> pow (const octave_int<T>&, const octave_int<T>&); \ template OCTAVE_API octave_int<T> pow (const double&, const octave_int<T>&); \ template OCTAVE_API octave_int<T> pow (const octave_int<T>&, const double&); \ + template OCTAVE_API octave_int<T> pow (const float&, const octave_int<T>&); \ + template OCTAVE_API octave_int<T> pow (const octave_int<T>&, const float&); \ template OCTAVE_API octave_int<T> powf (const float&, const octave_int<T>&); \ template OCTAVE_API octave_int<T> powf (const octave_int<T>&, const float&); \ template OCTAVE_API octave_int<T> \
--- a/liboctave/oct-inttypes.h +++ b/liboctave/oct-inttypes.h @@ -452,7 +452,7 @@ // Returns 1 for negative number, 0 otherwise. static T - signbit (T x) + __signbit (T x) { #ifdef HAVE_FAST_INT_OPS return static_cast<UT> (x) >> std::numeric_limits<T>::digits; @@ -496,7 +496,7 @@ signum (T x) { // With modest optimizations, this will compile without a jump. - return ((x > 0) ? 1 : 0) - signbit (x); + return ((x > 0) ? 1 : 0) - __signbit (x); } // FIXME -- we do not have an authority what signed shifts should @@ -544,7 +544,7 @@ T ux = u ^ x, uy = u ^ y; if ((ux & uy) < 0) { - u = octave_int_base<T>::max_val () + signbit (~u); + u = octave_int_base<T>::max_val () + __signbit (~u); } return u; #else @@ -585,7 +585,7 @@ T ux = u ^ x, uy = u ^ ~y; if ((ux & uy) < 0) { - u = octave_int_base<T>::max_val () + signbit (~u); + u = octave_int_base<T>::max_val () + __signbit (~u); } return u; #else @@ -651,7 +651,7 @@ z = x / y; T w = -octave_int_abs (x % y); // Can't overflow, but std::abs (x) can! if (w <= y - w) - z -= 1 - (signbit (x) << 1); + z -= 1 - (__signbit (x) << 1); } } else @@ -663,7 +663,7 @@ T w = octave_int_abs (x % y); if (w >= y - w) - z += 1 - (signbit (x) << 1); + z += 1 - (__signbit (x) << 1); } return z; } @@ -874,6 +874,17 @@ template <class T> extern OCTAVE_API octave_int<T> +pow (const float& a, const octave_int<T>& b); + +template <class T> +extern OCTAVE_API octave_int<T> +pow (const octave_int<T>& a, const float& b); + +// FIXME: Do we really need a differently named single-precision +// function integer power function here instead of an overloaded +// one? +template <class T> +extern OCTAVE_API octave_int<T> powf (const float& a, const octave_int<T>& b); template <class T>
--- a/liboctave/oct-mutex.cc +++ b/liboctave/oct-mutex.cc @@ -45,6 +45,14 @@ (*current_liboctave_error_handler) ("mutex not supported on this platform"); } +bool +octave_base_mutex::try_lock (void) +{ + (*current_liboctave_error_handler) ("mutex not supported on this platform"); + + return false; +} + #if defined (__WIN32__) && ! defined (__CYGWIN__) class @@ -72,10 +80,29 @@ LeaveCriticalSection (&cs); } + bool try_lock (void) + { + return (TryEnterCriticalSection (&cs) != 0); + } + private: CRITICAL_SECTION cs; }; +static DWORD octave_thread_id = 0; + +void +octave_thread::init (void) +{ + octave_thread_id = GetCurrentThreadId (); +} + +bool +octave_thread::is_octave_thread (void) +{ + return (GetCurrentThreadId () == octave_thread_id); +} + #elif defined (HAVE_PTHREAD_H) class @@ -108,10 +135,29 @@ pthread_mutex_unlock (&pm); } + bool try_lock (void) + { + return (pthread_mutex_trylock (&pm) == 0); + } + private: pthread_mutex_t pm; }; +static pthread_t octave_thread_id = 0; + +void +octave_thread::init (void) +{ + octave_thread_id = pthread_self (); +} + +bool +octave_thread::is_octave_thread (void) +{ + return (pthread_equal (octave_thread_id, pthread_self ()) != 0); +} + #endif static octave_base_mutex *
--- a/liboctave/oct-mutex.h +++ b/liboctave/oct-mutex.h @@ -39,6 +39,8 @@ virtual void unlock (void); + virtual bool try_lock (void); + private: int count; }; @@ -86,6 +88,11 @@ rep->unlock (); } + bool try_lock (void) + { + return rep->try_lock (); + } + protected: octave_base_mutex *rep; }; @@ -94,17 +101,28 @@ octave_autolock { public: - octave_autolock (const octave_mutex& m) - : mutex (m) + octave_autolock (const octave_mutex& m, bool block = true) + : mutex (m), lock_result (false) { - mutex.lock (); + if (block) + { + mutex.lock (); + lock_result = true; + } + else + lock_result = mutex.try_lock (); } ~octave_autolock (void) { - mutex.unlock (); + if (lock_result) + mutex.unlock (); } + bool ok (void) const { return lock_result; } + + operator bool (void) const { return ok (); } + private: // No copying or default constructor! @@ -114,6 +132,17 @@ private: octave_mutex mutex; + bool lock_result; +}; + +class +OCTAVE_API +octave_thread +{ +public: + static void init (void); + + static bool is_octave_thread (void); }; #endif
--- a/liboctave/oct-sort.cc +++ b/liboctave/oct-sort.cc @@ -1003,7 +1003,7 @@ octave_idx_type *idest; int result = -1; /* guilty until proved innocent */ T *basea, *baseb; - octave_idx_type *ibasea, *ibaseb; + octave_idx_type *ibaseb; octave_idx_type min_gallop = ms->min_gallop; ms->getmemi (nb); @@ -1012,7 +1012,7 @@ idest = ipb + nb - 1; std::copy (pb, pb + nb, ms->a); std::copy (ipb, ipb + nb, ms->ia); - basea = pa; ibasea = ipa; + basea = pa; baseb = ms->a; ibaseb = ms->ia; pb = ms->a + nb - 1; ipb = ms->ia + nb - 1; pa += na - 1; ipa += na - 1;
--- a/liboctave/str-vec.cc +++ b/liboctave/str-vec.cc @@ -163,6 +163,26 @@ return *this; } +std::string +string_vector::join (const std::string& sep) const +{ + std::string retval; + + octave_idx_type len = length (); + + if (len > 0) + { + octave_idx_type i; + + for (i = 0; i < len - 1; i++) + retval += elem(i) + sep; + + retval += elem(i); + } + + return retval; +} + char ** string_vector::c_str_vec (void) const {
--- a/liboctave/str-vec.h +++ b/liboctave/str-vec.h @@ -105,6 +105,8 @@ string_vector& append (const string_vector& sv); + std::string join (const std::string& sep = std::string ()) const; + char **c_str_vec (void) const; static void delete_c_str_vec (const char * const*);
--- a/liboctave/uint16NDArray.cc +++ b/liboctave/uint16NDArray.cc @@ -54,3 +54,6 @@ BSXFUN_STDOP_DEFS_MXLOOP (uint16NDArray) BSXFUN_STDREL_DEFS_MXLOOP (uint16NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, uint16NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (uint16NDArray)
--- a/liboctave/uint16NDArray.h +++ b/liboctave/uint16NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (uint16NDArray, octave_uint16, OCTAVE_API) BSXFUN_STDOP_DECLS (uint16NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(uint16NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (uint16NDArray, OCTAVE_API) #endif
--- a/liboctave/uint32NDArray.cc +++ b/liboctave/uint32NDArray.cc @@ -54,3 +54,6 @@ BSXFUN_STDOP_DEFS_MXLOOP (uint32NDArray) BSXFUN_STDREL_DEFS_MXLOOP (uint32NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, uint32NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (uint32NDArray)
--- a/liboctave/uint32NDArray.h +++ b/liboctave/uint32NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (uint32NDArray, octave_uint32, OCTAVE_API) BSXFUN_STDOP_DECLS (uint32NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(uint32NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (uint32NDArray, OCTAVE_API) #endif
--- a/liboctave/uint64NDArray.cc +++ b/liboctave/uint64NDArray.cc @@ -54,3 +54,7 @@ BSXFUN_STDOP_DEFS_MXLOOP (uint64NDArray) BSXFUN_STDREL_DEFS_MXLOOP (uint64NDArray) + +BSXFUN_OP_DEF_MXLOOP (pow, uint64NDArray, mx_inline_pow) +BSXFUN_POW_MIXED_MXLOOP (uint64NDArray) +
--- a/liboctave/uint64NDArray.h +++ b/liboctave/uint64NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (uint64NDArray, octave_uint64, OCTAVE_API) BSXFUN_STDOP_DECLS (uint64NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(uint64NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (uint64NDArray, OCTAVE_API) #endif
--- a/liboctave/uint8NDArray.cc +++ b/liboctave/uint8NDArray.cc @@ -54,3 +54,7 @@ BSXFUN_STDOP_DEFS_MXLOOP (uint8NDArray) BSXFUN_STDREL_DEFS_MXLOOP (uint8NDArray) + +BSXFUN_POW_MIXED_MXLOOP (uint8NDArray) +BSXFUN_OP_DEF_MXLOOP (pow, uint8NDArray, mx_inline_pow) +
--- a/liboctave/uint8NDArray.h +++ b/liboctave/uint8NDArray.h @@ -44,6 +44,7 @@ MINMAX_DECLS (uint8NDArray, octave_uint8, OCTAVE_API) BSXFUN_STDOP_DECLS (uint8NDArray, OCTAVE_API) +BSXFUN_MIXED_INT_DECLS(uint8NDArray, OCTAVE_API) BSXFUN_STDREL_DECLS (uint8NDArray, OCTAVE_API) #endif
--- a/m4/acinclude.m4 +++ b/m4/acinclude.m4 @@ -565,7 +565,7 @@ AC_DEFUN([OCTAVE_PROG_GHOSTSCRIPT], [ case "$canonical_host_type" in *-*-mingw* | *-*-msdosmsvc) - gs_names="gswin32c gs" + gs_names="gswin32c gs mgs" ;; *) gs_names="gs"
--- a/run-octave.in +++ b/run-octave.in @@ -30,22 +30,19 @@ top_srcdir='%abs_top_srcdir%' builddir='%builddir%' -d1="$top_srcdir/test" -d2="$top_srcdir/scripts" -d3="$builddir/scripts" -d4="$builddir/src" +d1="$top_srcdir/scripts" +d2="$builddir/scripts" +d3="$builddir/src" d1_list=`$FIND "$d1" -type d -a ! \( \( -name private -o -name '@*' \) -a -prune \) -exec echo '{}' ';' | $SED 's/$/:/'` d2_list=`$FIND "$d2" -type d -a ! \( \( -name private -o -name '@*' \) -a -prune \) -exec echo '{}' ';' | $SED 's/$/:/'` d3_list=`$FIND "$d3" -type d -a ! \( \( -name private -o -name '@*' \) -a -prune \) -exec echo '{}' ';' | $SED 's/$/:/'` -d4_list=`$FIND "$d4" -type d -a ! \( \( -name private -o -name '@*' \) -a -prune \) -exec echo '{}' ';' | $SED 's/$/:/'` d1_path=`echo "$d1_list" | $AWK '{ t = (s $0); s = t; } END { sub (/:$/, "", s); print s; }'` d2_path=`echo "$d2_list" | $AWK '{ t = (s $0); s = t; } END { sub (/:$/, "", s); print s; }'` d3_path=`echo "$d3_list" | $AWK '{ t = (s $0); s = t; } END { sub (/:$/, "", s); print s; }'` -d4_path=`echo "$d4_list" | $AWK '{ t = (s $0); s = t; } END { sub (/:$/, "", s); print s; }'` -LOADPATH="$d1_path:$d2_path:$d3_path:$d4_path" +LOADPATH="$d1_path:$d2_path:$d3_path" IMAGEPATH="$top_srcdir/scripts/image" DOCFILE="$builddir/doc/interpreter/doc-cache" INFOFILE="$top_srcdir/doc/interpreter/octave.info"
--- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -3,17 +3,17 @@ # Copyright (C) 1993-2011 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 # <http://www.gnu.org/licenses/>. @@ -53,6 +53,7 @@ include pkg/module.mk include plot/module.mk include polynomial/module.mk +include prefs/module.mk include set/module.mk include signal/module.mk include sparse/module.mk @@ -141,6 +142,10 @@ $(srcdir)/mk-pkg-add $(srcdir) $(polynomial_FCN_FILES) -- $(polynomial_GEN_FCN_FILES) > $@-t mv $@-t $@ +prefs/PKG_ADD: $(prefs_FCN_FILES) $(prefs_GEN_FCN_FILES) prefs/$(octave_dirstamp) mk-pkg-add + $(srcdir)/mk-pkg-add $(srcdir) $(prefs_FCN_FILES) -- $(prefs_GEN_FCN_FILES) > $@-t + mv $@-t $@ + set/PKG_ADD: $(set_FCN_FILES) $(set_GEN_FCN_FILES) set/$(octave_dirstamp) mk-pkg-add $(srcdir)/mk-pkg-add $(srcdir) $(set_FCN_FILES) -- $(set_GEN_FCN_FILES) > $@-t mv $@-t $@ @@ -209,6 +214,7 @@ $(pkg_GEN_FCN_FILES): pkg/$(octave_dirstamp) $(plot_GEN_FCN_FILES): plot/$(octave_dirstamp) $(polynomial_GEN_FCN_FILES): polynomial/$(octave_dirstamp) +$(prefs_GEN_FCN_FILES): prefs/$(octave_dirstamp) $(set_GEN_FCN_FILES): set/$(octave_dirstamp) $(signal_GEN_FCN_FILES): signal/$(octave_dirstamp) $(sparse_GEN_FCN_FILES): sparse/$(octave_dirstamp) @@ -271,6 +277,9 @@ polynomial/$(octave_dirstamp): $(MKDIR_P) polynomial : > polynomial/$(octave_dirstamp) +prefs/$(octave_dirstamp): + $(MKDIR_P) prefs + : > prefs/$(octave_dirstamp) set/$(octave_dirstamp): $(MKDIR_P) set : > set/$(octave_dirstamp)
--- a/scripts/audio/playaudio.m +++ b/scripts/audio/playaudio.m @@ -30,46 +30,59 @@ function playaudio (name, ext) - if (nargin == 1 && isvector (name) && ! ischar (name)) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1 && isnumeric (name)) ## play a vector - [nr, nc] = size (name); - if (nc != 1) - if (nr == 1) - name = name'; - nr = nc; - else - error ("playaudio: X must be a vector"); - endif + if (! isvector (name)) + error ("playaudio: X must be a vector"); endif - X = name + 127; + X = name(:) + 127; unwind_protect file = tmpnam (); - num = fopen (file, "wb"); - c = fwrite (num, X, "uchar"); - fclose (num); - system (sprintf ("cat \"%s\" > /dev/dsp", file)); + fid = fopen (file, "wb"); + fwrite (fid, X, "uchar"); + fclose (fid); + [status, out] = system (sprintf ('cat "%s" > /dev/dsp', file)); + if (status != 0) + system (sprintf ("paplay --raw \"%s\"", file)) + endif unwind_protect_cleanup unlink (file); end_unwind_protect elseif (nargin >= 1 && ischar (name)) ## play a file if (nargin == 1) - name = [name, ".lin"]; + name = [name ".lin"]; elseif (nargin == 2) - name = [name, ".", ext]; - else - print_usage (); + name = [name "." ext]; endif - if (strcmp (ext, "lin") || strcmp (ext, "raw")) - system (sprintf ("cat \"%s\" > /dev/dsp", name)); - elseif (strcmp (ext, "mu") || strcmp (ext, "au") - || strcmp (ext, "snd") || strcmp (ext, "ul")) - system (sprintf ("cat \"%s\" > /dev/audio", name)); + if (any (strcmp (ext, {"lin", "raw"}))) + [status, out] = system (sprintf ('cat "%s" > /dev/dsp', name)); + if (status != 0) + system (sprintf ('paplay --raw "%s"', name)) + endif + elseif (any (strcmp (ext, {"mu", "au" "snd", "ul"}))) + [status, out] = system (sprintf ('cat "%s" > /dev/audio', name)); + if (status != 0) + system (sprintf ('paplay "%s"', name)) + endif else - error ("playaudio: unsupported extension"); + error ("playaudio: unsupported extension '%s'", ext); endif else print_usage (); endif endfunction + + +%% Test input validation +%!error playaudio () +%!error playaudio (1,2,3) +%!error <X must be a vector> playaudio (magic (3)) +%!error <unsupported extension> playaudio ("file", "abc") +%!error playaudio ({"abc"}) +
--- a/scripts/audio/wavread.m +++ b/scripts/audio/wavread.m @@ -55,135 +55,139 @@ error ("wavread: FILENAME must be a character string"); endif - # Open file for binary reading. - [fid, msg] = fopen (filename, "rb"); - if (fid < 0) - error ("wavread: %s", msg); - endif + fid = -1; + + unwind_protect - ## Get file size. - fseek (fid, 0, "eof"); - file_size = ftell (fid); - fseek (fid, 0, "bof"); + [fid, msg] = fopen (filename, "rb"); + + if (fid < 0) + error ("wavread: %s", msg); + endif - ## Find RIFF chunk. - riff_size = find_chunk (fid, "RIFF", file_size); - riff_pos = ftell (fid); - if (riff_size == -1) - fclose (fid); - error ("wavread: file contains no RIFF chunk"); - endif + ## Get file size. + fseek (fid, 0, "eof"); + file_size = ftell (fid); + fseek (fid, 0, "bof"); - riff_type = char (fread (fid, 4))'; - if (! strcmp (riff_type, "WAVE")) - fclose (fid); - error ("wavread: file contains no WAVE signature"); - endif - riff_pos = riff_pos + 4; - riff_size = riff_size - 4; + ## Find RIFF chunk. + riff_size = find_chunk (fid, "RIFF", file_size); + riff_pos = ftell (fid); + if (riff_size == -1) + error ("wavread: file contains no RIFF chunk"); + endif + + riff_type = char (fread (fid, 4))'; + if (! strcmp (riff_type, "WAVE")) + error ("wavread: file contains no WAVE signature"); + endif + riff_pos = riff_pos + 4; + riff_size = riff_size - 4; - ## Find format chunk inside the RIFF chunk. - fseek (fid, riff_pos, "bof"); - fmt_size = find_chunk (fid, "fmt ", riff_size); - fmt_pos = ftell(fid); - if (fmt_size == -1) - fclose (fid); - error ("wavread: file contains no format chunk"); - endif + ## Find format chunk inside the RIFF chunk. + fseek (fid, riff_pos, "bof"); + fmt_size = find_chunk (fid, "fmt ", riff_size); + fmt_pos = ftell(fid); + if (fmt_size == -1) + error ("wavread: file contains no format chunk"); + endif + + ## Find data chunk inside the RIFF chunk. + ## We don't assume that it comes after the format chunk. + fseek (fid, riff_pos, "bof"); + data_size = find_chunk (fid, "data", riff_size); + data_pos = ftell (fid); + if (data_size == -1) + error ("wavread: file contains no data chunk"); + endif - ## Find data chunk inside the RIFF chunk. - ## We don't assume that it comes after the format chunk. - fseek (fid, riff_pos, "bof"); - data_size = find_chunk (fid, "data", riff_size); - data_pos = ftell (fid); - if (data_size == -1) - fclose (fid); - error ("wavread: file contains no data chunk"); - endif + ### Read format chunk. + fseek (fid, fmt_pos, "bof"); - ### Read format chunk. - fseek (fid, fmt_pos, "bof"); + ## Sample format code. + format_tag = fread (fid, 1, "uint16", 0, BYTEORDER); + if (format_tag != FORMAT_PCM && format_tag != FORMAT_IEEE_FLOAT) + error ("wavread: sample format %#x is not supported", format_tag); + endif - ## Sample format code. - format_tag = fread (fid, 1, "uint16", 0, BYTEORDER); - if (format_tag != FORMAT_PCM && format_tag != FORMAT_IEEE_FLOAT) - fclose (fid); - error ("wavread: sample format %#x is not supported", format_tag); - endif + ## Number of interleaved channels. + channels = fread (fid, 1, "uint16", 0, BYTEORDER); - ## Number of interleaved channels. - channels = fread (fid, 1, "uint16", 0, BYTEORDER); + ## Sample rate. + samples_per_sec = fread (fid, 1, "uint32", 0, BYTEORDER); - ## Sample rate. - samples_per_sec = fread (fid, 1, "uint32", 0, BYTEORDER); + ## Bits per sample. + fseek (fid, 6, "cof"); + bits_per_sample = fread (fid, 1, "uint16", 0, BYTEORDER); - ## Bits per sample. - fseek (fid, 6, "cof"); - bits_per_sample = fread (fid, 1, "uint16", 0, BYTEORDER); + ### Read data chunk. + fseek (fid, data_pos, "bof"); - ### Read data chunk. - fseek (fid, data_pos, "bof"); + ## Determine sample data type. + if (format_tag == FORMAT_PCM) + switch (bits_per_sample) + case 8 + format = "uint8"; + case 16 + format = "int16"; + case 24 + format = "uint8"; + case 32 + format = "int32"; + otherwise + error ("wavread: %d bits sample resolution is not supported with PCM", + bits_per_sample); + endswitch + else + switch (bits_per_sample) + case 32 + format = "float32"; + case 64 + format = "float64"; + otherwise + error ("wavread: %d bits sample resolution is not supported with IEEE float", + bits_per_sample); + endswitch + endif - ## Determine sample data type. - if (format_tag == FORMAT_PCM) - switch (bits_per_sample) - case 8 - format = "uint8"; - case 16 - format = "int16"; - case 24 - format = "uint8"; - case 32 - format = "int32"; - otherwise - fclose (fid); - error ("wavread: %d bits sample resolution is not supported with PCM", - bits_per_sample); - endswitch - else - switch (bits_per_sample) - case 32 - format = "float32"; - case 64 - format = "float64"; - otherwise - fclose (fid); - error ("wavread: %d bits sample resolution is not supported with IEEE float", - bits_per_sample); - endswitch - endif + ## Parse arguments. + if (nargin == 1) + length = idivide (8 * data_size, bits_per_sample); + else + nparams = numel (param); + if (nparams == 1) + ## Number of samples is given. + length = param * channels; + elseif (nparams == 2) + ## Sample range is given. + if (fseek (fid, (param(1)-1) * channels * (bits_per_sample/8), "cof") < 0) + warning ("wavread: seeking failed"); + endif + length = (param(2)-param(1)+1) * channels; + elseif (nparams == 4 && char (param) == "size") + ## Size of the file is requested. + tmp = idivide (8 * data_size, channels * bits_per_sample); + y = [tmp, channels]; + return; + else + error ("wavread: invalid PARAM argument"); + endif + endif - ## Parse arguments. - if (nargin == 1) - length = 8 * data_size / bits_per_sample; - else - nparams = numel (param); - if (nparams == 1) - ## Number of samples is given. - length = param * channels; - elseif (nparams == 2) - ## Sample range is given. - if (fseek (fid, (param(1)-1) * channels * (bits_per_sample/8), "cof") < 0) - warning ("wavread: seeking failed"); - endif - length = (param(2)-param(1)+1) * channels; - elseif (nparams == 4 && char (param) == "size") - ## Size of the file is requested. + ## Read samples and close file. + if (bits_per_sample == 24) + length *= 3; + endif + + [yi, n] = fread (fid, length, format, 0, BYTEORDER); + + unwind_protect_cleanup + + if (fid >= 0) fclose (fid); - y = [data_size/channels/(bits_per_sample/8), channels]; - return; - else - fclose (fid); - error ("wavread: invalid PARAM argument"); endif - endif - ## Read samples and close file. - if (bits_per_sample == 24) - length *= 3; - endif - [yi, n] = fread (fid, length, format, 0, BYTEORDER); - fclose (fid); + end_unwind_protect ## Check data. if (mod (numel (yi), channels) != 0) @@ -240,7 +244,6 @@ endif endfunction - -%% Tests for wavread/wavwrite pair are in wavrite.m -%!assert(1) # stop fntests.m from reporting no tests for wavread - +## Mark file as being tested. Tests for wavread/wavwrite pair are in +## wavwrite.m +%!assert(1)
--- a/scripts/audio/wavwrite.m +++ b/scripts/audio/wavwrite.m @@ -143,38 +143,41 @@ endfunction +%!shared fname +%! fname = tmpnam (); + %!test %! A = [-1:0.1:1; -1:0.1:1]; -%! wavwrite (A, "a.wav"); -%! [B, samples_per_sec, bits_per_sample] = wavread ("a.wav"); -%! assert(A,B, 1/2^15); -%! assert(samples_per_sec, 8000); -%! assert(bits_per_sample, 16); -%! delete ("a.wav"); +%! wavwrite (A, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/2^15); +%! assert (samples_per_sec, 8000); +%! assert (bits_per_sample, 16); +%! unlink (fname); % %!test %! A = [-1:0.1:1; -1:0.1:1]; -%! wavwrite (A, 4000, "a.wav"); -%! [B, samples_per_sec, bits_per_sample] = wavread ("a.wav"); -%! assert(A,B, 1/2^15); -%! assert(samples_per_sec, 4000); -%! assert(bits_per_sample, 16); -%! delete ("a.wav"); +%! wavwrite (A, 4000, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/2^15); +%! assert (samples_per_sec, 4000); +%! assert (bits_per_sample, 16); +%! unlink (fname); % %!test %! A = [-1:0.1:1; -1:0.1:1]; -%! wavwrite (A, 4000, 8, "a.wav"); -%! [B, samples_per_sec, bits_per_sample] = wavread ("a.wav"); -%! assert(A,B, 1/128); -%! assert(samples_per_sec, 4000); -%! assert(bits_per_sample, 8); -%! delete ("a.wav"); +%! wavwrite (A, 4000, 8, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/128); +%! assert (samples_per_sec, 4000); +%! assert (bits_per_sample, 8); +%! unlink (fname); % %!test %! A = [-2:2]; -%! wavwrite (A, "a.wav"); -%! B = wavread ("a.wav"); +%! wavwrite (A, fname); +%! B = wavread (fname); %! B *= 32768; -%! assert(B, [-32768 -32768 0 32767 32767]); -%! delete ("a.wav"); +%! assert (B, [-32768 -32768 0 32767 32767]); +%! unlink (fname);
new file mode 100644 --- /dev/null +++ b/scripts/deprecated/__error_text__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} __error_text__ (@var{msg}, @var{msgid}) +## This function has been deprecated. Use @code{lasterr} instead. +## @seealso{lasterr} +## @end deftypefn + +function [msg, msgid] = __error_text__ (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "__error_text__ is obsolete and will be removed from a future version of Octave, please use lasterr instead"); + endif + + [msg, msgid] = lasterr (varargin{:}); + +endfunction
deleted file mode 100644 --- a/scripts/deprecated/complement.m +++ /dev/null @@ -1,78 +0,0 @@ -## Copyright (C) 1994-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} complement (@var{x}, @var{y}) -## Return the elements of set @var{y} that are not in set @var{x}. For -## example: -## -## @example -## @group -## complement ([ 1, 2, 3 ], [ 2, 3, 5 ]) -## @result{} 5 -## @end group -## @end example -## @seealso{union, intersect, unique} -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function y = complement (a, b) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "complement is obsolete and will be removed from a future version of Octave, please use setdiff instead"); - endif - - if (nargin != 2) - print_usage (); - endif - - if (isempty (a)) - y = unique (b); - elseif (isempty (b)) - y = []; - else - a = unique (a); - b = unique (b); - yindex = 1; - y = zeros (1, length (b)); - for index = 1:length (b) - if (all (a != b (index))) - y(yindex++) = b(index); - endif - endfor - y = y(1:(yindex-1)); - endif - -endfunction - -%!assert(all (all (complement ([1, 2, 3], [3; 4; 5; 6]) == [4, 5, 6]))); - -%!assert(all (all (complement ([1, 2, 3], [3, 4, 5, 6]) == [4, 5, 6]))); - -%!assert(isempty (complement ([1, 2, 3], [3, 2, 1]))); - -%!error complement (1); - -%!error complement (1, 2, 3); -
rename from scripts/statistics/base/cor.m rename to scripts/deprecated/cor.m --- a/scripts/statistics/base/cor.m +++ b/scripts/deprecated/cor.m @@ -27,6 +27,13 @@ function retval = cor (x, y = x) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cor is obsolete and will be removed from a future version of Octave; please use corr instead"); + endif + if (nargin < 1 || nargin > 2) print_usage (); endif @@ -35,6 +42,7 @@ endfunction + %!test %! x = rand (10, 2); %! assert (cor (x), corrcoef (x), 5*eps);
rename from scripts/statistics/base/corrcoef.m rename to scripts/deprecated/corrcoef.m --- a/scripts/statistics/base/corrcoef.m +++ b/scripts/deprecated/corrcoef.m @@ -48,20 +48,26 @@ function retval = corrcoef (x, y = []) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "corrcoef is not equivalent to Matlab and will be removed from a future version of Octave; for similar functionality see corr"); + endif + if (nargin < 1 || nargin > 2) print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) - error ("corrcoef: X and Y must be numeric matrices or vectors"); - endif + ## Input validation is done by cov.m. Don't repeat tests here - if (ndims (x) != 2 || ndims (y) != 2) - error ("corrcoef: X and Y must be 2-D matrices or vectors"); - endif - + ## Special case, scalar is always 100% correlated with itself if (isscalar (x)) - retval = 1; + if (isa (x, 'single')) + retval = single (1); + else + retval = 1; + endif return; endif @@ -79,20 +85,35 @@ endfunction + %!test %! x = rand (10); %! cc1 = corrcoef (x); %! cc2 = corrcoef (x, x); -%! assert((size (cc1) == [10, 10] && size (cc2) == [10, 10] -%! && abs (cc1 - cc2) < sqrt (eps))); +%! assert (size (cc1) == [10, 10] && size (cc2) == [10, 10]); +%! assert (cc1, cc2, sqrt (eps)); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (corrcoef (x,y), -1, 5*eps) +%! assert (corrcoef (x,flipud (y)), 1, 5*eps) +%! assert (corrcoef ([x, y]), [1 -1; -1 1], 5*eps) -%!assert(corrcoef (5), 1); +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (corrcoef (x,y), single (-1), 5*eps) +%! assert (corrcoef (x,flipud (y)), single (1), 5*eps) +%! assert (corrcoef ([x, y]), single ([1 -1; -1 1]), 5*eps) + +%!assert (corrcoef (5), 1); +%!assert (corrcoef (single(5)), single(1)); %% Test input validation %!error corrcoef (); %!error corrcoef (1, 2, 3); -%!error corrcoef ([true, true]); -%!error corrcoef ([1, 2], [true, true]); +%!error corrcoef ([1; 2], ["A", "B"]); %!error corrcoef (ones (2,2,2)); %!error corrcoef (ones (2,2), ones (2,2,2));
deleted file mode 100644 --- a/scripts/deprecated/create_set.m +++ /dev/null @@ -1,79 +0,0 @@ -## Copyright (C) 1994-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} create_set (@var{x}) -## @deftypefnx {Function File} {} create_set (@var{x}, "rows") -## This function has been deprecated. Use unique instead. -## @end deftypefn - -## Return a row vector containing the unique values in @var{x}, sorted in -## ascending order. For example, -## -## @example -## @group -## create_set ([ 1, 2; 3, 4; 4, 2; 1, 2 ]) -## @result{} [ 1, 2, 3, 4 ] -## @end group -## @end example -## -## If the optional second input argument is the string "rows" each row of -## the matrix @var{x} will be considered an element of set. For example, -## @example -## @group -## create_set ([ 1, 2; 3, 4; 4, 2; 1, 2 ], "rows") -## @result{} 1 2 -## 3 4 -## 4 2 -## @end group -## @end example -## @seealso{union, intersect, complement, unique} - -## Author: jwe - -## Deprecated in version 3.2 - -function y = create_set (x, rows_opt) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "create_set is obsolete and will be removed from a future version of Octave, please use unique instead"); - endif - - if (nargin < 1 || nargin > 2) - print_usage (); - endif - - if (nargin == 1) - y = unique (x)(:)'; - elseif (strcmpi (rows_opt, "rows")) - y = unique (x, "rows"); - else - error ("create_set: expecting \"rows\" as second argument"); - endif - -endfunction - -%!assert(all (all (create_set ([1, 2, 3, 4, 2, 4]) == [1, 2, 3, 4]))); -%!assert(all (all (create_set ([1, 2; 3, 4; 2, 4]) == [1, 2, 3, 4]))); -%!assert(all (all (create_set ([1; 2; 3; 4; 2; 4]) == [1, 2, 3, 4]))); -%!assert(isempty (create_set ([]))); -%!error create_set (1, 2); -
rename from scripts/statistics/base/cut.m rename to scripts/deprecated/cut.m --- a/scripts/statistics/base/cut.m +++ b/scripts/deprecated/cut.m @@ -37,6 +37,13 @@ function group = cut (x, breaks) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cut is obsolete and will be removed from a future version of Octave; please use histc instead"); + endif + if (nargin != 2) print_usage (); endif
deleted file mode 100644 --- a/scripts/deprecated/dmult.m +++ /dev/null @@ -1,49 +0,0 @@ -## Copyright (C) 1995-2011 Kurt Hornik -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} dmult (@var{a}, @var{b}) -## This function has been deprecated. Use the direct syntax @code{diag(A)*B} -## which is more readable and now also more efficient. -## @end deftypefn - -## Author: KH <Kurt.Hornik@wu-wien.ac.at> -## Description: Rescale the rows of a matrix - -## Deprecated in version 3.2 - -function M = dmult (a, B) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "dmult is obsolete and will be removed from a future version of Octave; please use the straightforward (and now efficient) syntax \"diag(A)*B\""); - endif - - if (nargin != 2) - print_usage (); - endif - if (! isvector (a)) - error ("dmult: a must be a vector of length rows (B)"); - endif - a = a(:); - sb = size (B); - sb(1) = 1; - M = repmat (a(:), sb) .* B; -endfunction
new file mode 100644 --- /dev/null +++ b/scripts/deprecated/error_text.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} error_text (@var{msg}, @var{msgid}) +## This function has been deprecated. Use @code{lasterr} instead. +## @seealso{lasterr} +## @end deftypefn + +function [msg, msgid] = error_text (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "error_text is obsolete and will be removed from a future version of Octave, please use lasterr instead"); + endif + + [msg, msgid] = lasterr (varargin{:}); + +endfunction
--- a/scripts/deprecated/glpkmex.m +++ b/scripts/deprecated/glpkmex.m @@ -32,7 +32,7 @@ warning ("Octave:deprecated-function", "glpkmex is obsolete and will be removed from a future version of Octave; please use glpk instead"); endif - + ## If there is no input output the version and syntax if (nargin < 4 || nargin > 11) print_usage ();
deleted file mode 100644 --- a/scripts/deprecated/iscommand.m +++ /dev/null @@ -1,44 +0,0 @@ -## Copyright (C) 2009-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Built-in Function} {} iscommand (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function retval = iscommand () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "iscommand is obsolete and will be removed from a future version of Octave"); - endif - - if (nargin == 0) - retval = {}; - else - retval = true; - endif - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/israwcommand.m +++ /dev/null @@ -1,44 +0,0 @@ -## Copyright (C) 2009-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Built-in Function} {} israwcommand (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function retval = israwcommand () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "israwcommand is obsolete and will be removed from a future version of Octave"); - endif - - if (nargin == 0) - retval = {}; - else - retval = true; - endif - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/lchol.m +++ /dev/null @@ -1,39 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Loadable Function} {@var{l} =} lchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{p}] =} lchol (@var{a}) -## This function has been deprecated. Use @code{chol (@dots{},'lower')} -## instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = lchol (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spfind is obsolete and will be removed from a future version of Octave; please use find instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = chol (varargin{:}, "lower"); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/loadimage.m +++ /dev/null @@ -1,43 +0,0 @@ -## Copyright (C) 1994-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {[@var{x}, @var{map}] =} loadimage (@var{file}) -## Load an image file and its associated color map from the specified -## @var{file}. The image must be stored in Octave's image format. -## @seealso{saveimage, load, save} -## @end deftypefn - -## Author: Tony Richardson <arichard@stark.cc.oh.us> -## Created: July 1994 -## Adapted-By: jwe - -## Deprecated in version 3.2 - -function [img_retval, map_retval] = loadimage (varargin) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "loadimage is obsolete and will be removed from a future version of Octave; please use imread instead"); - endif - - [img_retval, map_retval] = imread (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/mark_as_command.m +++ /dev/null @@ -1,38 +0,0 @@ -## Copyright (C) 2009-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Built-in Function} {} mark_as_command (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function mark_as_command () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "mark_as_command is obsolete and will be removed from a future version of Octave"); - endif - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/mark_as_rawcommand.m +++ /dev/null @@ -1,38 +0,0 @@ -## Copyright (C) 2009-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Built-in Function} {} mark_as_rawcommand (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function mark_as_rawcommand () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "mark_as_rawcommand is obsolete and will be removed from a future version of Octave"); - endif - -endfunction
--- a/scripts/deprecated/module.mk +++ b/scripts/deprecated/module.mk @@ -6,55 +6,29 @@ deprecated/betai.m \ deprecated/cellidx.m \ deprecated/clg.m \ - deprecated/complement.m \ - deprecated/create_set.m \ + deprecated/cor.m \ + deprecated/corrcoef.m \ deprecated/cquad.m \ + deprecated/cut.m \ deprecated/dispatch.m \ - deprecated/dmult.m \ deprecated/fstat.m \ deprecated/gammai.m \ deprecated/glpkmex.m \ deprecated/intwarning.m \ - deprecated/iscommand.m \ deprecated/is_duplicate_entry.m \ deprecated/is_global.m \ - deprecated/israwcommand.m \ deprecated/isstr.m \ - deprecated/lchol.m \ - deprecated/loadimage.m \ deprecated/krylovb.m \ - deprecated/mark_as_command.m \ - deprecated/mark_as_rawcommand.m \ deprecated/perror.m \ + deprecated/polyderiv.m \ deprecated/replot.m \ deprecated/saveimage.m \ deprecated/setstr.m \ - deprecated/spatan2.m \ - deprecated/spchol2inv.m \ - deprecated/spcholinv.m \ - deprecated/spchol.m \ - deprecated/spcumprod.m \ - deprecated/spcumsum.m \ - deprecated/spdet.m \ - deprecated/spdiag.m \ - deprecated/spfind.m \ deprecated/sphcat.m \ - deprecated/spinv.m \ - deprecated/spkron.m \ - deprecated/splchol.m \ - deprecated/split.m \ - deprecated/splu.m \ - deprecated/spmax.m \ - deprecated/spmin.m \ - deprecated/spprod.m \ - deprecated/spqr.m \ - deprecated/spsum.m \ - deprecated/spsumsq.m \ deprecated/spvcat.m \ - deprecated/str2mat.m \ deprecated/strerror.m \ - deprecated/unmark_command.m \ - deprecated/unmark_rawcommand.m \ + deprecated/studentize.m \ + deprecated/sylvester_matrix.m \ deprecated/values.m \ deprecated/weibcdf.m \ deprecated/weibinv.m \
rename from scripts/polynomial/polyderiv.m rename to scripts/deprecated/polyderiv.m --- a/scripts/polynomial/polyderiv.m +++ b/scripts/deprecated/polyderiv.m @@ -36,6 +36,13 @@ function [q, d] = polyderiv (p, a) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "polyderiv is obsolete and will be removed from a future version of Octave; please use polyder instead"); + endif + if (nargin == 1 || nargin == 2) if (! isvector (p)) error ("polyderiv: argument must be a vector");
--- a/scripts/deprecated/saveimage.m +++ b/scripts/deprecated/saveimage.m @@ -30,8 +30,7 @@ ## Portable pixmap format. ## ## @item "ps" -## PostScript format. Note that images saved in PostScript format cannot -## be read back into Octave with loadimage. +## PostScript format. ## @end table ## ## If the fourth argument is supplied, the specified colormap will also be @@ -42,7 +41,7 @@ ## image is a gray scale image (the entries within each row of the colormap ## are equal) the gray scale ppm and PostScript image formats are used, ## otherwise the full color formats are used. -## @seealso{loadimage, save, load, colormap} +## @seealso{imread, save, load, colormap} ## @end deftypefn ## The conversion to PostScript is based on pbmtolps.c, which was
deleted file mode 100644 --- a/scripts/deprecated/spatan2.m +++ /dev/null @@ -1,36 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spatan2 (@var{y}, @var{x}) -## This function has been deprecated. Use @code{atan2} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spatan2 (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spatan2 is obsolete and will be removed from a future version of Octave; please use atan2 instead"); - endif - - retval = atan2 (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spchol.m +++ /dev/null @@ -1,39 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Loadable Function} {@var{r} =} spchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{r}, @var{p}] =} spchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{r}, @var{p}, @var{q}] =} spchol (@var{a}) -## This function has been deprecated. Use @code{chol} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spchol (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spchol is obsolete and will be removed from a future version of Octave; please use chol instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = chol (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spchol2inv.m +++ /dev/null @@ -1,36 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spchol2inv (@var{u}) -## This function has been deprecated. Use @code{chol2inv} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spchol2inv (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spchol2inv is obsolete and will be removed from a future version of Octave; please use chol2inv instead"); - endif - - retval = chol2inv (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spcholinv.m +++ /dev/null @@ -1,35 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spcholinv (@var{u}) -## This function has been deprecated. Use @code{cholinv} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spcholinv (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spcholinv is obsolete and will be removed from a future version of Octave; please use cholinv instead"); - endif - retval = cholinv (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spcumprod.m +++ /dev/null @@ -1,36 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spcumprod (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{cumprod} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spcumprod (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spcumprod is obsolete and will be removed from a future version of Octave; please use cumprod instead"); - endif - - retval = cumprod (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spcumsum.m +++ /dev/null @@ -1,36 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spcumsum (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{cumsum} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spcumsum (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spcumsum is obsolete and will be removed from a future version of Octave; please use cumsum instead"); - endif - - retval = cumsum (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spdet.m +++ /dev/null @@ -1,37 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Loadable Function} {[@var{d}, @var{rcond}] =} spdet (@var{a}) -## This function has been deprecated. Use @code{det} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spdet (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spdet is obsolete and will be removed from a future version of Octave; please use det instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = det (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spdiag.m +++ /dev/null @@ -1,37 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spdiag (@var{v}, @var{k}) -## This function has been deprecated. Use @code{sparse (diag (@dots{}))} -## instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spdiag (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spdiag is obsolete and will be removed from a future version of Octave; please use sparse (diag (...)) instead"); - endif - - retval = sparse (diag (varargin{:})); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spfind.m +++ /dev/null @@ -1,40 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Loadable Function} {} spfind (@var{x}) -## @deftypefnx {Loadable Function} {} spfind (@var{x}, @var{n}) -## @deftypefnx {Loadable Function} {} spfind (@var{x}, @var{n}, @var{direction}) -## @deftypefnx {Loadable Function} {[@var{i}, @var{j}, @var{v}} spfind (@dots{}) -## This function has been deprecated. Use @code{find} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spfind (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spfind is obsolete and will be removed from a future version of Octave; please use find instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = find (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spinv.m +++ /dev/null @@ -1,37 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {[@var{x}, @var{rcond}] =} spinv (@var{a}) -## This function has been deprecated. Use @code{inv} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spinv (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spinv is obsolete and will be removed from a future version of Octave; please use inv instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = inv (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spkron.m +++ /dev/null @@ -1,38 +0,0 @@ -## Copyright (C) 2008-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spkron (@var{a}, @var{b}) -## This function has been deprecated. Use @code{kron} instead. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function retval = spkron (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spkron is obsolete and will be removed from a future version of Octave; please use kron instead"); - endif - - retval = kron (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/splchol.m +++ /dev/null @@ -1,40 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Loadable Function} {@var{l} =} splchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{p}] =} splchol (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{p}, @var{q}] =} splchol (@var{a}) -## This function has been deprecated. Use @code{chol (@dots{},'lower')} -## instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = splchol (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "splchol is obsolete and will be removed from a future version of Octave; please use chol instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = chol (varargin{:}, "lower"); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/split.m +++ /dev/null @@ -1,130 +0,0 @@ -## Copyright (C) 1996-2011 Kurt Hornik -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} split (@var{s}, @var{t}, @var{n}) -## This function has been deprecated. Use @code{char (strsplit (s, t))} -## instead. -## @end deftypefn - -## Divides the string @var{s} into pieces separated by @var{t}, returning -## the result in a string array (padded with blanks to form a valid -## matrix). If the optional input @var{n} is supplied, split @var{s} -## into at most @var{n} different pieces. -## -## For example, -## -## @example -## split ("Test string", "t") -## @result{} -## "Tes " -## " s " -## "ring" -## @end example -## -## @example -## split ("Test string", "t s", 2) -## @result{} -## "Tes " -## "tring" -## @end example -## @seealso{strtok, index} -## @end deftypefn - -## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> -## Adapted-By: jwe - -## Deprecated in version 3.2 - -function m = split (s, t, n) - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "split is obsolete and will be removed from a future version of Octave; please use strsplit instead"); - endif - - if (nargin == 2 || nargin == 3) - if (nargin == 2) - n = length (s); - endif - - if (ischar (s) && ischar (t)) - - l_s = length (s); - l_t = length (t); - - if (l_s == 0) - m = ""; - return; - elseif (l_t == 0) - m = s'; - return; - elseif (l_s < l_t) - error ("split: S must not be shorter than T"); - endif - - if (min (size (s)) != 1 || min (size (t)) != 1) - error("split: multi-line strings are not supported"); - endif - - ind = findstr (s, t, 0); - if (length (ind) == 0) - m = s; - return; - elseif (n - 1 < length(ind)) - ind = ind(1:n-1); - endif - ind2 = [1, ind+l_t]; - ind = [ind, l_s+1]; - - ind_diff = ind-ind2; - - ## Create a matrix of the correct size that's filled with spaces. - m_rows = length (ind); - m_cols = max (ind_diff); - m = repmat (" ", m_rows, m_cols); - - ## Copy the strings to the matrix. - for i = 1:length (ind) - tmp = ind2(i):(ind(i)-1); - m(i,1:length(tmp)) = s(tmp); - endfor - else - error ("split: both S and T must be strings"); - endif - else - print_usage (); - endif - -endfunction - -%!assert(all (all (split ("Test string", "t") == ["Tes "; " s "; "ring"]))); - -%!error split (); - -%!assert(all (strcmp (split ("foo bar baz", " ", 2), ["foo"; "bar baz"]))); - -%!error split ("foo", "bar", 3, 4); - -%!assert (all (strcmp (split("road//to/hell","/"), ["road"; " "; "to "; "hell"]))) - -%!assert (all (strcmp (split("/road/to/hell/","/"), [" "; "road"; "to "; "hell"; " "]))) - -
deleted file mode 100644 --- a/scripts/deprecated/splu.m +++ /dev/null @@ -1,48 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Loadable Function} {[@var{l}, @var{u}] =} splu (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}] =} splu (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}, @var{Q}] =} splu (@var{a}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}, @var{Q}] =} splu (@dots{}, @var{thres}) -## @deftypefnx {Loadable Function} {[@var{l}, @var{u}, @var{P}] =} splu (@dots{}, @var{Q}) -## This function has been deprecated. Use @code{lu} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = splu (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "splu is obsolete and will be removed from a future version of Octave; please use lu instead"); - endif - - for i = 2 : nargin - arg = varargin {i}; - if (! isscalar (arg)) - error ("splu: Can no longer treat input column permutations"); - endif - endfor - - varargout = cell (nargout, 1); - [ varargout{:} ] = lu (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spmax.m +++ /dev/null @@ -1,38 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Mapping Function} {} spmax (@var{x}, @var{y}, @var{dim}) -## @deftypefnx {Mapping Function} {[@var{w}, @var{iw}] =} spmax (@var{x}) -## This function has been deprecated. Use @code{max} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spmax (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spmax is obsolete and will be removed from a future version of Octave; please use max instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = max (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spmin.m +++ /dev/null @@ -1,38 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Mapping Function} {} spmin (@var{x}, @var{y}, @var{dim}) -## @deftypefnx {Mapping Function} {[@var{w}, @var{iw}] =} spmin (@var{x}) -## This function has been deprecated. Use @code{min} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spmin (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spmin is obsolete and will be removed from a future version of Octave; please use min instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = min (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spprod.m +++ /dev/null @@ -1,36 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spprod (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{prod} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spprod (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spprod is obsolete and will be removed from a future version of Octave; please use prod instead"); - endif - - retval = prod (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spqr.m +++ /dev/null @@ -1,40 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Loadable Function} {@var{r} =} spqr (@var{a}) -## @deftypefnx {Loadable Function} {@var{r} =} spqr (@var{a}, 0) -## @deftypefnx {Loadable Function} {[@var{c}, @var{r}] =} spqr (@var{a}, @var{b}) -## @deftypefnx {Loadable Function} {[@var{c}, @var{r}] =} spqr (@var{a}, @var{b}, 0) -## This function has been deprecated. Use @code{qr} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function varargout = spqr (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spqr is obsolete and will be removed from a future version of Octave; please use qr instead"); - endif - - varargout = cell (nargout, 1); - [ varargout{:} ] = qr (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spsum.m +++ /dev/null @@ -1,36 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spsum (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{sum} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spsum (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spsum is obsolete and will be removed from a future version of Octave; please use sum instead"); - endif - - retval = sum (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/spsumsq.m +++ /dev/null @@ -1,35 +0,0 @@ -## Copyright (C) 2008-2011 David Bateman -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} spsumsq (@var{x}, @var{dim}) -## This function has been deprecated. Use @code{sumsq} instead. -## @end deftypefn - -## Deprecated in version 3.2 - -function retval = spsumsq (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "spsumsq is obsolete and will be removed from a future version of Octave; please use sumsq instead"); - endif - retval = sumsq (varargin{:}); - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/str2mat.m +++ /dev/null @@ -1,45 +0,0 @@ -## Copyright (C) 1996-2011 Kurt Hornik -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} str2mat (@var{s_1}, @dots{}, @var{s_n}) -## Return a matrix containing the strings @var{s_1}, @dots{}, @var{s_n} as -## its rows. Each string is padded with blanks in order to form a valid -## matrix. -## -## This function is modelled after @sc{matlab}. In Octave, you can create -## a matrix of strings by @code{[@var{s_1}; @dots{}; @var{s_n}]} even if -## the strings are not all the same length. -## @end deftypefn - -## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> -## Adapted-By: jwe - -## Deprecated in version 3.2 - -function retval = str2mat (varargin) - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "str2mat is obsolete and will be removed from a future version of Octave; please use char instead"); - endif - - retval = char (varargin{:}); - -endfunction
rename from scripts/statistics/base/studentize.m rename to scripts/deprecated/studentize.m --- a/scripts/statistics/base/studentize.m +++ b/scripts/deprecated/studentize.m @@ -32,6 +32,12 @@ ## Description: Subtract mean and divide by standard deviation function t = studentize (x, dim) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "studentize is obsolete and will be removed from a future version of Octave; please use zscore instead"); + endif if (nargin != 1 && nargin != 2) print_usage ();
rename from scripts/special-matrix/sylvester_matrix.m rename to scripts/deprecated/sylvester_matrix.m --- a/scripts/special-matrix/sylvester_matrix.m +++ b/scripts/deprecated/sylvester_matrix.m @@ -33,6 +33,13 @@ function retval = sylvester_matrix (k) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "sylvester_matrix is obsolete and will be removed from a future version of Octave; please use hadamard(2^k) instead"); + endif + if (nargin != 1) print_usage (); endif
deleted file mode 100644 --- a/scripts/deprecated/unmark_command.m +++ /dev/null @@ -1,38 +0,0 @@ -## Copyright (C) 2009-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Built-in Function} {} unmark_command (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function unmark_command () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "unmark_command is obsolete and will be removed from a future version of Octave"); - endif - -endfunction
deleted file mode 100644 --- a/scripts/deprecated/unmark_rawcommand.m +++ /dev/null @@ -1,38 +0,0 @@ -## Copyright (C) 2009-2011 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Built-in Function} {} unmark_rawcommand (@var{name}) -## This function is obsolete and will be removed from a future -## version of Octave. -## @end deftypefn - -## Author: jwe - -## Deprecated in version 3.2 - -function unmark_rawcommand () - - persistent warned = false; - if (! warned) - warned = true; - warning ("Octave:deprecated-function", - "unmark_rawcommand is obsolete and will be removed from a future version of Octave"); - endif - -endfunction
--- a/scripts/elfun/cosd.m +++ b/scripts/elfun/cosd.m @@ -32,7 +32,7 @@ I = x / 180; y = cos (I .* pi); I = I + 0.5; - y(I == round (I) & finite (I)) = 0; + y(I == fix (I) & finite (I)) = 0; endfunction %!error(cosd())
--- a/scripts/elfun/module.mk +++ b/scripts/elfun/module.mk @@ -20,7 +20,6 @@ elfun/csc.m \ elfun/cscd.m \ elfun/csch.m \ - elfun/lcm.m \ elfun/sec.m \ elfun/secd.m \ elfun/sech.m \
--- a/scripts/elfun/sind.m +++ b/scripts/elfun/sind.m @@ -31,7 +31,7 @@ endif I = x / 180; y = sin (I .* pi); - y(I == round (I) & finite (I)) = 0; + y(I == fix (I) & finite (I)) = 0; endfunction %!error(sind())
--- a/scripts/elfun/tand.m +++ b/scripts/elfun/tand.m @@ -33,8 +33,8 @@ I0 = x / 180; I90 = (x-90) / 180; y = tan (I0 .* pi); - y(I0 == round (I0) & finite (I0)) = 0; - y(I90 == round (I90) & finite (I90)) = Inf; + y(I0 == fix (I0) & finite (I0)) = 0; + y(I90 == fix (I90) & finite (I90)) = Inf; endfunction; %!error(tand())
--- a/scripts/general/accumarray.m +++ b/scripts/general/accumarray.m @@ -31,7 +31,9 @@ ## The size of the matrix will be determined by the subscripts ## themselves. However, if @var{sz} is defined it determines the matrix ## size. The length of @var{sz} must correspond to the number of columns -## in @var{subs}. +## in @var{subs}. An exception is if @var{subs} has only one column, in +## which case @var{sz} may be the dimensions of a vector and the subscripts +## of @var{subs} are taken as the indices into it. ## ## The default action of @code{accumarray} is to sum the elements with ## the same subscripts. This behavior can be modified by defining the @@ -40,8 +42,14 @@ ## function should not depend on the order of the subscripts. ## ## The elements of the returned array that have no subscripts associated -## with them are set to zero. Defining @var{fillval} to some other -## value allows these values to be defined. +## with them are set to zero. Defining @var{fillval} to some other value +## allows these values to be defined. This behaviour changes, however, +## for certain values of @var{func}. If @var{func} is @code{min} +## (respectively, @code{max}) then the result will be filled with the +## minimum (respectively, maximum) integer if @var{vals} is of integral +## type, logical false (respectively, logical true) if @var{vals} is of +## logical type, zero if @var{fillval} is zero and all values are +## nonpositive (respectively, nonnegative), and NaN otherwise. ## ## By default @code{accumarray} returns a full matrix. If ## @var{issparse} is logically true, then a sparse matrix is returned @@ -100,7 +108,7 @@ endif if (iscell (subs)) - subs = cellfun (@vec, subs, "uniformoutput", false); + subs = cellfun ("vec", subs, "uniformoutput", false); ndims = numel (subs); if (ndims == 1) subs = subs{1}; @@ -166,7 +174,14 @@ if (isempty (sz)) A = sparse (subs(:,1), subs(:,2), vals, mode); elseif (length (sz) == 2) - A = sparse (subs(:,1), subs(:,2), vals, sz(1), sz(2), mode); + + ## Row vector case + if (sz(1) == 1) + [i, j] = deal (subs(:,2), subs(:,1)); + else + [i, j] = deal (subs(:,1), subs(:,2)); + endif + A = sparse (i, j, vals, sz(1), sz(2), mode); else error ("accumarray: dimensions mismatch"); endif @@ -177,7 +192,7 @@ if (ndims > 1) if (isempty (sz)) if (iscell (subs)) - sz = cellfun (@max, subs); + sz = cellfun ("max", subs); else sz = max (subs, [], 1); endif @@ -248,6 +263,9 @@ zero = intmax (class (vals)); elseif (islogical (vals)) zero = true; + elseif (fillval == 0 && all (vals(:) <= 0)) + ## This is a common case - fillval is zero, all numbers nonpositive. + zero = 0; else zero = NaN; # Neutral value. endif @@ -313,6 +331,10 @@ %!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2 4],@prod,0,true),sparse([1,2,2],[1,1,3],[101,10608,10815],2,4)) %!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],1,[2,4]), [1,0,0,0;2,0,2,0]) %!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2,4],@(x)length(x)>1),[false,false,false,false;true,false,true,false]) +%!assert (accumarray ([1; 2], [3; 4], [2, 1], @min, [], 0), [3; 4]) +%!assert (accumarray ([1; 2], [3; 4], [2, 1], @min, [], 1), sparse ([3; 4])) +%!assert (accumarray ([1; 2], [3; 4], [1, 2], @min, [], 0), [3, 4]) +%!assert (accumarray ([1; 2], [3; 4], [1, 2], @min, [], 1), sparse ([3, 4])) %!test %! A = accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2,4],@(x){x}); %! assert (A{2},[102;104])
--- a/scripts/general/accumdim.m +++ b/scripts/general/accumdim.m @@ -42,12 +42,12 @@ ## ## An example of the use of @code{accumdim} is: ## -## @example +## @smallexample ## @group ## accumdim ([1, 2, 1, 2, 1], [7,-10,4;-5,-12,8;-12,2,8;-10,9,-3;-5,-3,-13]) ## @result{} ans = [-10,-11,-1;-15,-3,5] ## @end group -## @end example +## @end smallexample ## ## @seealso{accumarray} ## @end deftypefn
deleted file mode 100644 --- a/scripts/general/arrayfun.m +++ /dev/null @@ -1,347 +0,0 @@ -## Copyright (C) 2006-2011 Bill Denney -## Copyright (C) 2009 Jaroslav Hajek -## -## 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 -## <http://www.gnu.org/licenses/>. - -## -*- texinfo -*- -## @deftypefn {Function File} {} arrayfun (@var{func}, @var{A}) -## @deftypefnx {Function File} {@var{x} =} arrayfun (@var{func}, @var{A}) -## @deftypefnx {Function File} {@var{x} =} arrayfun (@var{func}, @var{A}, @var{b}, @dots{}) -## @deftypefnx {Function File} {[@var{x}, @var{y}, @dots{}] =} arrayfun (@var{func}, @var{A}, @dots{}) -## @deftypefnx {Function File} {} arrayfun (@dots{}, "UniformOutput", @var{val}) -## @deftypefnx {Function File} {} arrayfun (@dots{}, "ErrorHandler", @var{errfunc}) -## -## Execute a function on each element of an array. This is useful for -## functions that do not accept array arguments. If the function does -## accept array arguments it is better to call the function directly. -## -## The first input argument @var{func} can be a string, a function -## handle, an inline function, or an anonymous function. The input -## argument @var{A} can be a logic array, a numeric array, a string -## array, a structure array, or a cell array. By a call of the function -## @command{arrayfun} all elements of @var{A} are passed on to the named -## function @var{func} individually. -## -## The named function can also take more than two input arguments, with -## the input arguments given as third input argument @var{b}, fourth -## input argument @var{c}, @dots{} If given more than one array input -## argument then all input arguments must have the same sizes, for -## example: -## -## @example -## @group -## arrayfun (@@atan2, [1, 0], [0, 1]) -## @result{} ans = [1.5708 0.0000] -## @end group -## @end example -## -## If the parameter @var{val} after a further string input argument -## "UniformOutput" is set @code{true} (the default), then the named -## function @var{func} must return a single element which then will be -## concatenated into the return value and is of type matrix. Otherwise, -## if that parameter is set to @code{false}, then the outputs are -## concatenated in a cell array. For example: -## -## @example -## @group -## arrayfun (@@(x,y) x:y, "abc", "def", "UniformOutput", false) -## @result{} ans = -## @{ -## [1,1] = abcd -## [1,2] = bcde -## [1,3] = cdef -## @} -## @end group -## @end example -## -## If more than one output arguments are given then the named function -## must return the number of return values that also are expected, for -## example: -## -## @example -## @group -## [A, B, C] = arrayfun (@@find, [10; 0], "UniformOutput", false) -## @result{} -## A = -## @{ -## [1,1] = 1 -## [2,1] = [](0x0) -## @} -## B = -## @{ -## [1,1] = 1 -## [2,1] = [](0x0) -## @} -## C = -## @{ -## [1,1] = 10 -## [2,1] = [](0x0) -## @} -## @end group -## @end example -## -## If the parameter @var{errfunc} after a further string input argument -## "ErrorHandler" is another string, a function handle, an inline -## function, or an anonymous function, then @var{errfunc} defines a -## function to call in the case that @var{func} generates an error. -## The definition of the function must be of the form -## -## @example -## function [@dots{}] = errfunc (@var{s}, @dots{}) -## @end example -## -## @noindent -## where there is an additional input argument to @var{errfunc} -## relative to @var{func}, given by @var{s}. This is a structure with -## the elements "identifier", "message", and "index" giving, -## respectively, the error identifier, the error message, and the index of -## the array elements that caused the error. The size of the output -## argument of @var{errfunc} must have the same size as the output -## argument of @var{func}, otherwise a real error is thrown. For -## example: -## -## @example -## @group -## function y = ferr (s, x), y = "MyString"; endfunction -## arrayfun (@@str2num, [1234], \ -## "UniformOutput", false, "ErrorHandler", @@ferr) -## @result{} ans = -## @{ -## [1,1] = MyString -## @} -## @end group -## @end example -## -## @seealso{spfun, cellfun, structfun} -## @end deftypefn - -## Author: Bill Denney <denney@seas.upenn.edu> -## Rewritten: Jaroslav Hajek <highegg@gmail.com> - -function varargout = arrayfun (func, varargin) - - if (nargin < 2) - print_usage (); - endif - - nargs = length (varargin); - - recognized_opts = {"UniformOutput", "ErrorHandler"}; - - while (nargs >= 2) - maybeopt = varargin{nargs-1}; - if (ischar (maybeopt) && any (strcmpi (maybeopt, recognized_opts))) - nargs -= 2; - else - break; - endif - endwhile - - args = varargin(1:nargs); - opts = varargin(nargs+1:end); - - args = cellfun (@num2cell, args, "UniformOutput", false, - "ErrorHandler", @arg_class_error); - - [varargout{1:max(1, nargout)}] = cellfun (func, args{:}, opts{:}); - -endfunction - -function arg_class_error (S, X) - error ("arrayfun: invalid argument of class %s", class (X)); -endfunction - -%% Test function to check the "Errorhandler" option -%!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 -%!error -%! arrayfun (@isequal); %% One or less input arguments -%!test -%! 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]); -%!test -%! 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]); - -%% Number of input and output arguments may be greater than one -%#!test -%! 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); -%!test %% Two input arguments of different types -%! 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); -%!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})); - -%% Input arguments can be of type logical -%!test -%! 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]); -%!test -%! 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})); -%!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); -%!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); - -%% 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]); -%!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]); -%!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])); -%!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})); -%!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]); -%!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]); - -%% 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]); -%!test -%! 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); - -%% 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); -%!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); -%!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]})); -%!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); -%!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); - -%% 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]); -%!test -%! 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}); -%!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]); -%!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]); - -## Local Variables: *** -## mode: octave *** -## End: ***
--- a/scripts/general/bitget.m +++ b/scripts/general/bitget.m @@ -79,3 +79,31 @@ C = bitand (A, bitshift (_conv (1), uint8 (n) - uint8 (1))) != _conv (0); endfunction + +%!error bitget (1); +%!error bitget (1, 2, 3); + +%!test +%! assert (bitget ([4, 14], [3, 3]), logical ([1, 1])); +%! pfx = {"", "u"}; +%! for i = 1:2 +%! for prec = [8, 16, 32, 64] +%! fcn = str2func (sprintf ("%sint%d", pfx{i}, prec)); +%! assert (bitget (fcn ([4, 14]), [3, 3]), logical ([1, 1])); +%! endfor +%! endfor + +%!error bitget (0, 0); +%!error bitget (0, 55); + +%!error bitget (int8 (0), 9); +%!error bitget (uint8 (0), 9); + +%!error bitget (int16 (0), 17); +%!error bitget (uint16 (0), 17); + +%!error bitget (int32 (0), 33); +%!error bitget (uint32 (0), 33); + +%!error bitget (int64 (0), 65); +%!error bitget (uint64 (0), 65);
--- a/scripts/general/bitset.m +++ b/scripts/general/bitset.m @@ -92,3 +92,31 @@ endif endfunction + +%!error bitset (1); +%!error bitset (1, 2, 3, 4); + +%!test +%! assert (bitset ([0, 10], [3, 3]), [4, 14]); +%! pfx = {"", "u"}; +%! for i = 1:2 +%! for prec = [8, 16, 32, 64] +%! fcn = str2func (sprintf ("%sint%d", pfx{i}, prec)); +%! assert (bitset (fcn ([0, 10]), [3, 3]), fcn ([4, 14])); +%! endfor +%! endfor + +%!error bitset (0, 0); +%!error bitset (0, 55); + +%!error bitset (int8 (0), 9); +%!error bitset (uint8 (0), 9); + +%!error bitset (int16 (0), 17); +%!error bitset (uint16 (0), 17); + +%!error bitset (int32 (0), 33); +%!error bitset (uint32 (0), 33); + +%!error bitset (int64 (0), 65); +%!error bitset (uint64 (0), 65);
--- a/scripts/general/blkdiag.m +++ b/scripts/general/blkdiag.m @@ -20,8 +20,9 @@ ## @deftypefn {Function File} {} blkdiag (@var{A}, @var{B}, @var{C}, @dots{}) ## Build a block diagonal matrix from @var{A}, @var{B}, @var{C}, @dots{} ## All the arguments must be numeric and are two-dimensional matrices or -## scalars. -## @seealso{diag, horzcat, vertcat} +## scalars. If any argument is of type sparse, the output will also be +## sparse. +## @seealso{diag, horzcat, vertcat, sparse} ## @end deftypefn ## Author: Daniel Calvelo @@ -33,7 +34,7 @@ print_usage (); endif - if (! all (cellfun (@isnumeric, varargin))) + if (! all (cellfun ("isnumeric", varargin))) error ("blkdiag: all arguments must be numeric"); endif @@ -46,7 +47,12 @@ ## calling size directly. tmp = cell2mat (cellfun (@size, varargin', "uniformoutput", false)); csz = cumsum ([0 0; tmp], 1); - retval = zeros (csz(end,:)); + + if (any (cellfun ("issparse", varargin))) + retval = sparse (csz(end,1), csz(end,2)); + else + retval = zeros (csz(end,:)); + endif for p = 1:nargin vp = varargin{p}; @@ -57,15 +63,18 @@ endfunction -# regular tests +## regular tests %!assert(blkdiag(1,ones(2),1),[1,0,0,0;0,1,1,0;0,1,1,0;0,0,0,1]) %!assert(blkdiag([1,2],[3,4],[5,6]),[1,2,0,0,0,0;0,0,3,4,0,0;0,0,0,0,5,6]) %!assert(blkdiag([1,2],[3;4],[5,6]),[1,2,0,0,0;0,0,3,0,0;0,0,4,0,0;0,0,0,5,6]) %!assert(blkdiag([1,2;3,4],[5,6,7]),[1,2,0,0,0;3,4,0,0,0;0,0,5,6,7]) -# tests involving empty matrices +## tests involving empty matrices %!assert(blkdiag([],[],[]),[]) %!assert(blkdiag([],[1,2;3,4],[],5,[]),[1,2,0;3,4,0;0,0,5]) %!assert(blkdiag(zeros(1,0,1),[1,2,3],1,0,5,zeros(0,1,1)),[0,0,0,0,0,0,0;1,2,3,0,0,0,0;0,0,0,1,0,0,0;0,0,0,0,0,0,0;0,0,0,0,0,5,0]); +## tests involving sparse matrices +%!assert (blkdiag (sparse([1,2;3,4]),[5,6;7,8]), sparse([1,2,0,0;3,4,0,0;0,0,5,6;0,0,7,8])) +%!assert (blkdiag (sparse([1,2;3,4]),[5,6]), sparse([1,2,0,0;3,4,0,0;0,0,5,6])) # sanity checks %!test %! A = rand (round (rand (1, 2) * 10));
--- a/scripts/general/cell2mat.m +++ b/scripts/general/cell2mat.m @@ -43,11 +43,11 @@ else ## We only want numeric, logical, and char matrices. - valid = cellfun (@isnumeric, c); - valid |= cellfun (@islogical, c); - valid |= cellfun (@ischar, c); - validc = cellfun (@iscell, c); - valids = cellfun (@isstruct, c); + valid = cellfun ("isnumeric", c); + valid |= cellfun ("islogical", c); + valid |= cellfun ("isclass", c, "char"); + validc = cellfun ("isclass", c, "cell"); + valids = cellfun ("isclass", c, "struct"); if (! all (valid(:)) && ! all (validc(:)) && ! all (valids(:))) error ("cell2mat: wrong type elements or mixed cells, structs and matrices"); @@ -71,7 +71,7 @@ endif xdim = [1:idim-1, idim+1:nd]; cc = num2cell (c, xdim); - c = cellfun (@cat, {idim}, cc{:}, "uniformoutput", false); + c = cellfun ("cat", {idim}, cc{:}, "uniformoutput", false); endfor m = c{1}; endif
--- a/scripts/general/celldisp.m +++ b/scripts/general/celldisp.m @@ -80,4 +80,8 @@ %!demo %! c = {1, 2, {31, 32}}; -%! celldisp(c, "b") \ No newline at end of file +%! celldisp(c, "b") + +%!error celldisp (); +%!error celldisp ({}, "name", 1); +%!error celldisp (1);
--- a/scripts/general/circshift.m +++ b/scripts/general/circshift.m @@ -47,53 +47,58 @@ function y = circshift (x, n) - if (nargin == 2) - if (isempty (x)) - y = x; - else - nd = ndims (x); - sz = size (x); - - if (! isvector (n) && length (n) > nd) - error ("circshift: N must be a vector, no longer than the number of dimension in X"); - endif - - if (any (n != floor (n))) - error ("circshift: all values of N must be integers"); - endif - - idx = cell (); - for i = 1:length (n); - nn = n(i); - if (nn < 0) - while (sz(i) <= -nn) - nn = nn + sz(i); - endwhile - idx{i} = [(1-nn):sz(i), 1:-nn]; - else - while (sz(i) <= nn) - nn = nn - sz(i); - endwhile - idx{i} = [(sz(i)-nn+1):sz(i), 1:(sz(i)-nn)]; - endif - endfor - for i = (length(n) + 1) : nd - idx{i} = 1:sz(i); - endfor - y = x(idx{:}); - endif - else + if (nargin != 2) print_usage (); endif + + if (isempty (x)) + y = x; + return; + endif + + nd = ndims (x); + sz = size (x); + + if (! isvector (n) || length (n) > nd) + error ("circshift: N must be a vector, no longer than the number of dimension in X"); + elseif (any (n != fix (n))) + error ("circshift: all values of N must be integers"); + endif + + idx = repmat ({':'}, 1, nd); + for i = 1:length (n); + b = n(i); + d = sz(i); + if (b > 0) + b = rem (b, d); + idx{i} = [d-b+1:d, 1:d-b]; + elseif (b < 0) + b = rem (abs (b), d); + idx{i} = [b+1:d, 1:b]; + endif + endfor + + y = x(idx{:}); + endfunction + %!shared x %! x = [1, 2, 3; 4, 5, 6; 7, 8, 9]; %!assert (circshift (x, 1), [7, 8, 9; 1, 2, 3; 4, 5, 6]) %!assert (circshift (x, -2), [7, 8, 9; 1, 2, 3; 4, 5, 6]) -%!assert (circshift (x, [0, 1]), [3, 1, 2; 6, 4, 5; 9, 7, 8]); -%!assert (circshift ([],1), []) +%!assert (circshift (x, [0, 1]), [3, 1, 2; 6, 4, 5; 9, 7, 8]) +%!assert (circshift ([], 1), []) + +%!assert (circshift (eye (3), 1), circshift (eye (3), 1)) +%!assert (circshift (eye (3), 1), [0,0,1;1,0,0;0,1,0]) -%!assert (full (circshift (eye (3), 1)), circshift (full (eye (3)), 1)) -%!assert (full (circshift (eye (3), 1)), [0,0,1;1,0,0;0,1,0]) +%% Test input validation +%!error circshift () +%!error circshift (1) +%!error circshift (1,2,3) +%!error circshift (1, ones(2,2)) +%!error circshift (1, [1 2 3]) +%!error circshift (1, 1.5) +
--- a/scripts/general/colon.m +++ b/scripts/general/colon.m @@ -38,3 +38,7 @@ error ("colon: not defined for class \"%s\"", class(varargin{1})); endif endfunction + +%!error colon (1) + +## FIXME -- what does colon () mean since it doesn't set a return value?
--- a/scripts/general/common_size.m +++ b/scripts/general/common_size.m @@ -52,7 +52,7 @@ endif ## Find scalar args. - nscal = cellfun (@numel, varargin) != 1; + nscal = cellfun ("numel", varargin) != 1; i = find (nscal, 1); @@ -60,7 +60,7 @@ errorcode = 0; varargout = varargin; else - match = cellfun (@size_equal, varargin, varargin(i)); + match = cellfun ("size_equal", varargin, varargin(i)); if (any (nscal &! match)) errorcode = 1; varargout = varargin; @@ -78,3 +78,13 @@ endif endif endfunction + +%!error common_size (); + +%!test +%! m = [1,2;3,4]; +%! [err, a, b, c] = common_size (m, 3, 5); +%! assert (err, 0); +%! assert (a, m); +%! assert (b, [3,3;3,3]); +%! assert (c, [5,5;5,5]);
--- a/scripts/general/dblquad.m +++ b/scripts/general/dblquad.m @@ -37,22 +37,23 @@ ## ## The optional argument @var{quadf} specifies which underlying integrator ## function to use. Any choice but @code{quad} is available and the default -## is @code{quadgk}. +## is @code{quadcc}. ## ## Additional arguments, are passed directly to @var{f}. To use the default -## value for @var{tol} or @var{quadf} one may pass an empty matrix ([]). +## value for @var{tol} or @var{quadf} one may pass ':' or an empty matrix ([]). ## @seealso{triplequad, quad, quadv, quadl, quadgk, quadcc, trapz} ## @end deftypefn -function q = dblquad(f, xa, xb, ya, yb, tol, quadf, varargin) +function q = dblquad (f, xa, xb, ya, yb, tol = 1e-6, quadf = @quadcc, varargin) + if (nargin < 5) print_usage (); endif - if (nargin < 6 || isempty (tol)) + if (isempty (tol)) tol = 1e-6; endif - if (nargin < 7 || isempty (quadf)) - quadf = @quadgk; + if (isempty (quadf)) + quadf = @quadcc; endif inner = @__dblquad_inner__; @@ -72,10 +73,10 @@ endfor endfunction -%% Nasty integrand to show quadgk off +%% Nasty integrand to show quadcc off %!assert (dblquad (@(x,y) 1 ./ (x+y), 0, 1, 0, 1), 2*log(2), 1e-6) -%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, [], @quadgk), pi * erf(1).^2, 1e-6) -%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, [], @quadl), pi * erf(1).^2, 1e-6) -%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, [], @quadv), pi * erf(1).^2, 1e-6) +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadgk), pi * erf(1).^2, 1e-6) +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadl), pi * erf(1).^2, 1e-6) +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadv), pi * erf(1).^2, 1e-6)
--- a/scripts/general/display.m +++ b/scripts/general/display.m @@ -33,9 +33,18 @@ ## @end deftypefn function idx = display (a) - if (nargin == 1) - error ("display: not defined for class \"%s\"", class(a)); - else + + if (nargin != 1) print_usage (); endif + + ## Only reason we got here is that there was no overloaded display() + ## function for object a. This may mean it is a built-in. + str = disp (a); + if (isempty (strfind (str, "<class "))) + disp (str); + else + error ('display: not defined for class "%s"', class (a)); + endif + endfunction
--- a/scripts/general/flipdim.m +++ b/scripts/general/flipdim.m @@ -43,9 +43,10 @@ endif nd = ndims (x); + sz = size (x); if (nargin == 1) ## Find the first non-singleton dimension. - [~, dim] = min (size (x) != 1); + (dim = find (sz > 1, 1)) || (dim = 1); elseif (! (isscalar (dim) && isindex (dim))) error ("flipdim: DIM must be a positive integer"); endif @@ -55,3 +56,12 @@ y = x(idx{:}); endfunction + +%!error flipdim (); +%!error flipdim (1, 2, 3); + +%!assert (flipdim ([1,2;3,4]), flipdim ([1,2 ; 3,4], 1)); +%!assert (flipdim ([1,2;3,4], 2), [2,1;4,3]); +%!assert (flipdim ([1,2;3,4], 3), [1,2;3,4]); + +## FIXME -- we need tests for multidimensional arrays.
--- a/scripts/general/gradient.m +++ b/scripts/general/gradient.m @@ -88,7 +88,7 @@ if (isvector (m)) ## make a row vector. transposed = (size (m, 2) == 1); - m = m(:)'; + m = m(:).'; endif nd = ndims (m); @@ -259,6 +259,34 @@ %! assert (all(dU(:)==2)); %!test +%! [Y,X,Z,U] = ndgrid (2:2:8,1:5,4:4:12,3:5:30); +%! [dX,dY,dZ,dU] = gradient (X+j*X); +%! assert (all(dX(:)==1+1j)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (Y-j*Y); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==2-j*2)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (Z+j*1); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==4)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (U-j*1); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==5)); +%! assert (size_equal(dX, dY, dZ, dU, X, Y, Z, U)); +%! [dX,dY,dZ,dU] = gradient (U, 5.0); +%! assert (all(dU(:)==1)); +%! [dX,dY,dZ,dU] = gradient (U, 1.0, 2.0, 3.0, 2.5); +%! assert (all(dU(:)==2)); + +%!test %! x = 0:10; %! f = @cos; %! df_dx = @(x) -sin (x);
--- a/scripts/general/int2str.m +++ b/scripts/general/int2str.m @@ -49,31 +49,33 @@ function retval = int2str (n) - if (nargin == 1) - n = round (real(n)); - sz = size(n); - nd = ndims (n); - nc = columns (n); - if (nc > 1) - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor - idx(2) = 1; - ifmt = get_fmt (n(idx{:}), 0); - idx(2) = 2:sz(2); - rfmt = get_fmt (n(idx{:}), 2); - fmt = cstrcat (ifmt, repmat (rfmt, 1, nc-1), "\n"); - else - fmt = cstrcat (get_fmt (n, 0), "\n"); - endif - tmp = sprintf (fmt, permute (n, [2, 1, 3 : nd])); - tmp(end) = ""; - retval = char (strsplit (tmp, "\n")); - else + if (nargin != 1) print_usage (); endif + if (isempty (n)) + retval = ''; + return; + endif + + n = round (real(n)); + sz = size(n); + nd = ndims (n); + nc = columns (n); + if (nc > 1) + idx = repmat ({':'}, nd, 1); + idx(2) = 1; + ifmt = get_fmt (n(idx{:}), 0); + idx(2) = 2:sz(2); + rfmt = get_fmt (n(idx{:}), 2); + fmt = cstrcat (ifmt, repmat (rfmt, 1, nc-1), "\n"); + else + fmt = cstrcat (get_fmt (n, 0), "\n"); + endif + tmp = sprintf (fmt, permute (n, [2, 1, 3 : nd])); + tmp(end) = ""; + retval = char (strsplit (tmp, "\n")); + endfunction function fmt = get_fmt (x, sep) @@ -112,8 +114,10 @@ endfunction -%!assert(strcmp (int2str (-123), "-123") && strcmp (int2str (1.2), "1")); +%!assert (strcmp (int2str (-123), "-123") && strcmp (int2str (1.2), "1")); %!assert (all (int2str ([1, 2, 3; 4, 5, 6]) == ["1 2 3";"4 5 6"])); +%!assert (int2str([]), ""); + %!error int2str (); %!error int2str (1, 2);
--- a/scripts/general/interp1.m +++ b/scripts/general/interp1.m @@ -43,7 +43,7 @@ ## Piecewise cubic Hermite interpolating polynomial ## ## @item 'cubic' -## Cubic interpolation from four nearest neighbors +## Cubic interpolation (same as @code{pchip}) ## ## @item 'spline' ## Cubic spline interpolation---smooth first and second derivatives @@ -112,7 +112,7 @@ method = "linear"; extrap = NA; xi = []; - pp = false; + ispp = false; firstnumeric = true; if (nargin > 2) @@ -123,7 +123,7 @@ if (strcmp ("extrap", arg)) extrap = "extrap"; elseif (strcmp ("pp", arg)) - pp = true; + ispp = true; else method = arg; endif @@ -138,7 +138,7 @@ endfor endif - if (isempty (xi) && firstnumeric && ! pp) + if (isempty (xi) && firstnumeric && ! ispp) xi = y; y = x; x = 1:numel(y); @@ -150,9 +150,8 @@ szx = size (xi); if (isvector (y)) y = y(:); - elseif (isvector (xi)) - szx = length (xi); endif + szy = size (y); y = y(:,:); [ny, nc] = size (y); @@ -191,147 +190,85 @@ switch (method) case "nearest" - if (pp) - yi = mkpp ([x(1); (x(1:nx-1)+x(2:nx))/2; x(nx)], y, szy(2:end)); + pp = mkpp ([x(1); (x(1:nx-1)+x(2:nx))/2; x(nx)], shiftdim (y, 1), szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; else - idx = lookup (0.5*(x(1:nx-1)+x(2:nx)), xi) + 1; - yi = y(idx,:); + yi = ppval (pp, reshape (xi, szx)); endif case "*nearest" - if (pp) - yi = mkpp ([x(1); x(1)+[0.5:(nx-1)]'*dx; x(nx)], y, szy(2:end)); + pp = mkpp ([x(1), x(1)+[0.5:(nx-1)]*dx, x(nx)], shiftdim (y, 1), szy(2:end)); + pp.orient = "first"; + if (ispp) + yi = pp; else - idx = max (1, min (ny, floor((xi-x(1))/dx+1.5))); - yi = y(idx,:); + yi = ppval(pp, reshape (xi, szx)); endif case "linear" dy = diff (y); dx = diff (x); - if (pp) - coefs = [dy./dx, y(1:nx-1)]; - xx = x; - if (have_jumps) - ## Omit zero-size intervals. - coefs(jumps) = []; - xx(jumps) = []; - endif - yi = mkpp (xx, coefs, szy(2:end)); + dx = repmat (dx, [1 size(dy)(2:end)]); + coefs = [(dy./dx).'(:), y(1:nx-1, :).'(:)]; + xx = x; + + if (have_jumps) + ## Omit zero-size intervals. + coefs(jumps, :) = []; + xx(jumps) = []; + endif + + pp = mkpp (xx, coefs, szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; else - ## find the interval containing the test point - idx = lookup (x, xi, "lr"); - ## use the endpoints of the interval to define a line - s = (xi - x(idx))./dx(idx); - yi = bsxfun (@times, s, dy(idx,:)) + y(idx,:); - if (have_jumps) - ## Fix the corner cases of discontinuities at boundaries. - ## Internal discontinuities already handled correctly. - if (jumps (1)) - mask = xi < x(1); - yi(mask,:) = y(1*ones (1, sum (mask)),:); - endif - if (jumps(nx-1)) - mask = xi >= x(nx); - yi(mask,:) = y(nx*ones (1, sum (mask)),:); - endif - endif + yi = ppval(pp, reshape (xi, szx)); endif + case "*linear" dy = diff (y); - if (pp) - yi = mkpp (x(1) + [0:ny-1]*dx, [dy./dx, y(1:end-1)], szy(2:end)); + coefs = [(dy/dx).'(:), y(1:nx-1, :).'(:)]; + pp = mkpp (x, coefs, szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; else - ## find the interval containing the test point - t = (xi - x(1))/dx + 1; - idx = max (1, min (ny - 1, floor (t))); + yi = ppval(pp, reshape (xi, szx)); + endif - ## use the endpoints of the interval to define a line - s = t - idx; - yi = bsxfun (@times, s, dy(idx,:)) + y(idx,:); - endif - case {"pchip", "*pchip"} + case {"pchip", "*pchip", "cubic", "*cubic"} if (nx == 2 || starmethod) x = linspace (x(1), x(nx), ny); endif - ## Note that pchip's arguments are transposed relative to interp1 - if (pp) - yi = pchip (x.', y.'); - yi.d = szy(2:end); - else - yi = pchip (x.', y.', xi.').'; - endif - case {"cubic", "*cubic"} - if (nx < 4 || ny < 4) - error ("interp1: table too short"); - endif - - ## FIXME Is there a better way to treat pp return and *cubic - if (starmethod && ! pp) - ## From: Miloje Makivic - ## http://www.npac.syr.edu/projects/nasa/MILOJE/final/node36.html - t = (xi - x(1))/dx + 1; - idx = max (min (floor (t), ny-2), 2); - t = t - idx; - t2 = t.*t; - tp = 1 - 0.5*t; - a = (1 - t2).*tp; - b = (t2 + t).*tp; - c = (t2 - t).*tp/3; - d = (t2 - 1).*t/6; - J = ones (1, nc); - - yi = a(:,J) .* y(idx,:) + b(:,J) .* y(idx+1,:) ... - + c(:,J) .* y(idx-1,:) + d(:,J) .* y(idx+2,:); + if (ispp) + y = shiftdim (reshape (y, szy), 1); + yi = pchip (x, y); else - if (starmethod) - x = linspace (x(1), x(nx), ny).'; - nx = ny; - endif - - idx = lookup (x(2:nx-1), xi, "lr"); - - ## Construct cubic equations for each interval using divided - ## differences (computation of c and d don't use divided differences - ## but instead solve 2 equations for 2 unknowns). Perhaps - ## reformulating this as a lagrange polynomial would be more efficient. - i = 1:nx-3; - J = ones (1, nc); - dx = diff (x); - dx2 = x(i+1).^2 - x(i).^2; - dx3 = x(i+1).^3 - x(i).^3; - a = diff (y, 3)./dx(i,J).^3/6; - b = (diff (y(1:nx-1,:), 2)./dx(i,J).^2 - 6*a.*x(i+1,J))/2; - c = (diff (y(1:nx-2,:), 1) - a.*dx3(:,J) - b.*dx2(:,J))./dx(i,J); - d = y(i,:) - ((a.*x(i,J) + b).*x(i,J) + c).*x(i,J); - - if (pp) - xs = [x(1);x(3:nx-2)]; - yi = mkpp ([x(1);x(3:nx-2);x(nx)], - [a(:), (b(:) + 3.*xs(:,J).*a(:)), ... - (c(:) + 2.*xs(:,J).*b(:) + 3.*xs(:,J)(:).^2.*a(:)), ... - (d(:) + xs(:,J).*c(:) + xs(:,J).^2.*b(:) + ... - xs(:,J).^3.*a(:))], szy(2:end)); - else - yi = ((a(idx,:).*xi(:,J) + b(idx,:)).*xi(:,J) ... - + c(idx,:)).*xi(:,J) + d(idx,:); - endif + y = shiftdim (y, 1); + yi = pchip (x, y, reshape (xi, szx)); endif case {"spline", "*spline"} if (nx == 2 || starmethod) x = linspace(x(1), x(nx), ny); endif - ## Note that spline's arguments are transposed relative to interp1 - if (pp) - yi = spline (x.', y.'); - yi.d = szy(2:end); + + if (ispp) + y = shiftdim (reshape (y, szy), 1); + yi = spline (x, y); else - yi = spline (x.', y.', xi.').'; + y = shiftdim (y, 1); + yi = spline (x, y, reshape (xi, szx)); endif otherwise error ("interp1: invalid method '%s'", method); endswitch - if (! pp) + if (! ispp) if (! ischar (extrap)) ## determine which values are out of range and set them to extrap, ## unless extrap == "extrap". @@ -339,10 +276,24 @@ maxx = max (x(1), x(nx)); outliers = xi < minx | ! (xi <= maxx); # this catches even NaNs - yi(outliers, :) = extrap; + if (size_equal (outliers, yi)) + yi(outliers) = extrap; + yi = reshape (yi, szx); + elseif (!isvector (yi)) + if (strcmp (method, "pchip") || strcmp (method, "*pchip") + ||strcmp (method, "cubic") || strcmp (method, "*cubic") + ||strcmp (method, "spline") || strcmp (method, "*spline")) + yi(:, outliers) = extrap; + yi = shiftdim(yi, 1); + else + yi(outliers, :) = extrap; + endif + else + yi(outliers.') = extrap; + endif endif - - yi = reshape (yi, [szx, szy(2:end)]); + else + yi.orient = "first"; endif endfunction @@ -394,6 +345,7 @@ %! %-------------------------------------------------------- %! % confirm that interpolated function matches the original +##FIXME: add test for n-d arguments here ## For each type of interpolated test, confirm that the interpolated ## value at the knots match the values at the knots. Points away @@ -595,7 +547,6 @@ %!assert (interp1(1:2,1:2,1.4,"nearest"),1); %!error interp1(1,1,1, "linear"); %!assert (interp1(1:2,1:2,1.4,"linear"),1.4); -%!error interp1(1:3,1:3,1, "cubic"); %!assert (interp1(1:4,1:4,1.4,"cubic"),1.4); %!assert (interp1(1:2,1:2,1.1, "spline"), 1.1); %!assert (interp1(1:3,1:3,1.4,"spline"),1.4); @@ -604,7 +555,6 @@ %!assert (interp1(1:2:4,1:2:4,1.4,"*nearest"),1); %!error interp1(1,1,1, "*linear"); %!assert (interp1(1:2:4,1:2:4,[0,1,1.4,3,4],"*linear"),[NA,1,1.4,3,NA]); -%!error interp1(1:3,1:3,1, "*cubic"); %!assert (interp1(1:2:8,1:2:8,1.4,"*cubic"),1.4); %!assert (interp1(1:2,1:2,1.3, "*spline"), 1.3); %!assert (interp1(1:2:6,1:2:6,1.4,"*spline"),1.4); @@ -612,5 +562,5 @@ %!assert (interp1([3,2,1],[3,2,2],2.5),2.5) %!assert (interp1 ([1,2,2,3,4],[0,1,4,2,1],[-1,1.5,2,2.5,3.5], "linear", "extrap"), [-2,0.5,4,3,1.5]) -%!assert (interp1 ([4,4,3,2,0],[0,1,4,2,1],[1.5,4,4.5], "linear"), [0,1,NA]) +%!assert (interp1 ([4,4,3,2,0],[0,1,4,2,1],[1.5,4,4.5], "linear"), [1.75,1,NA]) %!assert (interp1 (0:4, 2.5), 1.5)
--- a/scripts/general/interpft.m +++ b/scripts/general/interpft.m @@ -46,40 +46,35 @@ print_usage (); endif + if (! (isscalar (n) && n == fix (n))) + error ("interpft: N must be a scalar integer"); + endif + if (nargin == 2) - if (isvector (x) && size (x, 1) == 1) + if (isrow (x)) dim = 2; else dim = 1; endif endif - if (! isscalar (n)) - error ("interpft: N must be an integer scalar"); - endif - nd = ndims (x); if (dim < 1 || dim > nd) - error ("interpft: integrating over invalid dimension"); + error ("interpft: invalid dimension DIM"); endif perm = [dim:nd, 1:(dim-1)]; x = permute (x, perm); - m = size (x, 1); + m = rows (x); - inc = 1; - while (inc*n < m) - inc++; - endwhile + inc = max (1, fix (m/n)); y = fft (x) / m; k = floor (m / 2); sz = size (x); sz(1) = n * inc - m; - idx = cell (nd, 1); - for i = 2:nd - idx{i} = 1:sz(i); - endfor + + idx = repmat ({':'}, nd, 1); idx{1} = 1:k; z = cat (1, y(idx{:}), zeros (sz)); idx{1} = k+1:m; @@ -92,8 +87,10 @@ endif z = ipermute (z, perm); + endfunction + %!demo %! t = 0 : 0.3 : pi; dt = t(2)-t(1); %! n = length (t); k = 100; @@ -110,5 +107,10 @@ %!assert (interpft(y', n), y', 20*eps); %!assert (interpft([y,y],n), [y,y], 20*eps); -%!error (interpft(y,n,0)) -%!error (interpft(y,[n,n])) +%% Test input validation +%!error interpft () +%!error interpft (1) +%!error interpft (1,2,3) +%!error (interpft(1,[n,n])) +%!error (interpft(1,2,0)) +%!error (interpft(1,2,3))
--- a/scripts/general/interpn.m +++ b/scripts/general/interpn.m @@ -129,7 +129,7 @@ error ("interpn: wrong number or incorrectly formatted input arguments"); endif - if (any (! cellfun (@isvector, x))) + if (any (! cellfun ("isvector", x))) for i = 2 : nd if (! size_equal (x{1}, x{i}) || ! size_equal (x{i}, v)) error ("interpn: dimensional mismatch"); @@ -145,8 +145,8 @@ method = tolower (method); - all_vectors = all (cellfun (@isvector, y)); - different_lengths = numel (unique (cellfun (@numel, y))) > 1; + all_vectors = all (cellfun ("isvector", y)); + different_lengths = numel (unique (cellfun ("numel", y))) > 1; if (all_vectors && different_lengths) [foobar(1:numel(y)).y] = ndgrid (y{:}); y = {foobar.y}; @@ -174,7 +174,7 @@ vi(idx) = extrapval; vi = reshape (vi, yshape); elseif (strcmp (method, "spline")) - if (any (! cellfun (@isvector, y))) + if (any (! cellfun ("isvector", y))) for i = 2 : nd if (! size_equal (y{1}, y{i})) error ("interpn: dimensional mismatch");
--- a/scripts/general/isa.m +++ b/scripts/general/isa.m @@ -75,3 +75,22 @@ %!assert (isa (uint16 (13), "numeric"), true) %!assert (isa (uint32 (13), "numeric"), true) %!assert (isa (uint64 (13), "numeric"), true) + +%!assert (isa (double (13), "double")); +%!assert (isa (single (13), "single")); +%!assert (isa (int8 (13), "int8")); +%!assert (isa (int16 (13), "int16")); +%!assert (isa (int32 (13), "int32")); +%!assert (isa (int64 (13), "int64")); +%!assert (isa (uint8 (13), "uint8")); +%!assert (isa (uint16 (13), "uint16")); +%!assert (isa (uint32 (13), "uint32")); +%!assert (isa (uint64 (13), "uint64")); +%!assert (isa ("string", "char")); +%!assert (isa (true, "logical")); +%!assert (isa (false, "logical")); +%!assert (isa ({1, 2}, "cell")); +%!test +%! a.b = 1; +%! assert (isa (a, "struct")); +
--- a/scripts/general/iscolumn.m +++ b/scripts/general/iscolumn.m @@ -26,8 +26,6 @@ function retval = iscolumn (x) - retval = false; - if (nargin != 1) print_usage (); endif
--- a/scripts/general/isdir.m +++ b/scripts/general/isdir.m @@ -23,10 +23,17 @@ ## @end deftypefn function retval = isdir (f) - if (nargin == 1) - ## Exist returns an integer but isdir should return a logical. - retval = (exist (f, "dir") == 7); - else + if (nargin != 1) print_usage ("isdir"); endif + + ## Exist returns an integer but isdir should return a logical. + retval = (exist (f, "dir") == 7); + endfunction + +%!error isdir (); +%!error isdir (1, 2); + +%!assert (isdir (pwd ())); +%!assert (! isdir ("this is highly unlikely to be a directory name"));
--- a/scripts/general/isequal.m +++ b/scripts/general/isequal.m @@ -24,12 +24,12 @@ function retval = isequal (x1, varargin) - if (nargin > 1) - retval = __isequal__ (false, x1, varargin{:}); - else + if (nargin < 2) print_usage (); endif + retval = __isequal__ (false, x1, varargin{:}); + endfunction ## test size and shape
--- a/scripts/general/isequalwithequalnans.m +++ b/scripts/general/isequalwithequalnans.m @@ -25,12 +25,12 @@ function retval = isequalwithequalnans (x1, varargin) - if (nargin > 1) - retval = __isequal__ (true, x1, varargin{:}); - else + if (nargin < 2) print_usage (); endif + retval = __isequal__ (true, x1, varargin{:}); + endfunction ## test for equality
--- a/scripts/general/isrow.m +++ b/scripts/general/isrow.m @@ -26,8 +26,6 @@ function retval = isrow (x) - retval = false; - if (nargin != 1) print_usage (); endif
--- a/scripts/general/isscalar.m +++ b/scripts/general/isscalar.m @@ -26,12 +26,12 @@ function retval = isscalar (x) - if (nargin == 1) - retval = numel (x) == 1; - else + if (nargin != 1) print_usage (); endif + retval = numel (x) == 1; + endfunction %!assert(isscalar (1));
--- a/scripts/general/issquare.m +++ b/scripts/general/issquare.m @@ -28,42 +28,35 @@ function retval = issquare (x) - if (nargin == 1) - if (ndims (x) == 2) - [r, c] = size (x); - retval = r == c; - else - retval = false; - endif + if (nargin != 1) + print_usage (); + endif + + if (ndims (x) == 2) + [r, c] = size (x); + retval = r == c; else - print_usage (); + retval = false; endif endfunction +%!assert(issquare ([])); %!assert(issquare (1)); - %!assert(!(issquare ([1, 2]))); - -%!assert(issquare ([])); - %!assert(issquare ([1, 2; 3, 4])); - -%!test -%! assert(issquare ("t")); - +%!assert(!(issquare ([1, 2; 3, 4; 5, 6]))); +%!assert(!(issquare (ones (3,3,3)))); +%!assert(issquare ("t")); %!assert(!(issquare ("test"))); - -%!test -%! assert(issquare (["test"; "ing"; "1"; "2"])); - +%!assert(issquare (["test"; "ing"; "1"; "2"])); %!test %! s.a = 1; %! assert(issquare (s)); - -%!assert(!(issquare ([1, 2; 3, 4; 5, 6]))); +%!assert(issquare ({1, 2; 3, 4})); +%!assert(sparse (([1, 2; 3, 4]))); +%% Test input validation %!error issquare (); - %!error issquare ([1, 2; 3, 4], 2);
--- a/scripts/general/isvector.m +++ b/scripts/general/isvector.m @@ -28,15 +28,13 @@ function retval = isvector (x) - retval = 0; - - if (nargin == 1) - sz = size (x); - retval = (ndims (x) == 2 && (sz(1) == 1 || sz(2) == 1)); - else + if (nargin != 1) print_usage (); endif + sz = size (x); + retval = (ndims (x) == 2 && (sz(1) == 1 || sz(2) == 1)); + endfunction %!assert(isvector (1));
--- a/scripts/general/logspace.m +++ b/scripts/general/logspace.m @@ -59,44 +59,41 @@ ## Author: jwe -function retval = logspace (base, limit, n) +function retval = logspace (base, limit, n = 50) - if (nargin == 2) - npoints = 50; - elseif (nargin == 3) - if (length (n) == 1) - npoints = fix (n); - else - error ("logspace: arguments must be scalars"); - endif - else + if (nargin != 2 && nargin != 3) print_usage (); endif - if (length (base) == 1 && length (limit) == 1) - if (limit == pi) - limit = log10 (pi); - endif - retval = 10 .^ (linspace (base, limit, npoints)); - else - error ("logspace: arguments must be scalars"); + if (! (isscalar (base) && isscalar (limit) && isscalar (n))) + error ("logspace: arguments BASE, LIMIT, and N must be scalars"); endif + npoints = fix (n); + + if (limit == pi) + limit = log10 (pi); + endif + + retval = 10 .^ (linspace (base, limit, npoints)); + endfunction + %!test %! x1 = logspace (1, 2); -%! x2 = logspace (1, 2, 10); +%! x2 = logspace (1, 2, 10.1); %! x3 = logspace (1, -2, 10); %! x4 = logspace (1, pi, 10); -%! assert((size (x1) == [1, 50] && x1(1) == 10 && x1(50) == 100 -%! && size (x2) == [1, 10] && x2(1) == 10 && x2(10) == 100 -%! && size (x3) == [1, 10] && x3(1) == 10 && x3(10) == 0.01 -%! && size (x4) == [1, 10] && x4(1) == 10 && abs (x4(10) - pi) < sqrt (eps))); +%! assert (size (x1) == [1, 50] && x1(1) == 10 && x1(50) == 100); +%! assert (size (x2) == [1, 10] && x2(1) == 10 && x2(10) == 100); +%! assert (size (x3) == [1, 10] && x3(1) == 10 && x3(10) == 0.01); +%! assert (size (x4) == [1, 10] && x4(1) == 10 && abs (x4(10) - pi) < sqrt (eps)); +%% Test input validation +%!error logspace (); +%!error logspace (1, 2, 3, 4); %!error logspace ([1, 2; 3, 4], 5, 6); - -%!error logspace (); +%!error logspace (1, [1, 2; 3, 4], 6); +%!error logspace (1, 2, [1, 2; 3, 4]); -%!error logspace (1, 2, 3, 4); -
--- a/scripts/general/module.mk +++ b/scripts/general/module.mk @@ -7,7 +7,6 @@ general_FCN_FILES = \ general/accumarray.m \ general/accumdim.m \ - general/arrayfun.m \ general/bicubic.m \ general/bitcmp.m \ general/bitget.m \ @@ -55,12 +54,16 @@ general/logspace.m \ general/nargchk.m \ general/nargoutchk.m \ + general/nthargout.m \ general/nextpow2.m \ general/num2str.m \ general/pol2cart.m \ general/polyarea.m \ general/postpad.m \ general/prepad.m \ + general/profexplore.m \ + general/profile.m \ + general/profshow.m \ general/quadgk.m \ general/quadl.m \ general/quadv.m \
--- a/scripts/general/nargchk.m +++ b/scripts/general/nargchk.m @@ -30,16 +30,14 @@ ## Author: Bill Denney <bill@denney.ws> -function msg = nargchk (minargs, maxargs, nargs, outtype) +function msg = nargchk (minargs, maxargs, nargs, outtype = "string") if (nargin < 3 || nargin > 4) print_usage (); elseif (minargs > maxargs) error ("nargchk: MINARGS must be <= MAXARGS"); - elseif (nargin == 3) - outtype = "string"; elseif (! any (strcmpi (outtype, {"string", "struct"}))) - error ("nargchk: output type must be either string or struct"); + error ('nargchk: output type must be either "string" or "struct"'); elseif (! (isscalar (minargs) && isscalar (maxargs) && isscalar (nargs))) error ("nargchk: MINARGS, MAXARGS, and NARGS must be scalars"); endif @@ -56,13 +54,16 @@ if (strcmpi (outtype, "string")) msg = msg.message; elseif (isempty (msg.message)) - msg = struct ([]); + ## Compatability: Matlab returns a 0x1 empty struct when nargchk passes + msg = resize (msg, 0, 1); endif endfunction + ## Tests -%!shared stmin, stmax +%!shared stnul, stmin, stmax +%! stnul = resize (struct ("message", "", "identifier", ""), 0, 1); %! stmin = struct ("message", "not enough input arguments", %! "identifier", "Octave:nargchk:not-enough-inputs"); %! stmax = struct ("message", "too many input arguments", @@ -73,7 +74,7 @@ %!assert (nargchk (0, 1, 2), "too many input arguments") %!assert (nargchk (0, 1, 2, "string"), "too many input arguments") ## Struct outputs -%!assert (nargchk (0, 1, 0, "struct"), struct([])) -%!assert (nargchk (0, 1, 1, "struct"), struct([])) +%!assert (isequal (nargchk (0, 1, 0, "struct"), stnul)) +%!assert (isequal (nargchk (0, 1, 1, "struct"), stnul)) %!assert (nargchk (1, 1, 0, "struct"), stmin) %!assert (nargchk (0, 1, 2, "struct"), stmax)
--- a/scripts/general/nargoutchk.m +++ b/scripts/general/nargoutchk.m @@ -55,19 +55,17 @@ if (strcmpi (outtype, "string")) msg = msg.message; - else - if (isempty (msg.message)) - msg = struct ([]); - endif - ## FIXME: remove the error below if error is modified to accept - ## struct inputs - error ("nargoutchk: error does not yet support struct inputs"); + elseif (isempty (msg.message)) + ## Compatability: Matlab returns a 0x1 empty struct when nargchk passes + msg = resize (msg, 0, 1); endif endfunction + ## Tests -%!shared stmin, stmax +%!shared stnul, stmin, stmax +%! stnul = resize (struct ("message", "", "identifier", ""), 0, 1); %! stmin = struct ("message", "not enough output arguments", %! "identifier", "Octave:nargoutchk:not-enough-outputs"); %! stmax = struct ("message", "too many output arguments", @@ -78,7 +76,8 @@ %!assert (nargoutchk (0, 1, 2), "too many output arguments") %!assert (nargoutchk (0, 1, 2, "string"), "too many output arguments") ## Struct outputs -#%!assert (nargoutchk (0, 1, 0, "struct"), struct([])) -#%!assert (nargoutchk (0, 1, 1, "struct"), struct([])) -#%!assert (nargoutchk (1, 1, 0, "struct"), stmin) -#%!assert (nargoutchk (0, 1, 2, "struct"), stmax) +%!assert (isequal (nargoutchk (0, 1, 0, "struct"), stnul)) +%!assert (isequal (nargoutchk (0, 1, 1, "struct"), stnul)) +%!assert (nargoutchk (1, 1, 0, "struct"), stmin) +%!assert (nargoutchk (0, 1, 2, "struct"), stmax) +
--- a/scripts/general/nextpow2.m +++ b/scripts/general/nextpow2.m @@ -55,3 +55,14 @@ endif endfunction + +%!error nexpow2 (); +%!error nexpow2 (1, 2); + +%!assert (nextpow2 (16), 4); +%!assert (nextpow2 (17), 5); +%!assert (nextpow2 (31), 5); +%!assert (nextpow2 (-16), 4); +%!assert (nextpow2 (-17), 5); +%!assert (nextpow2 (-31), 5); +%!assert (nextpow2 (1:17), 5);
new file mode 100644 --- /dev/null +++ b/scripts/general/nthargout.m @@ -0,0 +1,113 @@ +## Copyright (C) 2011 Jordi Gutiérrez Hermoso +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} nthargout (@var{n}, @var{func}, @dots{}) +## @deftypefnx {Function File} {} nthargout (@var{n}, @var{ntot}, @var{func}, @dots{}) +## Return the @var{n}th output argument of function given by the +## function handle or string @var{func}. Any arguments after @var{func} +## are passed to @var{func}. The total number of arguments to call +## @var{func} with can be passed in @var{ntot}; by default @var{ntot} +## is @var{n}. The input @var{n} can also be a vector of indices of the +## output, in which case the output will be a cell array of the +## requested output arguments. +## +## The intended use @code{nthargout} is to avoid intermediate variables. +## For example, when finding the indices of the maximum entry of a +## matrix, the following two compositions of nthargout +## +## @example +## @group +## @var{m} = magic (5); +## cell2mat (nthargout ([1, 2], @@ind2sub, size(@var{m}), +## nthargout (2, @@max, @var{m}(:)))) +## @result{} 5 3 +## @end group +## @end example +## +## @noindent +## are completely equivalent to the following lines: +## +## @example +## @group +## @var{m} = magic(5); +## [~, idx] = max (@var{M}(:)); +## [i, j] = ind2sub (size (@var{m}), idx); +## [i, j] +## @result{} 5 3 +## @end group +## @end example +## +## It can also be helpful to have all output arguments in a single cell +## in the following manner: +## +## @example +## @var{USV} = nthargout ([1:3], @@svd, hilb (5)); +## @end example +## +## @seealso{nargin, nargout, varargin, varargout, isargout} +## @end deftypefn + +## Author: Jordi Gutiérrez Hermoso + +function out = nthargout (n, varargin) + if (nargin < 2) + print_usage (); + endif + + if (isa (varargin{1}, "function_handle") || ischar (varargin{1})) + ntot = max (n(:)); + func = varargin{1}; + args = varargin(2:end); + elseif (isnumeric (varargin{1}) + && (isa (varargin{2}, "function_handle") || ischar (varargin{2}))) + ntot = varargin{1}; + func = varargin{2}; + args = varargin(3:end); + else + print_usage (); + endif + + if (any (n != fix (n)) || ntot != fix (ntot) || any (n <= 0) || ntot <= 0) + error ("nthargout: N and NTOT must consist of positive integers") + endif + + outargs = cell (1, ntot); + + try + [outargs{:}] = feval (func, args{:}); + if (numel (n) > 1) + out = outargs(n); + else + out = outargs{n}; + endif + catch + err = lasterr (); + if (strfind ("some elements undefined in return list", err)) + error ("nthargout: Too many output arguments: %d", ntot); + else + error (err); + endif + end_try_catch + +endfunction + +%!shared m +%! m = magic (5); +%!assert (nthargout ([1, 2], @ind2sub, size(m), nthargout (2, @max, m(:))), {5,3}) +%!assert (nthargout (3, @find, m(m>20)), [23, 24, 25, 21, 22]')
--- a/scripts/general/num2str.m +++ b/scripts/general/num2str.m @@ -75,7 +75,7 @@ if (ischar (arg)) fmt = cstrcat (arg, "%-+", arg(2:end), "i"); else - if (isnumeric (x) && round (x) == x && abs (x) < (10 .^ arg)) + 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); @@ -83,7 +83,7 @@ endif else ## Setup a suitable format string - if (isnumeric (x) && round (x) == x && abs (x) < 1e10) + if (isnumeric (x) && x == fix (x) && abs (x) < 1e10) if (max (abs (real (x(:)))) == 0) dgt1 = 2; else @@ -111,10 +111,7 @@ nd = ndims (x); perm = fix ([1:0.5:nc+0.5]); perm(2:2:2*nc) = perm(2:2:2*nc) + nc; - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{2} = perm; x = horzcat (real (x), imag (x)); x = x(idx{:}); @@ -147,14 +144,14 @@ if (ischar (arg)) fmt = arg; else - if (isnumeric (x) && round (x) == x && abs (x) < (10 .^ arg)) + 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) && round (x) == x && abs (x) < 1e10) + if (isnumeric (x) && x == fix (x) && abs (x) < 1e10) if (max (abs (x(:))) == 0) dgt = 2; else
--- a/scripts/general/postpad.m +++ b/scripts/general/postpad.m @@ -53,11 +53,8 @@ nd = ndims (x); sz = size (x); if (nargin < 4) - ## Find the first non-singleton dimension - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -76,10 +73,7 @@ d = sz (dim); if (d >= l) - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = 1:l; y = x(idx{:}); else @@ -88,3 +82,16 @@ endif endfunction + +%!error postpad (); +%!error postpad (1); +%!error postpad (1,2,3,4,5); +%!error postpad ([1,2], 2, 2,3); + +%!assert (postpad ([1,2], 4), [1,2,0,0]); +%!assert (postpad ([1;2], 4), [1;2;0;0]); + +%!assert (postpad ([1,2], 4, 2), [1,2,2,2]); +%!assert (postpad ([1;2], 4, 2), [1;2;2;2]); + +%!assert (postpad ([1,2], 2, 2, 1), [1,2;2,2]);
--- a/scripts/general/prepad.m +++ b/scripts/general/prepad.m @@ -53,11 +53,8 @@ nd = ndims (x); sz = size (x); if (nargin < 4) - ## Find the first non-singleton dimension - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -76,10 +73,7 @@ d = sz (dim); if (d >= l) - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = d-l+1:d; y = x(idx{:}); else @@ -88,3 +82,18 @@ endif endfunction + +%!error prepad (); +%!error prepad (1); +%!error prepad (1,2,3,4,5); +%!error prepad ([1,2], 2, 2,3); + +%!assert (prepad ([1,2], 4), [0,0,1,2]); +%!assert (prepad ([1;2], 4), [0;0;1;2]); + +%!assert (prepad ([1,2], 4, 2), [2,2,1,2]); +%!assert (prepad ([1;2], 4, 2), [2;2;1;2]); + +%!assert (prepad ([1,2], 2, 2, 1), [2,2;1,2]); + +## FIXME -- we need tests for multidimensional arrays.
--- a/scripts/general/private/__isequal__.m +++ b/scripts/general/private/__isequal__.m @@ -59,16 +59,16 @@ ## All arguments must either be of the same class or they must be ## numeric values. t = (all (strcmp (class(x), - cellfun (@class, varargin, "uniformoutput", false))) + cellfun ("class", varargin, "uniformoutput", false))) || ((isnumeric (x) || islogical (x)) - && all (cellfun (@isnumeric, varargin) - | cellfun (@islogical, varargin)))); + && all (cellfun ("isnumeric", varargin) + | cellfun ("islogical", varargin)))); if (t) ## Test that everything has the same number of dimensions. s_x = size (x); s_v = cellfun (@size, varargin, "uniformoutput", false); - t = all (length (s_x) == cellfun (@length, s_v)); + t = all (length (s_x) == cellfun ("length", s_v)); endif if (t) @@ -96,8 +96,8 @@ ## Test the number of fields. fn_x = fieldnames (x); l_fn_x = length (fn_x); - fn_v = cellfun (@fieldnames, varargin, "uniformoutput", false); - t = all (l_fn_x == cellfun (@length, fn_v)); + fn_v = cellfun ("fieldnames", varargin, "uniformoutput", false); + t = all (l_fn_x == cellfun ("length", fn_v)); ## Test that all the names are equal. idx = 0; @@ -146,7 +146,7 @@ elseif (isa (x, "function_handle")) ## The == operator is overloaded for handles. - t = all (cellfun (@eq, {x}, varargin)); + t = all (cellfun ("eq", {x}, varargin)); else ## Check the numeric types.
new file mode 100644 --- /dev/null +++ b/scripts/general/profexplore.m @@ -0,0 +1,132 @@ +## Copyright (C) 2011 Daniel Kraft +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} profexplore (@var{data}) +## Interactively explore hierarchical profiler output. +## +## Assuming @var{data} is the structure with profile data returned by +## @code{profile ('info')}, this command opens an interactive prompt +## that can be used to explore the call-tree. Type @kbd{help} to get a list +## of possible commands. +## @seealso{profile, profshow} +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft <d@domob.eu> + +function profexplore (data) + + if (nargin ~= 1) + print_usage (); + endif + + ## The actual work is done by a recursive worker function, since that + ## is an easy way to traverse the tree datastructure. Here, we just check + ## the arguments (already done) and give over to it. + + __profexplore_worker (data.FunctionTable, data.Hierarchical, "Top\n", " "); + +endfunction + +## This is the worker function. tree is the current subtree we want to +## display / explore. parents is a string containing the already 'rendered' +## data for the parents which is displayed on top of the list of current +## children. prefix is the prefix to add to each line rendered; this +## is just a string of spaces to get indentation right. +## +## Returning 0 indicates that the user requested to totally exit the +## explorer, thus also all higher levels should exit immediately. An integer +## greater zero indicates to exit that many levels since the user wants to go +## up (but not necessarily quit). + +function rv = __profexplore_worker (fcn_table, tree, parents, prefix) + + ## Sort children by total time. + times = -[ tree.TotalTime ]; + [~, p] = sort (times); + tree = tree(p); + + while (true) + + printf ("\n%s", parents); + strings = cell (length (tree), 1); + for i = 1 : length (tree) + strings{i} = sprintf ("%s: %d calls, %.3f total, %.3f self", ... + fcn_table(tree(i).Index).FunctionName, ... + tree(i).NumCalls, ... + tree(i).TotalTime, tree(i).SelfTime); + printf ("%s%d) %s\n", prefix, i, strings{i}); + endfor + printf ("\n"); + + cmd = input ("profexplore> ", "s"); + option = fix (str2double (cmd)); + + if (strcmp (cmd, "exit")) + rv = 0; + return; + elseif (strcmp (cmd, "help")) + printf ("\nCommands for profile explorer:\n\n"); + printf ("exit Return to Octave prompt.\n"); + printf ("help Display this help message.\n"); + printf ("up [N] Go up N levels, where N is an integer. Default is 1.\n"); + printf ("N Go down a level into option N.\n"); + elseif (~isnan (option)) + if (option < 1 || option > length (tree)) + printf ("The chosen option is out of range!\n"); + else + newParents = sprintf ("%s%s%s\n", parents, prefix, strings{option}); + newPrefix = sprintf ("%s ", prefix); + + rv = __profexplore_worker (fcn_table, tree(option).Children, ... + newParents, newPrefix); + + if (rv == 0) + return; + elseif (rv > 1) + rv = rv - 1; + return; + else + assert (rv == 1); + ## It was requested to return to this level, so just stay. + endif + endif + elseif (length (cmd) >= 2 && strcmp (substr (cmd, 1, 2), "up")) + if (length (cmd) == 2) + rv = 1; + return; + endif + + if (length (cmd) > 3 && cmd(3) == ' ') + opt = fix (str2double (substr (cmd, 3))); + if (~isnan (opt) && opt > 0) + rv = opt; + return; + endif + endif + + printf ("Invalid 'up' command. Type 'help' for further"); + printf (" information.\n"); + else + printf ("Unrecognized input. Type 'help' to get a list of possible"); + printf (" commands.\n"); + endif + + endwhile +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/general/profile.m @@ -0,0 +1,151 @@ +## Copyright (C) 2011 Daniel Kraft +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} profile on +## @deftypefnx {Function File} {} profile off +## @deftypefnx {Function File} {} profile resume +## @deftypefnx {Function File} {} profile clear +## @deftypefnx {Function File} {@var{S} =} profile ('status') +## @deftypefnx {Function File} {@var{T} =} profile ('info') +## Control the built-in profiler. +## +## @table @code +## @item profile on +## Start the profiler, clearing all previously collected data if there +## is any. +## +## @item profile off +## Stop profiling. The collected data can later be retrieved and examined +## with calls like @code{S = profile ('info')}. +## +## @item profile clear +## Clear all collected profiler data. +## +## @item profile resume +## Restart profiling without cleaning up the old data and instead +## all newly collected statistics are added to the already existing ones. +## +## @item @var{S} = profile ('status') +## Return a structure filled with certain information about the current status +## of the profiler. At the moment, the only field is @code{ProfilerStatus} +## which is either 'on' or 'off'. +## +## @item @var{T} = profile ('info') +## Return the collected profiling statistics in the structure @var{T}. +## The flat profile is returned in the field @code{FunctionTable} which is an +## array of structures, each entry corresponding to a function which was called +## and for which profiling statistics are present. Furthermore, the field +## @code{Hierarchical} contains the hierarchical call-tree. Each node +## has an index into the @code{FunctionTable} identifying the function it +## corresponds to as well as data fields for number of calls and time spent +## at this level in the call-tree. +## @seealso{profshow, profexplore} +## @end table +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft <d@domob.eu> + +function retval = profile (option) + + if (nargin != 1) + print_usage (); + endif + + switch (option) + case 'on' + __profiler_reset__ (); + __profiler_enable__ (true); + + case 'off' + __profiler_enable__ (false); + + case 'clear' + __profiler_reset__ (); + + case 'resume' + __profiler_enable__ (true); + + case 'status' + enabled = __profiler_enable__ (); + if (enabled) + enabled = 'on'; + else + enabled = 'off'; + endif + retval = struct ('ProfilerStatus', enabled); + + case 'info' + [flat, tree] = __profiler_data__ (); + retval = struct ('FunctionTable', flat, 'Hierarchical', tree); + + otherwise + warning ("profile: Unrecognized option '%s'", option); + print_usage (); + + endswitch + +endfunction + + +%!demo +%! profile ('on'); +%! A = rand (100); +%! B = expm (A); +%! profile ('off'); +%! profile ('resume'); +%! C = sqrtm (A); +%! profile ('off'); +%! T = profile ('info'); +%! profshow (T); + +%!error profile (); +%!error profile ('on', 2); + +%!test +%! on_struct.ProfilerStatus = "on"; +%! off_struct.ProfilerStatus = "off"; +%! profile ('on'); +%! result = logm (rand (200) + 10 * eye (200)); +%! assert (profile ('status'), on_struct); +%! profile ('off'); +%! assert (profile ('status'), off_struct); +%! profile ('resume'); +%! result = logm (rand (200) + 10 * eye (200)); +%! profile ('off'); +%! assert (profile ('status'), off_struct); +%! info = profile ('info'); +%! assert (isstruct (info)); +%! assert (size (info), [1, 1]); +%! assert (fieldnames (info), {'FunctionTable'; 'Hierarchical'}); +%! ftbl = info.FunctionTable; +%! assert (fieldnames (ftbl), {'FunctionName'; 'TotalTime'; 'NumCalls'; 'IsRecursive'; 'Parents'; 'Children'}); +%! hier = info.Hierarchical; +%! assert (fieldnames (hier), {'Index'; 'SelfTime'; 'TotalTime'; 'NumCalls'; 'Children'}); +%! profile ('clear'); +%! info = profile ('info'); +%! assert (isstruct (info)); +%! assert (size (info), [1, 1]); +%! assert (fieldnames (info), {'FunctionTable'; 'Hierarchical'}); +%! ftbl = info.FunctionTable; +%! assert (size (ftbl), [0, 1]); +%! assert (fieldnames (ftbl), {'FunctionName'; 'TotalTime'; 'NumCalls'; 'IsRecursive'; 'Parents'; 'Children'}); +%! hier = info.Hierarchical; +%! assert (size (hier), [0, 1]); +%! assert (fieldnames (hier), {'Index'; 'SelfTime'; 'NumCalls'; 'Children'});
new file mode 100644 --- /dev/null +++ b/scripts/general/profshow.m @@ -0,0 +1,107 @@ +## Copyright (C) 2011 Daniel Kraft +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} profshow (@var{data}) +## @deftypefnx {Function File} {} profshow (@var{data}, @var{n}) +## Show flat profiler results. +## +## This command prints out profiler data as a flat profile. @var{data} is the +## structure returned by @code{profile ('info')}. If @var{n} is given, it +## specifies the number of functions to show in the profile; functions are +## sorted in descending order by total time spent in them. If there are more +## than @var{n} included in the profile, those will not be shown. @var{n} +## defaults to 20. +## +## The attribute column shows @samp{R} for recursive functions and nothing +## otherwise. +## @seealso{profexplore, profile} +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft <d@domob.eu> + +function profshow (data, n = 20) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + n = fix (n); + if (! isscalar (n) || ! isreal (n) || ! (n > 0)) + error ("profile: N must be a positive integer"); + endif + + m = length (data.FunctionTable); + n = min (n, m); + + ## We want to sort by times in descending order. For this, extract the + ## times to an array, then sort this, and use the resulting index permutation + ## to print out our table. + times = -[ data.FunctionTable.TotalTime ]; + + [~, p] = sort (times); + + ## For printing the table, find out the maximum length of a function name + ## so that we can proportion the table accordingly. Based on this, + ## we can build the format used for printing table rows. + nameLen = length ("Function"); + for i = 1 : n + nameLen = max (nameLen, length (data.FunctionTable(p(i)).FunctionName)); + endfor + headerFormat = sprintf ("%%4s %%%ds %%4s %%12s %%12s\n", nameLen); + rowFormat = sprintf ("%%4d %%%ds %%4s %%12.3f %%12d\n", nameLen); + + printf (headerFormat, "#", "Function", "Attr", "Time (s)", "Calls"); + printf ("%s\n", repmat ("-", 1, nameLen + 2 * 5 + 2 * 13)); + for i = 1 : n + row = data.FunctionTable(p(i)); + attr = ""; + if (row.IsRecursive) + attr = "R"; + endif + printf (rowFormat, p(i), row.FunctionName, attr, ... + row.TotalTime, row.NumCalls); + endfor + +endfunction + +%!demo +%! profile ("on"); +%! A = rand (100); +%! B = expm (A); +%! profile ("off"); +%! T = profile ("info"); +%! profshow (T, 10); + +%!demo +%! function f = myfib (n) +%! if (n <= 2) +%! f = 1; +%! else +%! f = myfib (n - 1) + myfib (n - 2); +%! endif +%! endfunction +%! profile ("on"); +%! myfib (20); +%! profile ("off"); +%! profshow (profile ("info"), 5); + +%!error profshow (); +%!error profshow (1, 2, 3); +%!error profshow (struct (), 1.2);
--- a/scripts/general/quadl.m +++ b/scripts/general/quadl.m @@ -62,14 +62,12 @@ ## * replace global variable terminate2 with local function need_warning ## * add paper ref to docs -function q = quadl (f, a, b, tol, trace, varargin) - need_warning (1); - if (nargin < 4) - tol = []; +function q = quadl (f, a, b, tol = [], trace = false, varargin) + + if (nargin < 3) + print_usage (); endif - if (nargin < 5) - trace = []; - endif + if (isa (a, "single") || isa (b, "single")) myeps = eps ("single"); else @@ -79,16 +77,23 @@ tol = myeps; endif if (isempty (trace)) - trace = 0; + trace = false; endif if (tol < myeps) tol = myeps; endif + ## Track whether recursion has occurred + global __quadl_recurse_done__; + __quadl_recurse_done__ = false; + ## Track whether warning about machine precision has been issued + global __quadl_need_warning__; + __quadl_need_warning__ = true; + m = (a+b)/2; h = (b-a)/2; - alpha = sqrt(2/3); - beta = 1/sqrt(5); + alpha = sqrt (2/3); + beta = 1/sqrt (5); x1 = .942882415695480; x2 = .641853342345781; @@ -104,12 +109,12 @@ i2 = (h/6)*(y(1) + y(13) + 5*(y(5)+y(9))); - i1 = (h/1470)*(77*(y(1)+y(13)) + i1 = (h/1470)*( 77*(y(1)+y(13)) + 432*(y(3)+y(11)) + 625*(y(5)+y(9)) + 672*y(7)); - is = h*(.0158271919734802*(y(1)+y(13)) + is = h*( .0158271919734802*(y(1)+y(13)) +.0942738402188500*(y(2)+y(12)) + .155071987336585*(y(3)+y(11)) + .188821573960182*(y(4)+y(10)) @@ -117,80 +122,96 @@ + .224926465333340*(y(6)+y(8)) + .242611071901408*y(7)); - s = sign(is); - + s = sign (is); if (s == 0) s = 1; endif - erri1 = abs(i1-is); - erri2 = abs(i2-is); - R = 1; + erri1 = abs (i1-is); + erri2 = abs (i2-is); if (erri2 != 0) R = erri1/erri2; + else + R = 1; endif if (R > 0 && R < 1) tol = tol/R; endif - is = s*abs(is)*tol/myeps; + is = s * abs(is) * tol/myeps; if (is == 0) is = b-a; endif + q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin{:}); + endfunction ## ADAPTLOBSTP Recursive function used by QUADL. ## ## Q = ADAPTLOBSTP('F', A, B, FA, FB, IS, TRACE) tries to ## approximate the integral of F(X) from A to B to -## an appropriate relative error. The argument 'F' is +## an appropriate relative error. The argument 'F' is ## a string containing the name of f. The remaining ## arguments are generated by ADAPTLOB or by recursion. ## ## Walter Gautschi, 08/03/98 function q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin) + global __quadl_recurse_done__; + global __quadl_need_warning__; + h = (b-a)/2; m = (a+b)/2; - alpha = sqrt(2/3); - beta = 1/sqrt(5); + alpha = sqrt (2/3); + beta = 1 / sqrt(5); mll = m-alpha*h; - ml = m-beta*h; - mr = m+beta*h; + ml = m-beta*h; + mr = m+beta*h; mrr = m+alpha*h; x = [mll, ml, m, mr, mrr]; - y = feval(f, x, varargin{:}); + y = feval (f, x, varargin{:}); fmll = y(1); - fml = y(2); - fm = y(3); - fmr = y(4); + fml = y(2); + fm = y(3); + fmr = y(4); fmrr = y(5); i2 = (h/6)*(fa + fb + 5*(fml+fmr)); i1 = (h/1470)*(77*(fa+fb) + 432*(fmll+fmrr) + 625*(fml+fmr) + 672*fm); - if (is+(i1-i2) == is || mll <= a || b <= mrr) - if ((m <= a || b <= m) && need_warning ()) + if ((is+(i1-i2) == is || mll <= a || b <= mrr) && __quadl_recurse_done__) + if ((m <= a || b <= m) && __quadl_need_warning__) warning ("quadl: interval contains no more machine number"); warning ("quadl: required tolerance may not be met"); - need_warning (0); + __quadl_need_warning__ = false; endif q = i1; if (trace) disp ([a, b-a, q]); endif else - q = (adaptlobstp (f, a, mll, fa, fmll, is, trace, varargin{:}) - + adaptlobstp (f, mll, ml, fmll, fml, is, trace, varargin{:}) - + adaptlobstp (f, ml, m, fml, fm, is, trace, varargin{:}) - + adaptlobstp (f, m, mr, fm, fmr, is, trace, varargin{:}) - + adaptlobstp (f, mr, mrr, fmr, fmrr, is, trace, varargin{:}) - + adaptlobstp (f, mrr, b, fmrr, fb, is, trace, varargin{:})); + __quadl_recurse_done__ = true; + q = ( adaptlobstp (f, a , mll, fa , fmll, is, trace, varargin{:}) + + adaptlobstp (f, mll, ml , fmll, fml , is, trace, varargin{:}) + + adaptlobstp (f, ml , m , fml , fm , is, trace, varargin{:}) + + adaptlobstp (f, m , mr , fm , fmr , is, trace, varargin{:}) + + adaptlobstp (f, mr , mrr, fmr , fmrr, is, trace, varargin{:}) + + adaptlobstp (f, mrr, b , fmrr, fb , is, trace, varargin{:})); endif endfunction -function r = need_warning (v) - persistent w = []; - if (nargin == 0) - r = w; - else - w = v; - endif -endfunction + +## basic functionality +%!assert (quadl (@(x) sin (x), 0, pi, [], []), 2, -3e-16) + +## the values here are very high so it may be unavoidable that this fails +%!assert (quadl (@(x) sin (3*x).*cosh (x).*sinh (x),10,15), +%! 2.588424538641647e+10, -9e-15) + +## extra parameters +%!assert (quadl (@(x,a,b) sin (a + b*x), 0, 1, [], [], 2, 3), +%! cos(2)/3 - cos(5)/3, - 3e-16) + +## test different tolerances. +%!assert (quadl (@(x) sin (2 + 3*x).^2, 0, 10, 0.3, []), +%! (60 + sin(4) - sin(64))/12, -0.3) +%!assert (quadl (@(x) sin (2 + 3*x).^2, 0, 10, 0.1, []), +%! (60 + sin(4) - sin(64))/12, -0.1) +
--- a/scripts/general/rat.m +++ b/scripts/general/rat.m @@ -150,3 +150,11 @@ endif endfunction + +%!error rat (); +%!error rat (1, 2, 3); + +%!test +%! [n, d] = rat ([0.5, 0.3, 1/3]); +%! assert (n, [1, 3, 1]); +%! assert (d, [2, 10, 3]);
--- a/scripts/general/rot90.m +++ b/scripts/general/rot90.m @@ -52,58 +52,51 @@ ## Author: jwe -function B = rot90 (A, k) - - if (nargin == 1 || nargin == 2) - if (nargin < 2) - k = 1; - endif - - if (ndims (A) > 2) - error ("rot90: Only works with 2-D arrays"); - endif - - if (imag (k) != 0 || fix (k) != k) - error ("rot90: K must be an integer"); - endif - - k = rem (k, 4); +function B = rot90 (A, k = 1) - if (k < 0) - k = k + 4; - endif - - if (k == 0) - B = A; - elseif (k == 1) - B = flipud (A.'); - elseif (k == 2) - B = flipud (fliplr (A)); - elseif (k == 3) - B = (flipud (A)).'; - else - error ("rot90: internal error!"); - endif - else + if (nargin < 1 || nargin > 2) print_usage (); endif + if (ndims (A) > 2) + error ("rot90: A must be a 2-D array"); + elseif (! (isscalar (k) && isreal (k) && k == fix (k))) + error ("rot90: K must be a single real integer"); + endif + + k = mod (k, 4); + + if (k == 0) + B = A; + elseif (k == 1) + B = flipud (A.'); + elseif (k == 2) + B = flipud (fliplr (A)); + elseif (k == 3) + B = (flipud (A)).'; + else + error ("rot90: internal error!"); + endif + endfunction + %!test %! x1 = [1, 2; 3, 4]; %! x2 = [2, 4; 1, 3]; %! x3 = [4, 3; 2, 1]; %! x4 = [3, 1; 4, 2]; %! -%! assert(rot90 (x1) == x2); -%! assert(rot90 (x1, 2) == x3); -%! assert(rot90 (x1, 3) == x4); -%! assert(rot90 (x1, 4) == x1); -%! assert(rot90 (x1, 5) == x2); -%! assert(rot90 (x1, -1) == x4); +%! assert(rot90 (x1), x2); +%! assert(rot90 (x1, 2), x3); +%! assert(rot90 (x1, 3), x4); +%! assert(rot90 (x1, 4), x1); +%! assert(rot90 (x1, 5), x2); +%! assert(rot90 (x1, -1), x4); %% Test input validation %!error rot90 (); %!error rot90 (1, 2, 3); - +%!error rot90 (1, ones(2)); +%!error rot90 (1, 1.5); +%!error rot90 (1, 1+i);
--- a/scripts/general/rotdim.m +++ b/scripts/general/rotdim.m @@ -71,26 +71,30 @@ nd = ndims (x); sz = size (x); if (nargin < 3) - ## Find the first two non-singleton dimension. - plane = []; - dim = 0; - while (dim < nd) - dim = dim + 1; - if (sz (dim) != 1) - plane = [plane, dim]; - if (length (plane) == 2) - break; + if (nd > 2) + ## Find the first two non-singleton dimension. + plane = []; + dim = 0; + while (dim < nd) + dim = dim + 1; + if (sz (dim) != 1) + plane = [plane, dim]; + if (length (plane) == 2) + break; + endif endif + endwhile + if (length (plane) < 1) + plane = [1, 2]; + elseif (length (plane) < 2) + plane = [1, plane]; endif - endwhile - if (length (plane) < 1) + else plane = [1, 2]; - elseif (length (plane) < 2) - plane = [1, plane]; endif else if (! (isvector (plane) && length (plane) == 2 - && all (plane == round (plane)) && all (plane > 0) + && all (plane == fix (plane)) && all (plane > 0) && all (plane < (nd + 1)) && plane(1) != plane(2))) error ("rotdim: PLANE must be a 2 element integer vector defining a valid PLANE"); endif @@ -119,3 +123,36 @@ endif endfunction + +%!error rotdim (); +%!error rotdim (1, 2, 3, 4); + +%!shared r, rr +%! r = [1,2,3]; rr = [3,2,1]; +%!assert (rotdim (r, 0), r); +%!assert (rotdim (r, 1), rr'); +%!assert (rotdim (r, 2), rr); +%!assert (rotdim (r, 3), r'); +%!assert (rotdim (r, 3), rotdim (r, -1)); +%!assert (rotdim (r, 1), rotdim (r)); + +%!shared c, cr +%! c = [1;2;3]; cr = [3;2;1]; +%!assert (rotdim (c, 0), c); +%!assert (rotdim (c, 1), c'); +%!assert (rotdim (c, 2), cr); +%!assert (rotdim (c, 3), cr'); +%!assert (rotdim (c, 3), rotdim (c, -1)); +%!assert (rotdim (c, 1), rotdim (c)); + +%!shared m +%! m = [1,2;3,4]; +%!assert (rotdim (m, 0), m); +%!assert (rotdim (m, 1), [2,4;1,3]); +%!assert (rotdim (m, 2), [4,3;2,1]); +%!assert (rotdim (m, 3), [3,1;4,2]); +%!assert (rotdim (m, 3), rotdim (m, -1)); +%!assert (rotdim (m, 1), rotdim (m)); + +## FIXME -- we need tests for multidimensional arrays and different +## values of PLANE.
--- a/scripts/general/shift.m +++ b/scripts/general/shift.m @@ -37,7 +37,9 @@ print_usage (); endif - if (! (isscalar (b) && b == round (b))) + if (numel (x) < 1) + error ("shift: X must not be empty"); + elseif (! (isscalar (b) && b == fix (b))) error ("shift: B must be an integer"); endif @@ -45,39 +47,31 @@ sz = size (x); if (nargin == 3) - if (!(isscalar (dim) && dim == round (dim)) + if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) error ("shift: DIM must be an integer and a valid dimension"); endif else ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); endif - if (numel (x) < 1) - error ("shift: X must not be empty"); - endif - - d = sz (dim); + d = sz(dim); - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor - if (b >= 0) + idx = repmat ({':'}, nd, 1); + if (b > 0) b = rem (b, d); idx{dim} = [d-b+1:d, 1:d-b]; elseif (b < 0) b = rem (abs (b), d); idx{dim} = [b+1:d, 1:b]; endif + y = x(idx{:}); endfunction + %!test %! a = [1, 2, 3]; %! b = [4, 5, 6]; @@ -86,13 +80,20 @@ %! r = [a, b, c]; %! m = [a; b; c]; %! -%! assert((shift (r, 3) == [c, a, b] -%! && shift (r, -6) == [c, a, b] -%! && shift (r, -3) == [b, c, a] -%! && shift (m, 1) == [c; a; b] -%! && shift (m, -2) == [c; a; b])); +%! assert(shift (r, 0), r); +%! assert(shift (r, 3), [c, a, b]); +%! assert(shift (r, -6), [c, a, b]); +%! assert(shift (r, -3), [b, c, a]); +%! assert(shift (m, 1), [c; a; b]); +%! assert(shift (m, -2), [c; a; b]); -%!error shift (); +%% Test input validation +%!error shift () +%!error shift (1, 2, 3, 4) +%!error shift ([], 1) +%!error shift (ones(2), ones(2)) +%!error shift (ones(2), 1.5) +%!error shift (1, 1, 1.5) +%!error shift (1, 1, 0) +%!error shift (1, 1, 3) -%!error shift (1, 2, 3, 4); -
--- a/scripts/general/shiftdim.m +++ b/scripts/general/shiftdim.m @@ -57,14 +57,9 @@ orig_dims = size (x); if (nargin == 1) - ## Find the first singleton dimension. - n = 0; - while (n < nd && orig_dims(n+1) == 1) - n++; - endwhile - endif - - if (! isscalar (n) || floor (n) != n) + ## Find the first non-singleton dimension. + (n = find (orig_dims != 1, 1) - 1) || (n = nd); + elseif (! (isscalar (n) && n == fix (n))) error ("shiftdim: N must be a scalar integer"); endif @@ -78,7 +73,7 @@ elseif (n > 0) ## We need permute here instead of reshape to shift values in a ## compatible way. - y = permute (x, [n+1:ndims(x) 1:n]); + y = permute (x, [n+1:nd 1:n]); else y = x; endif @@ -86,3 +81,20 @@ ns = n; endfunction + + +%!test +%! x = rand (1, 1, 4, 2); +%! [y, ns] = shiftdim (x); +%! assert (size (y), [4 2]); +%! assert (ns, 2); +%! assert (shiftdim (y, -2), x); +%! assert (size (shiftdim (x, 2)), [4 2]); +%!assert (size (shiftdim (rand (0, 1, 2))), [0 1 2]); + +%% Test input validation +%!error(shiftdim ()); +%!error(shiftdim (1,2,3)); +%!error(shiftdim (1, ones (2))); +%!error(shiftdim (1, 1.5)); +
--- a/scripts/general/sortrows.m +++ b/scripts/general/sortrows.m @@ -25,6 +25,7 @@ ## lexicographical sort is used. By default ascending order is used ## however if elements of @var{c} are negative then the corresponding ## column is sorted in descending order. +## @seealso{sort} ## @end deftypefn ## Author: Daniel Calvelo, Paul Kienzle @@ -32,26 +33,38 @@ function [s, i] = sortrows (A, c) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 2) + if (! (isnumeric (c) && isvector (c))) + error ("sortrows: C must be a numeric vector"); + elseif (any (c == 0) || any (abs (c) > columns (A))) + error ("sortrows: all elements of C must be in the range [1, columns (A)]"); + endif + endif + default_mode = "ascend"; - other_mode = "descend"; + reverse_mode = "descend"; if (issparse (A)) - ## FIXME -- eliminate this case once __sort_rows_idx__ is fixed to - ## handle sparse matrices. + ## FIXME: Eliminate this case once __sort_rows_idx__ is fixed to + ## handle sparse matrices. if (nargin == 1) - i = sort_rows_idx_generic (default_mode, other_mode, A); + i = sort_rows_idx_generic (default_mode, reverse_mode, A); else - i = sort_rows_idx_generic (default_mode, other_mode, A, c); + i = sort_rows_idx_generic (default_mode, reverse_mode, A, c); endif elseif (nargin == 1) i = __sort_rows_idx__ (A, default_mode); elseif (all (c > 0)) i = __sort_rows_idx__ (A(:,c), default_mode); elseif (all (c < 0)) - i = __sort_rows_idx__ (A(:,-c), other_mode); + i = __sort_rows_idx__ (A(:,-c), reverse_mode); else ## Otherwise, fall back to the old algorithm. - i = sort_rows_idx_generic (default_mode, other_mode, A, c); + i = sort_rows_idx_generic (default_mode, reverse_mode, A, c); endif ## Only bother to compute s if needed. @@ -61,20 +74,20 @@ endfunction -function i = sort_rows_idx_generic (default_mode, other_mode, m, c) +function i = sort_rows_idx_generic (default_mode, reverse_mode, m, c) if (nargin == 3) - indices = [1:size(m,2)]'; - mode(1:size(m,2)) = {default_mode}; + indices = [1:columns(m)]'; + mode(1:columns(m)) = {default_mode}; else - for ii = 1:length (c); - if (c(ii) < 0) - mode{ii} = other_mode; + for j = 1:length (c); + if (c(j) < 0) + mode{j} = reverse_mode; else - mode{ii} = default_mode; + mode{j} = default_mode; endif endfor - indices = abs(c(:)); + indices = abs (c(:)); endif ## Since sort is 'stable' the order of identical elements will be @@ -83,9 +96,9 @@ ## index j. indices = flipud (indices); mode = flipud (mode'); - i = [1:size(m,1)]'; - for ii = 1:length (indices); - [trash, idx] = sort (m(i, indices(ii)), mode{ii}); + i = [1:rows(m)]'; + for j = 1:length (indices); + [~, idx] = sort (m(i, indices(j)), mode{j}); i = i(idx); endfor @@ -113,3 +126,12 @@ %! assert (issparse (sx)); %! assert (x, full (sx)); %! assert (idx, sidx); + +%% Test input validation +%!error sortrows () +%!error sortrows (1, 2, 3) +%!error sortrows (1, "ascend") +%!error sortrows (1, ones (2,2)) +%!error sortrows (1, 0) +%!error sortrows (1, 2) +
--- a/scripts/general/structfun.m +++ b/scripts/general/structfun.m @@ -106,7 +106,7 @@ [varargout{:}] = cellfun (func, struct2cell (S), varargin{:}); if (! uniform_output) - varargout = cellfun (@cell2struct, varargout, {fieldnames(S)}, {1}, uo_str, false); + varargout = cellfun ("cell2struct", varargout, {fieldnames(S)}, {1}, uo_str, false); endif endfunction @@ -120,9 +120,10 @@ %! "UniformOutput", false); %! assert (o, l); -%!function [a, b] = twoouts (x) +%!function [a, b] = __twoouts (x) %! a = x + x; %! b = x * x; +%!endfunction %!test %! s = struct ("a", {1, 2, 3}, "b", {4, 5, 6}); @@ -132,7 +133,7 @@ %! d(1:2, 1, 1) = [1; 16]; %! d(1:2, 1, 2) = [4; 25]; %! d(1:2, 1, 3) = [9; 36]; -%! [aa, bb] = structfun(@twoouts, s); +%! [aa, bb] = structfun(@__twoouts, s); %! assert(aa, c); %! assert(bb, d); @@ -140,6 +141,6 @@ %! s = struct ("a", {1, 2, 3}, "b", {4, 5, 6}); %! c = struct ("a", {2, 4, 6}, "b", {8, 10, 12}); %! d = struct ("a", {1, 4, 9}, "b", {16, 25, 36}); -%! [aa, bb] = structfun(@twoouts, s, "UniformOutput", false); +%! [aa, bb] = structfun(@__twoouts, s, "UniformOutput", false); %! assert(aa, c); %! assert(bb, d);
--- a/scripts/general/triplequad.m +++ b/scripts/general/triplequad.m @@ -37,22 +37,25 @@ ## ## The optional argument @var{quadf} specifies which underlying integrator ## function to use. Any choice but @code{quad} is available and the default -## is @code{quadgk}. +## is @code{quadcc}. ## ## Additional arguments, are passed directly to @var{f}. To use the default -## value for @var{tol} or @var{quadf} one may pass an empty matrix ([]). +## value for @var{tol} or @var{quadf} one may pass ':' or an empty matrix ([]). ## @seealso{dblquad, quad, quadv, quadl, quadgk, quadcc, trapz} ## @end deftypefn -function q = triplequad(f, xa, xb, ya, yb, za, zb, tol, quadf, varargin) +function q = triplequad (f, xa, xb, ya, yb, za, zb, tol = 1e-6, quadf = @quadcc, varargin) + if (nargin < 7) print_usage (); endif - if (nargin < 8 || isempty (tol)) + + ## Allow use of empty matrix ([]) to indicate default + if (isempty (tol)) tol = 1e-6; endif - if (nargin < 9 || isempty (quadf)) - quadf = @quadgk; + if (isempty (quadf)) + quadf = @quadcc; endif inner = @__triplequad_inner__; @@ -61,7 +64,8 @@ varargin = {}; endif - q = dblquad(@(y, z) inner (y, z, f, xa, xb, tol, quadf, varargin{:}),ya, yb, za, zb, tol); + q = dblquad (@(y, z) inner (y, z, f, xa, xb, tol, quadf, varargin{:}), ya, yb, za, zb, tol); + endfunction function q = __triplequad_inner__ (y, z, f, xa, xb, tol, quadf, varargin) @@ -71,8 +75,11 @@ endfor endfunction -%% These tests are too expensive to run normally. Disable them -% !#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadgk), pi ^ (3/2) * erf(1).^3, 1e-6) -% !#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadl), pi ^ (3/2) * erf(1).^3, 1e-6) -% !#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadv), pi ^ (3/2) * erf(1).^3, 1e-6) + +%!assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadcc), pi ^ (3/2) * erf(1).^3, 1e-6) +%% These tests are too expensive to run normally (~30 sec each). Disable them +#%!assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadgk), pi ^ (3/2) * erf(1).^3, 1e-6) +#%!#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadl), pi ^ (3/2) * erf(1).^3, 1e-6) +#%!#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadv), pi ^ (3/2) * erf(1).^3, 1e-6) +
--- a/scripts/geometry/convhull.m +++ b/scripts/geometry/convhull.m @@ -18,35 +18,44 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{H} =} convhull (@var{x}, @var{y}) -## @deftypefnx {Function File} {@var{H} =} convhull (@var{x}, @var{y}, @var{opt}) -## Return the index vector to the points of the enclosing convex hull. The -## data points are defined by the x and y vectors. +## @deftypefnx {Function File} {@var{H} =} convhull (@var{x}, @var{y}, @var{options}) +## Compute the convex hull of the set of points defined by the +## vectors @var{x} and @var{y}. The hull @var{H} is an index vector into +## the set of points and specifies which points form the enclosing hull. ## -## A third optional argument, which must be a string, contains extra options -## passed to the underlying qhull command. See the documentation for the -## Qhull library for details. +## An optional third argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default option is @code{@{"Qt"@}}. ## -## @seealso{delaunay, convhulln} +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## 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{convhulln, delaunay, voronoi} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> -function H = convhull (x, y, opt) +function H = convhull (x, y, options) if (nargin != 2 && nargin != 3) print_usage (); endif - if (isvector (x) && isvector (y) && length (x) == length (y)) - if (nargin == 2) - i = convhulln ([x(:), y(:)]); - elseif (ischar (opt) || iscell (opt)) - i = convhulln ([x(:), y(:)], opt); - else - error ("convhull: third argument must be a string or cell array of strings"); - endif + if (! (isvector (x) && isvector (y) && length (x) == length (y)) + && ! size_equal (x, y)) + error ("convhull: X and Y must be the same size"); + elseif (nargin == 3 && ! (ischar (options) || iscellstr (options))) + error ("convhull: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 2) + i = convhulln ([x(:), y(:)]); else - error ("convhull: first two input arguments must be vectors of same size"); + i = convhulln ([x(:), y(:)], options); endif n = rows (i); @@ -71,16 +80,21 @@ endfor H(n + 1) = H(1); + endfunction -%!testif HAVE_QHULL -%! x = -3:0.5:3; -%! y = abs (sin (x)); -%! assert (convhull (x, y, {"s","Qci","Tcv","Pp"}), [1;7;13;12;11;10;4;3;2;1]) %!demo %! x = -3:0.05:3; %! y = abs (sin (x)); %! k = convhull (x, y); -%! plot (x(k),y(k),'r-',x,y,'b+'); +%! plot (x(k),y(k),"r-;convex hull;", x,y,"b+;points;"); %! axis ([-3.05, 3.05, -0.05, 1.05]); + +%!testif HAVE_QHULL +%! x = -3:0.5:3; +%! y = abs (sin (x)); +%! assert (convhull (x, y), [1;7;13;12;11;10;4;3;2;1]) + +%% FIXME: Need input validation tests +
--- a/scripts/geometry/delaunay.m +++ b/scripts/geometry/delaunay.m @@ -17,74 +17,103 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}) -## @deftypefnx {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}, @var{opt}) -## The return matrix of size [n, 3] contains a set triangles which are -## described by the indices to the data point x and y vector. -## The triangulation satisfies the Delaunay circum-circle criterion. -## No other data point is in the circum-circle of the defining triangle. +## @deftypefn {Function File} {} delaunay (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}, @var{options}) +## Compute the Delaunay triangulation for a 2-D set of points. +## The return value @var{tri} is a set of triangles which satisfies the +## Delaunay circum-circle criterion, i.e., only a single data point from +## [@var{x}, @var{y}] is within the circum-circle of the defining triangle. +## +## The set of triangles @var{tri} is a matrix of size [n, 3]. Each +## row defines a triangle and the three columns are the three vertices +## of the triangle. The value of @code{@var{tri}(i,j)} is an index into +## @var{x} and @var{y} for the location of the j-th vertex of the i-th +## triangle. ## -## A third optional argument, which must be a string, contains extra options -## passed to the underlying qhull command. See the documentation for the -## Qhull library for details. +## An optional third argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options are @code{@{"Qt", "Qbb", "Qc", "Qz"@}}. +## +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## 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. +## +## If no output argument is specified the resulting Delaunay triangulation +## is plotted along with the original set of points. ## ## @example ## @group ## x = rand (1, 10); -## y = rand (size (x)); +## y = rand (1, 10); ## T = delaunay (x, y); -## X = [x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1))]; -## Y = [y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1))]; +## VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; +## VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; ## axis ([0,1,0,1]); -## plot (X, Y, "b", x, y, "r*"); +## plot (VX, VY, "b", x, y, "r*"); ## @end group ## @end example -## @seealso{voronoi, delaunay3, delaunayn} +## @seealso{delaunay3, delaunayn, convhull, voronoi} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> -function ret = delaunay (x, y, opt) +function tri = delaunay (x, y, options) if (nargin != 2 && nargin != 3) print_usage (); endif - if ((isvector (x) && isvector (y) && length (x) == length (y)) - || size_equal (x, y)) - if (nargin == 2) - tri = delaunayn ([x(:), y(:)]); - elseif (ischar (opt) || iscellstr (opt)) - tri = delaunayn ([x(:), y(:)], opt); - else - error ("delaunay: third argument must be a string"); - endif + if (! (isvector (x) && isvector (y) && length (x) == length (y)) + && ! size_equal (x, y)) + error ("delaunay: X and Y must be the same size"); + elseif (nargin == 3 && ! (ischar (options) || iscellstr (options))) + error ("delaunay: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 2) + T = delaunayn ([x(:), y(:)]); else - error ("delaunay: first two input arguments must be matrices of same size"); + T = delaunayn ([x(:), y(:)], options); endif if (nargout == 0) x = x(:).'; y = y(:).'; - X = [x(tri(:,1)); x(tri(:,2)); x(tri(:,3)); x(tri(:,1))]; - Y = [y(tri(:,1)); y(tri(:,2)); y(tri(:,3)); y(tri(:,1))]; - plot(X, Y, 'b', x, y, 'r*'); + VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; + VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; + plot (VX, VY, "b", x, y, "r*"); else - ret = tri; + tri = T; endif + endfunction + +%!demo +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 1); +%! x = rand (1,10); +%! y = rand (1,10); +%! T = delaunay (x,y); +%! VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; +%! VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; +%! axis ([0,1,0,1]); +%! plot (VX,VY,"b", x,y,"r*"); + +%!testif HAVE_QHULL +%! x = [-1, 0, 1, 0]; +%! y = [0, 1, 0, -1]; +%! assert (sortrows (sort (delaunay (x, y), 2)), [1,2,4;2,3,4]); + %!testif HAVE_QHULL %! x = [-1, 0, 1, 0, 0]; %! y = [0, 1, 0, -1, 0]; -%! assert (sortrows (sort (delaunay (x, y), 2)), [1,2,5;1,4,5;2,3,5;3,4,5]) +%! assert (sortrows (sort (delaunay (x, y), 2)), [1,2,5;1,4,5;2,3,5;3,4,5]); -%!demo -%! rand ('state', 1); -%! x = rand(1,10); -%! y = rand(size(x)); -%! T = delaunay(x,y); -%! X = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; -%! Y = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; -%! axis([0,1,0,1]); -%! plot(X,Y,'b',x,y,'r*'); +%% FIXME: Need input validation tests +
--- a/scripts/geometry/delaunay3.m +++ b/scripts/geometry/delaunay3.m @@ -17,42 +17,61 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{T} =} delaunay3 (@var{x}, @var{y}, @var{z}) -## @deftypefnx {Function File} {@var{T} =} delaunay3 (@var{x}, @var{y}, @var{z}, @var{opt}) -## A matrix of size [n, 4] is returned. Each row contains a -## set of tetrahedron which are -## described by the indices to the data point vectors (x,y,z). +## @deftypefn {Function File} {@var{tetr} =} delaunay3 (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {@var{tetr} =} delaunay3 (@var{x}, @var{y}, @var{z}, @var{options}) +## Compute the Delaunay triangulation for a 3-D set of points. +## The return value @var{tetr} is a set of tetrahedrons which satisfies the +## Delaunay circum-circle criterion, i.e., only a single data point from +## [@var{x}, @var{y}, @var{z}] is within the circum-circle of the defining +## tetrahedron. ## -## A fourth optional argument, which must be a string or cell array of strings, -## contains extra options passed to the underlying qhull command. See the -## documentation for the Qhull library for details. -## @seealso{delaunay, delaunayn} +## The set of tetrahedrons @var{tetr} is a matrix of size [n, 4]. Each +## row defines a tetrahedron and the four columns are the four vertices +## of the tetrahedron. The value of @code{@var{tetr}(i,j)} is an index into +## @var{x}, @var{y}, @var{z} for the location of the j-th vertex of the i-th +## tetrahedron. +## +## An optional fourth argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options are @code{@{"Qt", "Qbb", "Qc", "Qz"@}}. +## +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## 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} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> -function tetr = delaunay3 (x, y, z, opt) +function tetr = delaunay3 (x, y, z, options) - if (nargin != 3 && nargin != 4) + if (nargin < 3 || nargin > 4) print_usage (); endif - if (isvector (x) && isvector (y) &&isvector (z) - && length (x) == length (y) && length(x) == length (z)) - if (nargin == 3) - tetr = delaunayn ([x(:), y(:), z(:)]); - elseif (ischar (opt) || iscell (opt)) - tetr = delaunayn ([x(:), y(:), z(:)], opt); - else - error ("delaunay3: fourth argument must be a string or cell array of strings"); - endif + if (! (isvector (x) && isvector (y) && isvector (z) + && length (x) == length (y) && length(x) == length (z))) + error ("delaunay: X, Y, and Z must be the same size"); + elseif (nargin == 4 && ! (ischar (options) || iscellstr (options))) + error ("delaunay3: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 3) + tetr = delaunayn ([x(:), y(:), z(:)]); else - error ("delaunay3: first three input arguments must be vectors of same size"); + tetr = delaunayn ([x(:), y(:), z(:)], options); endif endfunction + %!testif HAVE_QHULL %! x = [-1, -1, 1, 0, -1]; y = [-1, 1, 1, 0, -1]; z = [0, 0, 0, 1, 1]; %! assert (sortrows (sort (delaunay3 (x, y, z), 2)), [1,2,3,4;1,2,4,5]) +%% FIXME: Need input validation tests +
--- a/scripts/geometry/delaunayn.m +++ b/scripts/geometry/delaunayn.m @@ -17,66 +17,77 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{t} =} delaunayn (@var{p}) -## @deftypefnx {Function File} {@var{t} =} delaunayn (@var{p}, @var{opt}) -## Form the Delaunay triangulation for a set of points. -## The Delaunay triangulation is a tessellation of the convex hull of the -## points such that no n-sphere defined by the n-triangles contains +## @deftypefn {Function File} {@var{T} =} delaunayn (@var{pts}) +## @deftypefnx {Function File} {@var{T} =} delaunayn (@var{pts}, @var{options}) +## Compute the Delaunay triangulation for an N-dimensional set of points. +## The Delaunay triangulation is a tessellation of the convex hull of a set +## of points such that no N-sphere defined by the N-triangles contains ## any other points from the set. -## The input matrix @var{p} of size @code{[n, dim]} contains @math{n} -## points in a space of dimension dim. The return matrix @var{t} has the -## size @code{[m, dim+1]}. It contains for each row a set of indices to -## the points, which describes a simplex of dimension dim. For example, -## a 2-D simplex is a triangle and 3-D simplex is a tetrahedron. +## +## The input matrix @var{pts} of size [n, dim] contains n points in a space of +## dimension dim. The return matrix @var{T} has size [m, dim+1]. Each row +## of @var{T} contains a set of indices back into the original set of points +## @var{pts} which describes a simplex of dimension dim. For example, a 2-D +## simplex is a triangle and 3-D simplex is a tetrahedron. ## -## Extra options for the underlying Qhull command can be specified by the -## second argument. This argument is a cell array of strings. The default -## options depend on the dimension of the input: +## An optional second argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options depend on the dimension of the input: ## ## @itemize -## @item 2D and 3D: @var{opt} = @code{@{"Qt", "Qbb", "Qc"@}} +## @item 2-D and 3-D: @var{options} = @code{@{"Qt", "Qbb", "Qc", "Qz"@}} ## -## @item 4D and higher: @var{opt} = @code{@{"Qt", "Qbb", "Qc", "Qz"@}} +## @item 4-D and higher: @var{options} = @code{@{"Qt", "Qbb", "Qc", "Qx"@}} ## @end itemize ## -## If @var{opt} is [], then the default arguments are used. If @var{opt} -## is @code{@{"@w{}"@}}, then none of the default arguments are used by Qhull. -## See the Qhull documentation for the available options. +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## 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. ## -## All options can also be specified as single string, for example -## @code{"Qt Qbb Qc Qz"}. -## +## @seealso{delaunay, delaunay3, convhulln, voronoin} ## @end deftypefn -function t = delaunayn (p, varargin) +function T = delaunayn (pts, varargin) + if (nargin < 1) print_usage (); endif - t = __delaunayn__ (p, varargin{:}); + T = __delaunayn__ (pts, varargin{:}); - if (isa (p, "single")) + if (isa (pts, "single")) myeps = eps ("single"); else myeps = eps; endif - ## Try to remove the zero volume simplices. The volume of the i-th simplex is - ## given by abs(det(p(t(i,1:end-1),:)-p(t(i,2:end),:)))/prod(1:n) - ## (reference http://en.wikipedia.org/wiki/Simplex). Any simplex with a - ## relative volume less than some arbitrary criteria is rejected. The + ## Try to remove the zero volume simplices. The volume of the i-th simplex is + ## given by abs(det(pts(T(i,1:end-1),:)-pts(T(i,2:end),:)))/prod(1:n) + ## (reference http://en.wikipedia.org/wiki/Simplex). Any simplex with a + ## relative volume less than some arbitrary criteria is rejected. The ## criteria we use is the volume of the simplex corresponding to an ## orthogonal simplex is equal edge length all equal to the edge length of - ## the original simplex. If the relative volume is 1e3*eps then the simplex - ## is rejected. Note division of the two volumes means that the factor + ## the original simplex. If the relative volume is 1e3*eps then the simplex + ## is rejected. Note division of the two volumes means that the factor ## prod(1:n) is dropped. idx = []; - [nt, n] = size (t); + [nt, n] = size (T); + ## FIXME: Vectorize this for loop or convert to delaunayn to .oct function for i = 1:nt - X = p(t(i,1:end-1),:) - p(t(i,2:end),:); - if (abs (det (X)) / sqrt (sum (X .^ 2, 2)) < 1e3 * myeps) - idx = [idx, i]; + X = pts(T(i,1:end-1),:) - pts(T(i,2:end),:); + if (abs (det (X)) / sqrt (sum (X .^ 2, 2)) < 1e3 * myeps) + idx(end+1) = i; endif endfor - t(idx,:) = []; + T(idx,:) = []; + endfunction + + +%% FIXME: Need tests for delaunayn + +%% FIXME: Need input validation tests +
--- a/scripts/geometry/griddata3.m +++ b/scripts/geometry/griddata3.m @@ -53,28 +53,32 @@ vi = griddatan ([x(:), y(:), z(:)], v(:), [xi(:), yi(:), zi(:)], varargin{:}); vi = reshape (vi, size (xi)); + endfunction + %!testif HAVE_QHULL -%! rand('state', 0); -%! x = 2 * rand(1000, 1) - 1; -%! y = 2 * rand(1000, 1) - 1; -%! z = 2 * rand(1000, 1) - 1; +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 0); +%! x = 2 * rand (1000, 1) - 1; +%! y = 2 * rand (1000, 1) - 1; +%! z = 2 * rand (1000, 1) - 1; %! v = x.^2 + y.^2 + z.^2; %! [xi, yi, zi] = meshgrid (-0.8:0.2:0.8); -%! ##vi = reshape (griddatan([x(:), y(:), z(:)], v, [xi(:), yi(:), zi(:)], 'linear'), size (xi)); %! vi = griddata3 (x, y, z, v, xi, yi, zi, 'linear'); %! vv = vi - xi.^2 - yi.^2 - zi.^2; -%! assert (max(abs(vv(:))), 0, 0.1) +%! assert (max (abs (vv(:))), 0, 0.1); %!testif HAVE_QHULL -%! rand('state', 0); -%! x = 2 * rand(1000, 1) - 1; -%! y = 2 * rand(1000, 1) - 1; -%! z = 2 * rand(1000, 1) - 1; +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 0); +%! x = 2 * rand (1000, 1) - 1; +%! y = 2 * rand (1000, 1) - 1; +%! z = 2 * rand (1000, 1) - 1; %! v = x.^2 + y.^2 + z.^2; %! [xi, yi, zi] = meshgrid (-0.8:0.2:0.8); -%! ##vi = reshape (griddatan([x(:), y(:), z(:)], v, [xi(:), yi(:), zi(:)], 'linear'), size (xi)); %! vi = griddata3 (x, y, z, v, xi, yi, zi, 'nearest'); %! vv = vi - xi.^2 - yi.^2 - zi.^2; -%! assert (max(abs(vv(:))), 0, 0.1) +%! assert (max (abs (vv(:))), 0, 0.1)
--- a/scripts/geometry/inpolygon.m +++ b/scripts/geometry/inpolygon.m @@ -130,3 +130,14 @@ %! disp("Green points are inside polygon, magenta are outside,"); %! disp("and blue are on boundary."); +%!error inpolygon (); +%!error inpolygon (1, 2); +%!error inpolygon (1, 2, 3); + +%!error inpolygon (1, [1,2], [3, 4], [5, 6]); +%!error inpolygon ([1,2], [3, 4], [5, 6], 1); + +%!test +%! [in, on] = inpolygon ([1, 0], [1, 0], [-1, -1, 1, 1], [-1, 1, 1, -1]); +%! assert (in, [false, true]); +%! assert (on, [true, false]);
--- a/scripts/geometry/module.mk +++ b/scripts/geometry/module.mk @@ -12,9 +12,6 @@ geometry/griddatan.m \ geometry/inpolygon.m \ geometry/rectint.m \ - geometry/trimesh.m \ - geometry/triplot.m \ - geometry/trisurf.m \ geometry/tsearchn.m \ geometry/voronoi.m \ geometry/voronoin.m
--- a/scripts/geometry/voronoi.m +++ b/scripts/geometry/voronoi.m @@ -18,18 +18,27 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} voronoi (@var{x}, @var{y}) -## @deftypefnx {Function File} {} voronoi (@var{x}, @var{y}, "plotstyle") -## @deftypefnx {Function File} {} voronoi (@var{x}, @var{y}, "plotstyle", @var{options}) +## @deftypefnx {Function File} {} voronoi (@var{x}, @var{y}, @var{options}) +## @deftypefnx {Function File} {} voronoi (@dots{}, "linespec") +## @deftypefnx {Function File} {} voronoi (@var{hax}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} voronoi (@dots{}) ## @deftypefnx {Function File} {[@var{vx}, @var{vy}] =} voronoi (@dots{}) -## Plot Voronoi diagram of points @code{(@var{x}, @var{y})}. +## Plot the Voronoi diagram of points @code{(@var{x}, @var{y})}. ## The Voronoi facets with points at infinity are not drawn. -## [@var{vx}, @var{vy}] = voronoi(@dots{}) returns the vertices instead of -## plotting the -## diagram. plot (@var{vx}, @var{vy}) shows the Voronoi diagram. +## +## If "linespec" is given it is used to set the color and line style of the +## plot. If an axis graphics handle @var{hax} is supplied then the Voronoi +## diagram is drawn on the specified axis rather than in a new figure. ## -## A fourth optional argument, which must be a string, contains extra options -## passed to the underlying qhull command. See the documentation for the -## Qhull library for details. +## The @var{options} argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## +## If a single output argument is requested then the Voronoi diagram will be +## plotted and a graphics handle to the plot is returned. +## [@var{vx}, @var{vy}] = voronoi(@dots{}) returns the Voronoi vertices +## instead of plotting the diagram. ## ## @example ## @group @@ -57,23 +66,23 @@ ## Added optional fourth argument to pass options to the underlying ## qhull command -function [vvx, vvy] = voronoi (varargin) +function [vx, vy] = voronoi (varargin) if (nargin < 1) print_usage (); + elseif (nargout > 2) + error ("voronoi: No more than two output arguments supported"); endif narg = 1; if (isscalar (varargin{1}) && ishandle (varargin{1})) handl = varargin{1}; - narg++; if (! strcmp (get (handl, "type"), "axes")) error ("voronoi: expecting first argument to be an axes object"); endif - else - if (nargout < 2) - handl = gca (); - endif + narg++; + elseif (nargout < 2) + handl = gca (); endif if (nargin < 1 + narg || nargin > 3 + narg) @@ -87,24 +96,22 @@ if (narg <= nargin) if (iscell (varargin{narg})) opts = varargin(narg++); - elseif (ismatrix (varargin{narg})) - ## Accept but ignore the triangulation + elseif (isnumeric (varargin{narg})) + ## Accept, but ignore, the triangulation narg++; endif endif linespec = {"b"}; - if (narg <= nargin) - if (ischar (varargin{narg})) - linespec = varargin(narg); - endif + if (narg <= nargin && ischar (varargin{narg})) + linespec = varargin(narg); endif lx = length (x); ly = length (y); if (lx != ly) - error ("voronoi: arguments must be vectors of same length"); + error ("voronoi: X and Y must be vectors of the same length"); endif ## Add box to approximate rays to infinity. For Voronoi diagrams the @@ -126,12 +133,12 @@ [p, c, infi] = __voronoi__ ([[x(:) ; xbox(:)], [y(:); ybox(:)]], opts{:}); - idx = find (!infi); + idx = find (! infi); ll = length (idx); c = c(idx).'; - k = sum (cellfun ('length', c)); - edges = cell2mat(cellfun (@(x) [x ; [x(end), x(1:end-1)]], c, - "uniformoutput", false)); + k = sum (cellfun ("length", c)); + edges = cell2mat (cellfun (@(x) [x ; [x(end), x(1:end-1)]], c, + "uniformoutput", false)); ## Identify the unique edges of the Voronoi diagram edges = sortrows (sort (edges).').'; @@ -147,22 +154,34 @@ edges (:, edgeoutside) = []; ## Get points of the diagram - vx = reshape (p (edges, 1), size(edges)); - vy = reshape (p (edges, 2), size(edges)); + Vvx = reshape (p(edges, 1), size (edges)); + Vvy = reshape (p(edges, 2), size (edges)); if (nargout < 2) lim = [xmin, xmax, ymin, ymax]; - h = plot (handl, vx, vy, linespec{:}, x, y, '+'); + h = plot (handl, Vvx, Vvy, linespec{:}, x, y, '+'); axis (lim + 0.1 * [[-1, 1] * (lim (2) - lim (1)), ... [-1, 1] * (lim (4) - lim (3))]); if (nargout == 1) - vxx = h; + vx = h; endif - elseif (nargout == 2) - vvx = vx; - vvy = vy; else - error ("voronoi: only two or zero output arguments supported"); + vx = Vvx; + vy = Vvy; endif endfunction + + +%!demo +%! voronoi (rand(10,1), rand(10,1)); + +%!testif HAVE_QHULL +%! phi = linspace (-pi, 3/4*pi, 8); +%! [x,y] = pol2cart (phi, 1); +%! [vx,vy] = voronoi (x,y); +%! assert(vx(2,:), zeros (1, columns (vx)), eps); +%! assert(vy(2,:), zeros (1, columns (vy)), eps); + +%% FIXME: Need input validation tests +
--- a/scripts/geometry/voronoin.m +++ b/scripts/geometry/voronoin.m @@ -20,14 +20,15 @@ ## @deftypefn {Function File} {[@var{C}, @var{F}] =} voronoin (@var{pts}) ## @deftypefnx {Function File} {[@var{C}, @var{F}] =} voronoin (@var{pts}, @var{options}) ## Compute N-dimensional Voronoi facets. The input matrix @var{pts} -## of size [n, dim] contains n points of dimension dim. +## of size [n, dim] contains n points in a space of dimension dim. ## @var{C} contains the points of the Voronoi facets. The list @var{F} -## contains for each facet the indices of the Voronoi points. +## contains, for each facet, the indices of the Voronoi points. ## -## A second optional argument, which must be a string, contains extra options -## passed to the underlying qhull command. See the documentation for the -## Qhull library for details. -## @seealso{voronoin, delaunay, convhull} +## An optional second argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## @seealso{voronoi, convhulln, delaunayn} ## @end deftypefn ## Author: Kai Habel <kai.habel@gmx.de> @@ -43,17 +44,24 @@ print_usage (); endif - [np, dims] = size (pts); - if (np > dims) - if (nargin == 1) - [C, F, infi] = __voronoi__ (pts); - elseif (ischar (options)) - [C, F, infi] = __voronoi__ (pts, options); - else - error ("voronoin: second argument must be a string"); - endif + [np, dim] = size (pts); + + if (np <= dim) + error ("voronoin: number of points must be greater than their dimension"); + elseif (nargin == 2 && ! (ischar (options) || iscellstr (options))) + error ("voronoin: OPTIONS argument must be a string or cell array of strings"); + endif + if (nargin == 1) + [C, F] = __voronoi__ (pts); else - error ("voronoin: number of points must be greater than their dimension"); + [C, F] = __voronoi__ (pts, options); endif + endfunction + + +%% FIXME: Need functional tests + +%% FIXME: Need input validation tests +
--- a/scripts/help/__makeinfo__.m +++ b/scripts/help/__makeinfo__.m @@ -57,87 +57,52 @@ ## The optional output argument @var{status} contains the exit status of the ## @code{makeinfo} program as returned by @code{system}. -function [retval, status] = __makeinfo__ (text, output_type = "plain text", see_also = []) +function [retval, status] = __makeinfo__ (text, output_type = "plain text", fsee_also) ## Check input - if (nargin == 0) + if (nargin < 1 || nargin > 3) print_usage (); endif - if (!ischar (text)) + if (! ischar (text)) error ("__makeinfo__: first input argument must be a string"); endif - if (!ischar (output_type)) + if (! ischar (output_type)) error ("__makeinfo__: second input argument must be a string"); endif - ## Define the function which expands @seealso macro - if (isempty (see_also)) + if (nargin < 3) if (strcmpi (output_type, "plain text")) - see_also = @simple_see_also; + fsee_also = @(T) strcat ... + ("\nSee also:", sprintf (" %s,", T{:})(1:end-1), "\n"); else - see_also = @simple_see_also_with_refs; + fsee_also = @(T) strcat ... + ("\nSee also:", sprintf (" @ref{%s},", T{:})(1:end-1), "\n"); endif endif - if (!isa (see_also, "function_handle")) - error ("__makeinfo__: third input argument must be the empty matrix, or a function handle"); + if (! isa (fsee_also, "function_handle")) + error ("__makeinfo__: third input argument must be a function handle"); endif + ## It seems like makeinfo sometimes gets angry if the first character ## on a line is a space, so we remove these. text = strrep (text, "\n ", "\n"); ## Handle @seealso macro - SEE_ALSO = "@seealso"; - starts = strfind (text, SEE_ALSO); - for start = fliplr (starts) - if (start == 1 || (text (start-1) != "@")) - bracket_start = find (text (start:end) == "{", 1); - stop = find (text (start:end) == "}", 1); - if (!isempty (stop) && !isempty (bracket_start)) - stop += start - 1; - bracket_start += start - 1; - else - bracket_start = start + length (SEE_ALSO); - stop = find (text (start:end) == "\n", 1); - if (isempty (stop)) - stop = length (text); - else - stop += start - 1; - endif - endif - see_also_args = text (bracket_start+1:(stop-1)); - see_also_args = strtrim (strsplit (see_also_args, ",")); - expanded = see_also (see_also_args); - text = strcat (text (1:start-1), expanded, text (stop+1:end)); - endif + see_also_pat = '@seealso *\{(.*)\}'; + args = regexp (text, see_also_pat, 'tokens'); + for ii = 1:numel (args) + expanded = fsee_also (strtrim (strsplit (args{ii}{:}, ',', true))); + text = regexprep (text, see_also_pat, expanded, 'once'); endfor ## Handle @nospell macro - NOSPELL = "@nospell"; - starts = strfind (text, NOSPELL); - for start = fliplr (starts) - if (start == 1 || (text (start-1) != "@")) - bracket_start = find (text (start:end) == "{", 1); - stop = find (text (start:end) == "}", 1); - if (!isempty (stop) && !isempty (bracket_start)) - stop += start - 1; - bracket_start += start - 1; - else - bracket_start = start + length (NOSPELL); - stop = find (text (start:end) == "\n", 1); - if (isempty (stop)) - stop = length (text); - else - stop += start - 1; - endif - endif - text(stop) = []; - text(start:bracket_start) = []; - endif - endfor + text = regexprep (text, '@nospell *\{([^}]*)\}', "$1"); + ## Handle @xcode macro + text = regexprep (text, '@xcode *\{([^}]*)\}', "$1"); if (strcmpi (output_type, "texinfo")) status = 0; @@ -151,7 +116,7 @@ unwind_protect ## Write Texinfo to tmp file template = "octave-help-XXXXXX"; - [fid, name, msg] = mkstemp (fullfile (P_tmpdir, template), true); + [fid, name] = mkstemp (fullfile (P_tmpdir, template), true); if (fid < 0) error ("__makeinfo__: could not create temporary file"); endif @@ -161,11 +126,11 @@ ## Take action depending on output type switch (lower (output_type)) case "plain text" - cmd = sprintf ("%s --no-headers --no-warn --force --no-validate %s", - makeinfo_program (), name); + cmd = sprintf ("%s --no-headers --no-warn --force --no-validate %s", + makeinfo_program (), name); case "html" - cmd = sprintf ("%s --no-headers --html --no-warn --no-validate --force %s", - makeinfo_program (), name); + cmd = sprintf ("%s --no-headers --html --no-warn --no-validate --force %s", + makeinfo_program (), name); otherwise error ("__makeinfo__: unsupported output type: '%s'", output_type); endswitch @@ -180,12 +145,6 @@ end_unwind_protect endfunction -function expanded = simple_see_also (args) - expanded = strcat ("\nSee also:", sprintf (" %s,", args {:})); - expanded = strcat (expanded (1:end-1), "\n\n"); -endfunction +## No test needed for internal helper function. +%!assert (1) -function expanded = simple_see_also_with_refs (args) - expanded = strcat ("\nSee also:", sprintf (" @ref{%s},", args {:})); - expanded = strcat (expanded (1:end-1), "\n\n"); -endfunction
--- a/scripts/help/gen_doc_cache.m +++ b/scripts/help/gen_doc_cache.m @@ -32,6 +32,7 @@ ## @end deftypefn function gen_doc_cache (out_file = "doc-cache", directory = []) + ## Check input if (!ischar (out_file)) print_usage (); @@ -143,3 +144,8 @@ cache = create_cache (list); endfunction + +%% No true tests desirable for this function. +%% Test input validation +%!error gen_doc_cache (1) +
--- a/scripts/help/get_first_help_sentence.m +++ b/scripts/help/get_first_help_sentence.m @@ -50,7 +50,7 @@ error ("get_first_help_sentence: NAME must be a string"); endif - if (!isnumeric (max_len) || max_len <= 0 || max_len != round (max_len)) + if (!isnumeric (max_len) || max_len <= 0 || max_len != fix (max_len)) error ("get_first_help_sentence: MAX_LEN must be positive integer"); endif
--- a/scripts/help/help.m +++ b/scripts/help/help.m @@ -179,3 +179,7 @@ endif endfunction + + +%!assert (! isempty (findstr (help ("ls"), "List directory contents"))) +%!error <invalid input> help (42)
--- a/scripts/help/lookfor.m +++ b/scripts/help/lookfor.m @@ -42,17 +42,18 @@ ## @end deftypefn function [out_fun, out_help_text] = lookfor (str, arg2) + if (strcmpi (str, "-all")) ## The difference between using '-all' and not, is which part of the caches - ## we search. The cache is organised such that its first column contains - ## the function name, its second column contains the full help text, and its - ## third column contains the first sentence of the help text. + ## we search. The cache is organized such that the first column contains + ## the function name, the second column contains the full help text, and + ## the third column contains the first sentence of the help text. str = arg2; - search_type = 2; # when using caches, search its second column + search_type = 2; # when using caches, search the second column else - search_type = 3; # when using caches, search its third column + search_type = 3; # when using caches, search the third column endif - str = lower (str); + str = lower (str); # Compare is case insensitive ## Search functions, operators, and keywords that come with Octave cache_file = doc_cache_file (); @@ -81,16 +82,16 @@ if (exist (cache_file, "file")) ## We have a cache in the directory, then read it and search it! [funs, hts] = search_cache (str, cache_file, search_type); - fun (end+1:end+length (funs)) = funs; - help_text (end+1:end+length (hts)) = hts; + fun(end+1:end+length (funs)) = funs; + help_text(end+1:end+length (hts)) = hts; else ## We don't have a cache. Search files funs_in_f = __list_functions__ (elt); for m = 1:length (funs_in_f) - fn = funs_in_f {m}; + fn = funs_in_f{m}; ## Skip files that start with __ - if (length (fn) > 2 && strcmp (fn (1:2), "__")) + if (length (fn) > 2 && strcmp (fn(1:2), "__")) continue; endif @@ -99,7 +100,7 @@ warn_state = warning (); unwind_protect warning ("off"); - first_sentence = get_first_help_sentence (fn); + first_sentence = get_first_help_sentence (fn, 1024); status = 0; unwind_protect_cleanup warning (warn_state); @@ -139,28 +140,29 @@ endif ## Search the help text, if we can - if (status == 0 && !isempty (strfind (text, str))) - fun (end+1) = fn; - help_text (end+1) = first_sentence; + if (status == 0 && ! isempty (strfind (lower (text), str))) + fun(end+1) = fn; + help_text(end+1) = first_sentence; endif endfor endif endfor if (nargout == 0) - ## Print the results (FIXME: improve this to make it look better. + ## Print the results (FIXME: it would be nice to break at word boundaries) indent = 20; - term_width = terminal_size() (2); + term_width = (terminal_size ())(2); desc_width = term_width - indent - 2; - indent_space = repmat (" ", 1, indent); + indent_space = blanks (indent); for k = 1:length (fun) - f = fun {k}; - f (end+1:indent) = " "; - printf (f); - desc = strtrim (strrep (help_text {k}, "\n", " ")); + f = fun{k}; + f(end+1:indent-1) = " "; + puts ([f " "]); + lf = length (f); + desc = strtrim (strrep (help_text{k}, "\n", " ")); ldesc = length (desc); - printf ("%s\n", desc (1:min (desc_width, ldesc))); - for start = desc_width+1:desc_width:ldesc + printf ("%s\n", desc(1:min (ldesc, desc_width - (lf - indent)))); + for start = (desc_width - (lf - indent) + 1):desc_width:ldesc stop = min (start + desc_width, ldesc); printf ("%s%s\n", indent_space, strtrim (desc (start:stop))); endfor @@ -171,17 +173,19 @@ out_fun = fun; out_help_text = help_text; endif + endfunction function [funs, help_texts] = search_cache (str, cache_file, search_type) load (cache_file); if (! isempty (cache)) - t1 = strfind (cache (1, :), str); - t2 = strfind (cache (search_type, :), str); + t1 = strfind (lower (cache (1, :)), str); + t2 = strfind (lower (cache (search_type, :)), str); cache_idx = find (! (cellfun ("isempty", t1) & cellfun ("isempty", t2))); - funs = cache (1, cache_idx); - help_texts = cache (3, cache_idx); + funs = cache(1, cache_idx); + help_texts = cache(3, cache_idx); else funs = help_texts = {}; endif endfunction +
--- a/scripts/help/module.mk +++ b/scripts/help/module.mk @@ -1,11 +1,11 @@ FCN_FILE_DIRS += help help_PRIVATE_FCN_FILES = \ - help/private/__additional_help_message__.m + help/private/__additional_help_message__.m \ + help/private/__strip_html_tags__.m help_FCN_FILES = \ help/__makeinfo__.m \ - help/__strip_html_tags__.m \ help/doc.m \ help/gen_doc_cache.m \ help/get_first_help_sentence.m \ @@ -13,6 +13,7 @@ help/lookfor.m \ help/print_usage.m \ help/type.m \ + help/unimplemented.m \ help/which.m \ $(help_PRIVATE_FCN_FILES)
--- a/scripts/help/print_usage.m +++ b/scripts/help/print_usage.m @@ -136,3 +136,7 @@ retval = get_usage_plain_text (help_text, max_len); endfunction + +## Stop reporting function as missing tests. No good tests possible. +%!assert (1) +
--- a/scripts/help/type.m +++ b/scripts/help/type.m @@ -111,4 +111,14 @@ endfor endfunction +%!test +%! var = 1; +%! typestr = type ("var"); +%! typestr = typestr{1}(1:17); +%! assert (typestr, "var is a variable"); +%!assert (type ('dot'){1}, "dot is a dynamically-linked function") +%!assert (type ('cat'){1}, "cat is a built-in function") +%!assert (type ('+'){1}, "+ is an operator") +%!assert (type ('end'){1}, "end is a keyword") +%!error (type ('NO_NAME'))
rename from scripts/miscellaneous/unimplemented.m rename to scripts/help/unimplemented.m --- a/scripts/miscellaneous/unimplemented.m +++ b/scripts/help/unimplemented.m @@ -29,12 +29,17 @@ ## Some smarter cases, add more as needed. switch (fcn) + case "importdata" + txt = ["importdata is not implemented. Similar functionality is ",... + "available through @code{load}, @code{dlmread}, @code{csvread}, ",... + "or @code{textscan}."]; + case "quad2d" txt = ["quad2d is not implemented. Consider using dblquad."]; case "gsvd" - txt = ["gsvd is not currently part of Octave. See the linear-algebra",... - "package at @url{http://octave.sf.net/linear-algebra/}."]; + txt = ["gsvd is not currently part of core Octave. See the ", + "linear-algebra package at @url{http://octave.sf.net/linear-algebra/}."]; case "linprog" txt = ["Octave does not currently provide linprog. ",... @@ -76,7 +81,6 @@ "RandStream", "TriRep", "TriScatteredInterp", - "addpref", "align", "alim", "alpha", @@ -95,7 +99,6 @@ "bar3h", "bench", "betaincinv", - "bicg", "bicgstabl", "brush", "builddocsearchdb", @@ -188,7 +191,6 @@ "gco", "getframe", "getpixelposition", - "getpref", "gmres", "grabcode", "graymon", @@ -233,7 +235,6 @@ "isinterface", "isjava", "isocaps", - "ispref", "isstudent", "javaArray", "javaMethod", @@ -333,18 +334,14 @@ "reducepatch", "reducevolume", "resample", - "reset", "rgbplot", - "rmpref", "root", "rotate", "rotate3d", - "rsf2csf", "selectmoveresize", "sendmail", "serial", "setpixelposition", - "setpref", "showplottool", "shrinkfaces", "smooth3", @@ -399,14 +396,12 @@ "unicode2native", "unloadlibrary", "unmesh", - "usejava", "userpath", "validateattributes", "verLessThan", "viewmtx", "visdiff", "volumebounds", - "waitbar", "waitfor", "warndlg", "waterfall", @@ -428,3 +423,14 @@ "zoom", }; endfunction + + +%!test +%! str = unimplemented ("no_name_function"); +%! assert (isempty (str)); +%! str = unimplemented ("quad2d"); +%! assert (str(1:51), "quad2d is not implemented. Consider using dblquad."); +%! str = unimplemented ("MException"); +%! assert (str(1:58), "the `MException' function is not yet implemented in Octave"); + +
--- a/scripts/help/which.m +++ b/scripts/help/which.m @@ -53,3 +53,13 @@ endif endfunction + + +%!test +%! str = which ("ls"); +%! assert (str(end-17:end), strcat ("miscellaneous", filesep(), "ls.m")); +%!test +%! str = which ("dot"); +%! assert (str(end-6:end), "dot.oct"); + +%!assert (which ("NO_NAME"), "");
--- a/scripts/image/image.m +++ b/scripts/image/image.m @@ -19,9 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} image (@var{img}) ## @deftypefnx {Function File} {} image (@var{x}, @var{y}, @var{img}) -## Display a matrix as a color image. The elements of @var{x} are indices +## Display a matrix as a color image. The elements of @var{img} are indices ## into the current colormap, and the colormap will be scaled so that the -## extremes of @var{x} are mapped to the extremes of the colormap. +## extremes of @var{img} are mapped to the extremes of the colormap. ## ## The axis values corresponding to the matrix elements are specified in ## @var{x} and @var{y}. If you're not using gnuplot 4.2 or later, these
--- a/scripts/image/ind2rgb.m +++ b/scripts/image/ind2rgb.m @@ -40,7 +40,7 @@ endif ## Check if X is an indexed image. - if (ndims (x) != 2 || any (x(:) != round (x(:))) || min (x(:)) < 1) + if (ndims (x) != 2 || any (x(:) != fix (x(:))) || min (x(:)) < 1) error ("ind2rgb: X must be an indexed image"); endif
--- a/scripts/io/beep.m +++ b/scripts/io/beep.m @@ -26,10 +26,13 @@ function beep () - if (nargin == 0) - puts ("\a"); - else + if (nargin != 0) print_usage (); endif + puts ("\a"); + endfunction + + +%!error (beep (1))
--- a/scripts/io/csvread.m +++ b/scripts/io/csvread.m @@ -33,3 +33,9 @@ function x = csvread (filename, varargin) x = dlmread (filename, ",", varargin{:}); endfunction + + +%% Tests for csvread() are in csvwrite() +%% Mark file as being tested +%!assert (1) +
--- a/scripts/io/csvwrite.m +++ b/scripts/io/csvwrite.m @@ -34,3 +34,21 @@ function csvwrite (filename, x, varargin) dlmwrite (filename, x, ",", varargin{:}); endfunction + + +%!shared fname +%! fname = tmpnam (); + +%!test +%! csvwrite (fname, magic (3)); +%! assert (csvread (fname), magic (3)); +%! unlink (fname); + +%!test +%! csvwrite (fname, magic (3), "precision", "%2.1f", "newline", "unix"); +%! fid = fopen (fname, "rt"); +%! txt = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! assert (txt, "8.0,1.0,6.0\n3.0,5.0,7.0\n4.0,9.0,2.0\n"); +%! unlink (fname); +
--- a/scripts/io/dlmwrite.m +++ b/scripts/io/dlmwrite.m @@ -21,6 +21,7 @@ ## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, @var{delim}, @var{r}, @var{c}) ## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, @var{key}, @var{val} @dots{}) ## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, "-append", @dots{}) +## @deftypefnx {Function File} {} dlmwrite (@var{fid}, @dots{}) ## Write the matrix @var{M} to the named file using delimiters. ## ## @var{file} should be a file name or writable file ID given by @code{fopen}. @@ -34,7 +35,7 @@ ## The value of @var{c} specifies the number of delimiters to prepend to ## each line of data. ## -## If the argument @code{"-append"} is given, append to the end of the +## If the argument @code{"-append"} is given, append to the end of ## @var{file}. ## ## In addition, the following keyword value pairs may appear at the end @@ -86,14 +87,13 @@ function dlmwrite (file, M, varargin) - if (nargin < 2 || ! ischar (file)) + if (nargin < 2) print_usage (); endif ## set defaults delim = ","; - r = 0; - c = 0; + r = c = 0; newline = "\n"; if (ischar (M)) precision = "%c"; @@ -102,16 +102,14 @@ endif opentype = "wt"; - ## process the input arguements + ## process the input arguments i = 0; while (i < length (varargin)) - i = i + 1; + i++; if (strcmpi (varargin{i}, "delimiter")) - i = i + 1; - delim = varargin{i}; + delim = varargin{++i}; elseif (strcmpi (varargin{i}, "newline")) - i = i + 1; - newline = varargin{i}; + newline = varargin{++i}; if (strcmpi (newline, "unix")) newline = "\n"; elseif (strcmpi (newline, "pc")) @@ -120,27 +118,24 @@ newline = "\r"; endif elseif (strcmpi (varargin{i}, "roffset")) - i = i + 1; - r = varargin{i}; + r = varargin{++i}; elseif (strcmpi (varargin{i}, "coffset")) - i = i + 1; - c = varargin{i}; + c = varargin{++i}; elseif (strcmpi (varargin{i}, "precision")) - i = i + 1; - precision = varargin{i}; + precision = varargin{++i}; if (! strcmpi (class (precision), "char")) precision = sprintf ("%%.%gg", precision); endif elseif (strcmpi (varargin{i}, "-append")) opentype = "at"; elseif (strcmpi (varargin{i}, "append")) - i = i + 1; + i++; if (strcmpi (varargin{i}, "on")) opentype = "at"; elseif (strcmpi (varargin{i}, "off")) opentype = "wt"; else - error ("dlmwrite: append must be \"on\" or \"off\""); + error ('dlmwrite: append must be "on" or "off"'); endif else if (i == 1) @@ -158,21 +153,20 @@ if (ischar (file)) [fid, msg] = fopen (file, opentype); elseif (isscalar (file) && isnumeric (file)) - fid = file; - msg = "invalid file number"; + [fid, msg] = deal (file, "invalid file number"); else error ("dlmwrite: FILE must be a filename string or numeric FID"); endif if (fid < 0) - error (msg); + error (["dlmwrite: " msg]); else if (r > 0) fprintf (fid, "%s", repmat ([repmat(delim, 1, c + columns(M)-1), newline], 1, r)); endif if (iscomplex (M)) - cprecision = regexprep (precision, '^%([-\d.])','%+$1'); + cprecision = regexprep (precision, '^%([-\d.])', '%+$1'); template = [precision, cprecision, "i", ... repmat([delim, precision, cprecision, "i"], 1, ... columns(M) - 1), newline ]; @@ -196,19 +190,22 @@ fclose (fid); endif endif + endfunction + %!test -%! f = tmpnam(); -%! dlmwrite(f,[1,2;3,4],'precision','%5.2f','newline','unix','roffset',1,'coffset',1); -%! fid = fopen(f,"rt"); -%! f1 = char(fread(fid,Inf,'char')'); -%! fclose(fid); -%! dlmwrite(f,[5,6],'precision','%5.2f','newline','unix','coffset',1,'delimiter',',','-append'); -%! fid = fopen(f,"rt"); -%! f2 = char(fread(fid,Inf,'char')'); -%! fclose(fid); -%! unlink(f); +%! f = tmpnam (); +%! dlmwrite (f,[1,2;3,4],'precision','%5.2f','newline','unix','roffset',1,'coffset',1); +%! fid = fopen (f,"rt"); +%! f1 = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! dlmwrite (f,[5,6],'precision','%5.2f','newline','unix','coffset',1,'delimiter',',','-append'); +%! fid = fopen (f,"rt"); +%! f2 = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! unlink (f); %! -%! assert(f1,",,\n, 1.00, 2.00\n, 3.00, 4.00\n"); -%! assert(f2,",,\n, 1.00, 2.00\n, 3.00, 4.00\n, 5.00, 6.00\n"); +%! assert (f1,",,\n, 1.00, 2.00\n, 3.00, 4.00\n"); +%! assert (f2,",,\n, 1.00, 2.00\n, 3.00, 4.00\n, 5.00, 6.00\n"); +
--- a/scripts/io/fileread.m +++ b/scripts/io/fileread.m @@ -29,7 +29,7 @@ endif if (! ischar (filename)) - error ("fileread: argument must be a string"); + error ("fileread: FILENAME argument must be a string"); endif fid = fopen (filename, "r"); @@ -45,3 +45,19 @@ endfunction + +%!test +%! cstr = {"Hello World", "The answer is 42", "Goodbye World"}; +%! fname = tmpnam (); +%! fid = fopen (fname, "wt"); +%! fprintf(fid, "%s\n", cstr{:}) +%! fclose (fid); +%! str = fileread (fname); +%! assert (str', [cstr{1} "\n" cstr{2} "\n" cstr{3} "\n"]); +%! unlink (fname); + +%% Test input validation +%!error fileread () +%!error fileread (1, 2) +%!error <FILENAME argument must be a string> fileread (1) +
--- a/scripts/io/strread.m +++ b/scripts/io/strread.m @@ -19,15 +19,16 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{a}, @dots{}] =} strread (@var{str}) ## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{format_repeat}) ## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{prop1}, @var{value1}, @dots{}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{format_repeat}, @var{prop1}, @var{value1}, @dots{}) ## Read data from a string. ## ## The string @var{str} is split into words that are repeatedly matched to the ## specifiers in @var{format}. The first word is matched to the first -## specifier, -## the second to the second specifier and so forth. If there are more words -## than -## specifiers, the process is repeated until all words have been processed. +## specifier, the second to the second specifier and so forth. If there are +## more words than specifiers, the process is repeated until all words have +## been processed. ## ## The string @var{format} describes how the words in @var{str} should be ## parsed. @@ -36,19 +37,31 @@ ## @item %s ## The word is parsed as a string. ## -## @item %d ## @itemx %f -## The word is parsed as a number. +## @itemx %n +## The word is parsed as a number and converted to double. +## +## @item %d +## @itemx %u +## The word is parsed as a number and converted to int32. ## -## @item %* +## @item %*', '%*f', '%*s ## The word is skipped. +## +## For %s and %d, %f, %n, %u and the associated %*s @dots{} specifiers an +## optional width can be specified as %Ns, etc. where N is an integer > 1. +## For %f, format specifiers like %N.Mf are allowed. +## +## @item literals +## In addition the format may contain literal character strings; these will be +## skipped during reading. ## @end table ## ## Parsed word corresponding to the first specifier are returned in the first ## output argument and likewise for the rest of the specifiers. ## ## By default, @var{format} is @t{"%f"}, meaning that numbers are read from -## @var{str}. +## @var{str}. This will do if @var{str} contains only numeric fields. ## ## For example, the string ## @@ -68,6 +81,18 @@ ## [@var{a}, @var{b}, @var{c}] = strread (@var{str}, "%s %s %f"); ## @end example ## +## Optional numeric argument @var{format_repeat} can be used for +## limiting the number of items read: +## @table @asis +## @item -1 +## (default) read all of the string until the end. +## +## @item N +## Read N times @var{nargout} items. 0 (zero) is an acceptable +## value for @var{format_repeat}. +## +## @end table +## ## The behavior of @code{strread} can be changed via property-value ## pairs. The following properties are recognized: ## @@ -77,94 +102,211 @@ ## @var{value} is the comment style and can be any of the following. ## @itemize ## @item "shell" -## Everything from @code{#} characters to the nearest end-line is skipped. +## Everything from @code{#} characters to the nearest end-of-line is skipped. ## ## @item "c" ## Everything between @code{/*} and @code{*/} is skipped. ## ## @item "c++" -## Everything from @code{//} characters to the nearest end-line is skipped. +## Everything from @code{//} characters to the nearest end-of-line is skipped. ## ## @item "matlab" -## Everything from @code{%} characters to the nearest end-line is skipped. +## Everything from @code{%} characters to the nearest end-of-line is skipped. +## +## @item user-supplied. Two options: +## (1) One string, or 1x1 cell string: Skip everything to the right of it; +## (2) 2x1 cell string array: Everything between the left and right strings +## is skipped. ## @end itemize ## ## @item "delimiter" -## Any character in @var{value} will be used to split @var{str} into words. +## Any character in @var{value} will be used to split @var{str} into words +## (default value = any whitespace). ## ## @item "emptyvalue" ## Parts of the output where no word is available is filled with @var{value}. +## +## @item "multipledelimsasone" +## Treat a series of consecutive delimiters, without whitespace in between, +## as a single delimiter. Consecutive delimiter series need not be vertically +## "aligned". +## +## @item "treatasempty" +## Treat single occurrences (surrounded by delimiters or whitespace) of the +## string(s) in @var{value} as missing values. +## +## @item "returnonerror" +## If @var{value} true (1, default), ignore read errors and return normally. +## If false (0), return an error. +## +## @item "whitespace" +## Any character in @var{value} will be interpreted as whitespace and +## trimmed; the string defining whitespace must be enclosed in double +## quotes for proper processing of special characters like \t. +## The default value for whitespace = " \b\r\n\t" (note the space). +## ## @end table ## -## @seealso{textread, load, dlmread, fscanf} +## @seealso{textscan, textread, load, dlmread, fscanf} ## @end deftypefn function varargout = strread (str, format = "%f", varargin) + ## Check input if (nargin < 1) print_usage (); endif - if (!ischar (str) || !ischar (format)) + if (isempty (format)) + format = "%f"; + endif + + if (! ischar (str) || ! ischar (format)) error ("strread: STR and FORMAT arguments must be strings"); endif - ## Parse options + ## Parse format string to compare number of conversion fields and nargout + nfields = length (strfind (format, "%")) - length (strfind (format, "%*")); + ## If str only has numeric fields, a (default) format ("%f") will do. + ## Otherwise: + if ((max (nargout, 1) != nfields) && ! strcmp (format, "%f")) + error ("strread: the number of output variables must match that specified by FORMAT"); + endif + + ## Check for format string repeat count + format_repeat_count = -1; + if (nargin > 2 && isnumeric (varargin{1})) + if (varargin{1} >= 0) + format_repeat_count = varargin{1}; + endif + if (nargin > 3) + varargin = varargin(2:end); + else + varargin = {}; + endif + endif + + ## Parse options. First initialize defaults comment_flag = false; - numeric_fill_value = 0; - white_spaces = " \n\r\t\b"; delimiter_str = ""; + empty_str = ""; + eol_char = ""; + err_action = 0; + mult_dlms_s1 = false; + numeric_fill_value = NaN; + white_spaces = " \b\r\n\t"; for n = 1:2:length (varargin) - switch (lower (varargin {n})) + switch (lower (varargin{n})) + case "bufsize" + ## We could synthesize this, but that just seems weird... + warning ('strread: property "bufsize" is not implemented'); case "commentstyle" comment_flag = true; - switch (lower (varargin {n+1})) + switch (lower (varargin{n+1})) case "c" - comment_specif = {"/*", "*/"}; + [comment_start, comment_end] = deal ("/*", "*/"); case "c++" - comment_specif = {"//", "\n"}; + [comment_start, comment_end] = deal ("//", "eol_char"); case "shell" - comment_specif = {"#", "\n"}; + [comment_start, comment_end] = deal ("#" , "eol_char"); case "matlab" - comment_specif = {"%", "\n"}; + [comment_start, comment_end] = deal ("%" , "eol_char"); otherwise - warning ("strread: unknown comment style '%s'", val); + if (ischar (varargin{n+1}) || + (numel (varargin{n+1}) == 1 && iscellstr (varargin{n+1}))) + [comment_start, comment_end] = deal (char (varargin{n+1}), "eol_char"); + elseif (iscellstr (varargin{n+1}) && numel (varargin{n+1}) == 2) + [comment_start, comment_end] = deal (varargin{n+1}{:}); + else + ## FIXME - a user may have numeric values specified: {'//', 7} + ## this will lead to an error in the warning message + error ("strread: unknown or unrecognized comment style '%s'", + varargin{n+1}); + endif endswitch case "delimiter" - delimiter_str = varargin {n+1}; + delimiter_str = varargin{n+1}; + if (is_sq_string (delimiter_str)) + delimiter_str = do_string_escapes (delimiter_str); + endif case "emptyvalue" - numeric_fill_value = varargin {n+1}; - case "bufsize" - ## XXX: We could synthesize this, but that just seems weird... - warning ("strread: property \"bufsize\" is not implemented"); + numeric_fill_value = varargin{n+1}; + case "expchars" + warning ('strread: property "expchars" is not implemented'); case "whitespace" - white_spaces = varargin {n+1}; - case "expchars" - warning ("strread: property \"expchars\" is not implemented"); + white_spaces = varargin{n+1}; + if (is_sq_string (white_spaces)) + white_spaces = do_string_escapes (white_spaces); + endif + ## The following parameters are specific to textscan and textread + case "endofline" + eol_char = varargin{n+1}; + if (is_sq_string (eol_char)) + eol_char = do_string_escapes (eol_char); + endif + case "returnonerror" + err_action = varargin{n+1}; + case "multipledelimsasone" + mult_dlms_s1 = varargin{n+1}; + case "treatasempty" + if (iscellstr (varargin{n+1})) + empty_str = varargin{n+1}; + elseif (ischar (varargin{n+1})) + empty_str = varargin(n+1); + else + error ('strread: "treatasempty" value must be string or cellstr'); + endif otherwise - warning ("strread: unknown property \"%s\"", varargin {n}); + warning ('strread: unknown property "%s"', varargin{n}); endswitch endfor - if (isempty (delimiter_str)) - delimiter_str = white_spaces; + + ## First parse of FORMAT + if (strcmpi (strtrim (format), "%f")) + ## Default format specified. Expand it (to desired nargout) + fmt_words = cell (nargout, 1); + fmt_words (1:nargout) = format; + else + ## Determine the number of words per line as a first guess. Forms + ## like %f<literal>) (w/o delimiter in between) are fixed further on + format = strrep (format, "%", " %"); + fmt_words = regexp (format, '[^ ]+', 'match'); + ## Format conversion specifiers following literals w/o space/delim + ## in between are separate now. Separate those w trailing literals + idy2 = find (! cellfun ("isempty", strfind (fmt_words, "%"))); + a = strfind (fmt_words(idy2), "%"); + b = regexp (fmt_words(idy2), '[nfdus]', 'end'); + for jj = 1:numel (a) + ii = numel (a) - jj + 1; + if (! (length (fmt_words{idy2(ii)}) == b{ii}(1))) + ## Fix format_words + fmt_words(idy2(ii)+1 : end+1) = fmt_words(idy2(ii) : end); + fmt_words{idy2(ii)} = fmt_words{idy2(ii)}(a{ii} : b{ii}(1)); + fmt_words{idy2(ii)+1} = fmt_words{idy2(ii)+1}(b{ii}+1:end); + endif + endfor + endif + num_words_per_line = numel (fmt_words); + + ## Special handling for CRLF EOL character in str + if (! isempty (eol_char) && strcmp (eol_char, "\r\n")) + ## Strip CR from CRLF sequences + str = strrep (str, "\r\n", "\n"); + ## CR serves no further purpose in function + eol_char = "\n"; endif - ## Parse format string - idx = strfind (format, "%")'; - specif = format ([idx, idx+1]); - nspecif = length (idx); - idx_star = strfind (format, "%*"); - nfields = length (idx) - length (idx_star); - - if (max (nargout, 1) != nfields) - error ("strread: the number of output variables must match that specified byFORMAT"); - endif - - ## Remove comments + ## Remove comments in str if (comment_flag) - cstart = strfind (str, comment_specif{1}); - cstop = strfind (str, comment_specif{2}); - if (length (cstart) > 0) + ## Expand 'eol_char' here, after option processing which may have set value + comment_end = regexprep (comment_end, 'eol_char', eol_char); + cstart = strfind (str, comment_start); + cstop = strfind (str, comment_end); + ## Treat end of string as additional comment stop + if (isempty (cstop) || cstop(end) != length (str)) + cstop(end+1) = length (str); + endif + if (! isempty (cstart)) ## Ignore nested openers. [idx, cidx] = unique (lookup (cstop, cstart), "first"); if (idx(end) == length (cstop)) @@ -172,7 +314,7 @@ endif cstart = cstart(cidx); endif - if (length (cstop) > 0) + if (! isempty (cstop)) ## Ignore nested closers. [idx, cidx] = unique (lookup (cstart, cstop), "first"); if (idx(1) == 0) @@ -181,101 +323,406 @@ cstop = cstop(cidx); endif len = length (str); - c2len = length (comment_specif{2}); + c2len = length (comment_end); str = cellslices (str, [1, cstop + c2len], [cstart - 1, len]); str = [str{:}]; endif - ## Determine the number of words per line - format = strrep (format, "%", " %"); - [~, ~, ~, fmt_words] = regexp (format, '[^ ]+'); + if (! isempty (white_spaces)) + ## Remove any delimiter chars from white_spaces list + white_spaces = setdiff (white_spaces, delimiter_str); + endif + if (isempty (delimiter_str)) + delimiter_str = " "; + endif + if (! isempty (eol_char)) + ## Add eol_char to delimiter collection + delimiter_str = unique ([delimiter_str eol_char]); + ## .. and remove it from whitespace collection + white_spaces = strrep (white_spaces, eol_char, ''); + endif - num_words_per_line = numel (fmt_words); - for m = 1:numel(fmt_words) - ## Convert formats such as "%Ns" to "%s" (see the FIXME below) - if (length (fmt_words{m}) > 2) - if (strcmp (fmt_words{m}(1:2), "%*")) - fmt_words{m} = "%*"; - elseif (fmt_words{m}(1) == "%") - fmt_words{m} = fmt_words{m}([1, end]); - endif + pad_out = 0; + ## Trim whitespace if needed + ## FIXME: This is very complicated. Can this be simplified with regexprep? + if (! isempty (white_spaces)) + ## Check if trailing "\n" might signal padding output arrays to equal size + ## before it is trimmed away below + if ((str(end) == 10) && (nargout > 1)) + pad_out = 1; endif - endfor + ## Remove repeated white_space chars. First find white_space positions + idx = strchr (str, white_spaces); + ## Find repeated white_spaces + idx2 = ! (idx(2:end) - idx(1:end-1) - 1); + ## Set all whitespace chars to spaces + ## FIXME: this implies real spaces are always part of white_spaces + str(idx) = ' '; + ## Set all repeated white_space to \0 + str(idx(idx2)) = "\0"; + str = strsplit (str, "\0"); + ## Reconstruct trimmed str + str = cell2mat (str); + ## Remove leading & trailing space, but preserve delimiters. + str = strtrim (str); + ## FIXME: Double strrep on str is enormously expensive of CPU time. + ## Can this be eliminated + ## Wipe leading and trailing whitespace on each line (it may be delimiter too) + if (! isempty (eol_char)) + str = strrep (str, [eol_char " "], eol_char); + str = strrep (str, [" " eol_char], eol_char); + endif + endif ## Split 'str' into words - words = split_by (str, delimiter_str); + words = split_by (str, delimiter_str, mult_dlms_s1, eol_char); + if (! isempty (white_spaces)) + ## Trim leading and trailing white_spaces + ## FIXME: Is this correct? strtrim clears what matches isspace(), not + ## necessarily what is in white_spaces. + words = strtrim (words); + endif num_words = numel (words); + ## First guess at number of lines in file (ignoring leading/trailing literals) num_lines = ceil (num_words / num_words_per_line); - ## For each specifier + ## Replace TreatAsEmpty char sequences by empty strings + if (! isempty (empty_str)) + for ii = 1:numel (empty_str) + idz = strmatch (empty_str{ii}, words, "exact"); + words(idz) = {""}; + endfor + endif + + ## We now may have to cope with 3 cases: + ## A: Trailing literals (%f<literal>) w/o delimiter in between. + ## B: Leading literals (<literal>%f) w/o delimiter in between. + ## C. Skipping leftover parts of specified skip fields (%*N ) + ## fmt_words has been split properly now, but words{} has only been split on + ## delimiter positions. Some words columns may have to be split further. + ## We also don't know the number of lines (as EndOfLine may have been set to + ## "" (empty) by the caller). + + ## Find indices and pointers to possible literals in fmt_words + idf = cellfun ("isempty", strfind (fmt_words, "%")); + ## Find indices and pointers to conversion specifiers with fixed width + idg = ! cellfun ("isempty", regexp (fmt_words, '%\*?\d')); + idy = find (idf | idg); + + ## If needed, split up columns in three steps: + if (! isempty (idy)) + ## Try-catch because complexity of strings to read can be infinite + #try + + ## 1. Assess "period" in the split-up words array ( < num_words_per_line). + ## Could be done using EndOfLine but that prohibits EndOfLine = "" option. + ## Alternative below goes by simply parsing a first grab of words + ## and counting words until the fmt_words array is exhausted: + iwrd = 1; iwrdp = 0; iwrdl = length (words{iwrd}); + for ii = 1:numel (fmt_words) + + if (idf(ii)) + ## Literal expected + if (isempty (strfind (fmt_words{ii}, words(iwrd)))) + ## Not found in current word; supposed to be in next word + ++iwrd; iwrdp = 0; + if (ii < numel (fmt_words)) + iwrdl = length (words{iwrd}); + endif + else + ## Found it in current word. Subtract literal length + iwrdp += length (fmt_words{ii}); + if (iwrdp > iwrdl) + ## Parse error. Literal extends beyond delimiter (word boundary) + error ("strread: Literal '%s' (fmt spec # %d) does not match data", fmt_words{ii}, ii); + elseif (iwrdp == iwrdl) + ## Word completely "used up". Next word + ++iwrd; iwrdp = 0; + if (ii < numel (fmt_words)) + iwrdl = length (words{iwrd}); + endif + endif + endif + + elseif (idg(ii)) + ## Fixed width specifier (%N or %*N): read just a part of word + iwrdp += floor ... + (str2double (fmt_words{ii}(regexp(fmt_words{ii}, '\d') : end-1))); + if (iwrdp > iwrdl) + ## Error. Field extends beyond word boundary. + error ("strread: Field width '%s' (fmt spec # %d) extends beyond word limit", fmt_words{ii}, ii); + elseif (iwrdp == iwrdl) + ## Word completely "used up". Next word + ++iwrd; iwrdp = 0; iwrdl = length (words{iwrd}); + endif + + else + ## A simple format conv. specifier. Either (1) uses rest of word, or + ## (2) is squeezed between current iwrdp and next literal, or (3) uses + ## next word. (3) is already taken care of. So just check (1) & (2) + if (ii < numel (fmt_words) && idf(ii+1)) + ## Next fmt_word is a literal... + if (! index (words{iwrd}(iwrdp+1:end), fmt_words{ii+1})) + ## ...but not found in current word => field uses rest of word + ++iwrd; iwrdp = 0; iwrdl = length (words{iwrd}); + else + ## ..or it IS found. Add inferred width of current conversion field + iwrdp += index (words{iwrd}(iwrdp+1:end), fmt_words{ii+1}) - 1; + endif + elseif (iwrdp < iwrdl) + ## No bordering literal to the right => field occupies (rest of) word + ++iwrd; iwrdp = 0; + if (ii < numel (fmt_words)) + iwrdl = length (words{iwrd}); + endif + endif + + endif + endfor + ## Done + words_period = max (iwrd - 1, 1); + num_lines = ceil (num_words / words_period); + + ## 2. Pad words array so that it can be reshaped + tmp_lines = ceil (num_words / words_period); + num_words_padded = tmp_lines * words_period - num_words; + if (num_words_padded) + words = [words'; cell(num_words_padded, 1)]; + endif + words = reshape (words, words_period, tmp_lines); + + ## 3. Do the column splitting on rectangular words array + icol = 1; ii = 1; # icol = current column, ii = current fmt_word + while (ii <= num_words_per_line) + + ## Check if fmt_words(ii) contains a literal or fixed-width + if ((idf(ii) || idg(ii)) && (rows(words) < num_words_per_line)) + if (idf(ii)) + s = strfind (words(icol, 1), fmt_words{ii}); + if (isempty (s{:})) + error ("strread: Literal '%s' not found in column %d", fmt_words{ii}, icol); + endif + s = s{:}(1); + e = s(1) + length (fmt_words{ii}) - 1; + endif + if (! strcmp (fmt_words{ii}, words{icol, 1})) + ## Column doesn't exactly match literal => split needed. Insert a column + words(icol+1:end+1, :) = words(icol:end, :); + ## Watch out for empty cells + jptr = find (! cellfun ("isempty", words(icol, :))); + + ## Distinguish leading or trailing literals + if (! idg(ii) && ! isempty (s) && s(1) == 1) + ## Leading literal. Assign literal to icol, paste rest in icol + 1 + ## Apply only to those cells that do have something beyond literal + jptr = find (cellfun("length", words(icol+1, jptr), ... + "UniformOutput", false) > e(1)); + words(icol+1, :) = {""}; + words(icol+1, jptr) = cellfun ... + (@(x) substr(x, e(1)+1, length(x)-e(1)), words(icol, jptr), ... + "UniformOutput", false); + words(icol, jptr) = fmt_words{ii}; + + else + if (! idg(ii) && ! isempty (strfind (fmt_words{ii-1}, "%s"))) + ## Trailing literal. If preceding format == '%s' this is an error + warning ("Ambiguous '%s' specifier next to literal in column %d", icol); + elseif (idg(ii)) + ## Current field = fixed width. Strip into icol, rest in icol+1 + wdth = floor (str2double (fmt_words{ii}(regexp(fmt_words{ii}, ... + '\d') : end-1))); + words(icol+1, jptr) = cellfun (@(x) x(wdth+1:end), + words(icol,jptr), "UniformOutput", false); + words(icol, jptr) = strtrunc (words(icol, jptr), wdth); + else + ## FIXME: this assumes char(254)/char(255) won't occur in input! + clear wrds; + wrds(1:2:2*numel (words(icol, jptr))) = ... + strrep (words(icol, jptr), fmt_words{ii}, ... + [char(255) char(254)]); + wrds(2:2:2*numel (words(icol, jptr))-1) = char(255); + wrds = strsplit ([wrds{:}], char(255)); + words(icol, jptr) = ... + wrds(find (cellfun ("isempty", strfind (wrds, char(254))))); + wrds(find (cellfun ("isempty", strfind (wrds, char(254))))) ... + = char(255); + words(icol+1, jptr) = strsplit (strrep ([wrds{2:end}], ... + char(254), fmt_words{ii}), char(255)); + ## Former trailing literal may now be leading for next specifier + --ii; + endif + endif + endif + + else + ## Conv. specifier. Peek if next fmt_word needs split from current column + if (ii < num_words_per_line && idf(ii+1)) + if (! isempty (strfind (words{icol, 1}, fmt_words{ii+1}))) + --icol; + endif + endif + endif + ## Next fmt_word, next column + ++ii; ++icol; + endwhile + + ## Done. Reshape words back into 1 long vector and strip padded empty words + words = reshape (words, 1, numel (words))(1 : end-num_words_padded); + + #catch + # warning ("strread: unable to parse text or file with given format string"); + # return; + + #end_try_catch + endif + + ## For each specifier, process corresponding column k = 1; for m = 1:num_words_per_line - data = words (m:num_words_per_line:end); - ## Map to format - ## FIXME - add support for formats like "%4s" or "<%s>", "%[a-zA-Z]" - ## Someone with regexp experience is needed. - switch fmt_words{m} - case "%s" - data (end+1:num_lines) = {""}; - varargout {k} = data'; - k++; - case {"%d", "%f"} - n = cellfun (@isempty, data); - data = str2double (data); - data(n) = numeric_fill_value; - data (end+1:num_lines) = numeric_fill_value; - varargout {k} = data.'; - k++; - case {"%*", "%*s"} - ## skip the word - otherwise - ## Ensure descriptive content is consistent - if (numel (unique (data)) > 1 - || ! strcmpi (unique (data), fmt_words{m})) - error ("strread: FORMAT does not match data"); - endif - endswitch + try + if (format_repeat_count < 0) + data = words(m:num_words_per_line:end); + elseif (format_repeat_count == 0) + data = {}; + else + lastline = ... + min (num_words_per_line * format_repeat_count + m - 1, numel (words)); + data = words(m:num_words_per_line:lastline); + endif + + ## Map to format + ## FIXME - add support for formats like "<%s>", "%[a-zA-Z]" + ## Someone with regexp experience is needed. + switch fmt_words{m}(1:min (2, length (fmt_words{m}))) + case "%s" + if (pad_out) + data(end+1:num_lines) = {""}; + endif + varargout{k} = data'; + k++; + case {"%d", "%u", "%f", "%n"} + n = cellfun ("isempty", data); + ### FIXME - erroneously formatted data lead to NaN, not an error + data = str2double (data); + if (! isempty (regexp (fmt_words{m}, "%[du]"))) + ## Cast to integer + ## FIXME: NaNs will be transformed into zeros + data = int32 (data); + endif + data(n) = numeric_fill_value; + if (pad_out) + data(end+1:num_lines) = numeric_fill_value; + endif + varargout{k} = data.'; + k++; + case {"%0", "%1", "%2", "%3", "%4", "%5", "%6", "%7", "%8", "%9"} + nfmt = strsplit (fmt_words{m}(2:end-1), '.'); + swidth = str2double (nfmt{1}); + switch fmt_words{m}(end) + case {"d", "u", "f", "n%"} + n = cellfun ("isempty", data); + ### FIXME - erroneously formatted data lead to NaN, not an error + ### => ReturnOnError can't be implemented for numeric data + data = str2double (strtrunc (data, swidth)); + data(n) = numeric_fill_value; + if (pad_out) + data(end+1:num_lines) = numeric_fill_value; + endif + if (numel (nfmt) > 1) + sprec = str2double (nfmt{2}); + data = 10^-sprec * round (10^sprec * data); + elseif (! isempty (regexp (fmt_words{m}, "[du]"))) + ## Cast to integer + ## FIXME: NaNs will be transformed into zeros + data = int32 (data); + endif + varargout{k} = data.'; + k++; + case "s" + if (pad_out) + data(end+1:num_lines) = {""} + endif + varargout{k} = strtrunc (data, swidth)'; + k++; + otherwise + endswitch + case {"%*", "%*s"} + ## skip the word + otherwise + ## Ensure descriptive content is consistent. + ## Test made a bit lax to accomodate for incomplete last lines + n = find (! cellfun ("isempty", data)); + if (numel (unique (data(n))) > 1 + || ! strcmpi (unique (data), fmt_words{m})) + error ("strread: FORMAT does not match data"); + endif + endswitch + catch + ## As strread processes columnwise, ML-compatible error processing + ## (row after row) is not feasible. In addition Octave sets unrecognizable + ## numbers to NaN w/o error. But maybe Octave is better in this respect. + if (err_action) + ## Just try the next column where ML bails out + else + rethrow (lasterror); + endif + end_try_catch endfor + endfunction -function out = split_by (text, sep) - sep = union (sep, "\n"); - pat = sprintf ('[^%s]+', sep); - [~, ~, ~, out] = regexp (text, pat); - out(cellfun (@isempty, out)) = {""}; - out = strtrim (out); +function out = split_by (text, sep, mult_dlms_s1, eol_char) + + ## Check & if needed, process MultipleDelimsAsOne parameter + if (mult_dlms_s1) + mult_dlms_s1 = true; + ## FIXME: Should re-implement strsplit() function here in order + ## to avoid strrep on megabytes of data. + ## If \n is in sep collection we need to enclose it in spaces in text + ## to avoid it being included in consecutive delim series + text = strrep (text, eol_char, [" " eol_char " "]); + else + mult_dlms_s1 = false; + endif + + ## Split text string along delimiters + out = strsplit (text, sep, mult_dlms_s1); + ## In case of trailing delimiter, strip stray last empty word + if (!isempty (out) && any (sep == text(end))) + out(end) = []; + endif + + ## Empty cells converted to empty cellstrings. + out(cellfun ("isempty", out)) = {""}; + endfunction + %!test %! [a, b] = strread ("1 2", "%f%f"); -%! assert (a == 1 && b == 2); - -%!test -%! str = "# comment\n# comment\n1 2 3"; -%! [a, b] = strread (str, '%d %s', 'commentstyle', 'shell'); -%! assert (a, [1; 3]); -%! assert (b, {"2"; ""}); +%! assert (a, 1); +%! assert (b, 2); %!test %! str = ''; %! a = rand (10, 1); -%! b = char (round (65 + 20 * rand (10, 1))); +%! b = char (randi ([65, 85], 10, 1)); %! for k = 1:10 -%! str = sprintf ('%s %.6f %s\n', str, a (k), b (k)); +%! str = sprintf ('%s %.6f %s\n', str, a(k), b(k)); %! endfor %! [aa, bb] = strread (str, '%f %s'); -%! assert (a, aa, 1e-5); +%! assert (a, aa, 1e-6); %! assert (cellstr (b), bb); %!test %! str = ''; %! a = rand (10, 1); -%! b = char (round (65 + 20 * rand (10, 1))); +%! b = char (randi ([65, 85], 10, 1)); %! for k = 1:10 -%! str = sprintf ('%s %.6f %s\n', str, a (k), b (k)); +%! str = sprintf ('%s %.6f %s\n', str, a(k), b(k)); %! endfor %! aa = strread (str, '%f %*s'); -%! assert (a, aa, 1e-5); +%! assert (a, aa, 1e-6); %!test %! str = sprintf ('/* this is\nacomment*/ 1 2 3'); @@ -283,6 +730,12 @@ %! assert (a, [1; 2; 3]); %!test +%! str = "# comment\n# comment\n1 2 3"; +%! [a, b] = strread (str, '%n %s', 'commentstyle', 'shell', 'endofline', "\n"); +%! assert (a, [1; 3]); +%! assert (b, {"2"}); + +%!test %! str = sprintf ("Tom 100 miles/hr\nDick 90 miles/hr\nHarry 80 miles/hr"); %! fmt = "%s %f miles/hr"; %! c = cell (1, 2); @@ -294,3 +747,72 @@ %! a = strread ("a b c, d e, , f", "%s", "delimiter", ","); %! assert (a, {"a b c"; "d e"; ""; "f"}); +%!test +%! # Bug #33536 +%! [a, b, c] = strread ("1,,2", "%s%s%s", "delimiter", ","); +%! assert (a{1}, '1'); +%! assert (b{1}, ''); +%! assert (c{1}, '2'); + +%!test +%! # Bug #33536 +%! a = strread ("[SomeText]", "[%s", "delimiter", "]"); +%! assert (a{1}, "SomeText"); + +%!test +%! dat = "Data file.\r\n= = = = =\r\nCOMPANY : <Company name>\r\n"; +%! a = strread (dat, "%s", 'delimiter', "\n", 'whitespace', '', 'endofline', "\r\n"); +%! assert (a{2}, "= = = = ="); +%! assert (double (a{3}(end-5:end)), [32 110 97 109 101 62]); + +%!test +%! [a, b, c, d] = strread ("1,2,3,,5,6", "%d%f%d%f", 'delimiter', ','); +%! assert (c, int32 (3)); +%! assert (d, NaN); + +%!test +%! [a, b, c, d] = strread ("1,2,3,,5,6\n", "%d%d%f%d", 'delimiter', ','); +%! assert (c, [3; NaN]); +%! assert (d, int32 ([0; 0])); + +%!test +%! # Default format (= %f) +%1 [a, b, c] = strread ("0.12 0.234 0.3567"); +%1 assert (a, 0.12); +%1 assert (b, 0.234); +%1 assert (c, 0.3567); + +%!test +%! [a, b] = strread('0.41 8.24 3.57 6.24 9.27', "%f%f", 2, 'delimiter', ' '); +%1 assert (a, [0.41; 3.57]); + +%!test +%! # TreatAsEmpty +%! [a, b, c, d] = strread ("1,2,3,NN,5,6\n", "%d%d%d%f", 'delimiter', ',', 'TreatAsEmpty', 'NN'); +%! assert (c, int32 ([3; 0])); +%! assert (d, [NaN; NaN]); + +%!test +%! # No delimiters at all besides EOL. Plain reading numbers & strings +%! str = "Text1Text2Text\nText398Text4Text\nText57Text"; +%! c = textscan (str, "Text%dText%1sText"); +%! assert (c{1}, int32 ([1; 398; 57])); +%! assert (c{2}(1:2), {'2'; '4'}); +%! assert (isempty (c{2}{3}), true); + +%% MultipleDelimsAsOne +%!test +%! str = "11, 12, 13,, 15\n21,, 23, 24, 25\n,, 33, 34, 35"; +%! [a b c d] = strread (str, "%f %f %f %f", 'delimiter', ',', 'multipledelimsasone', 1, 'endofline', "\n"); +%! assert (a', [11, 21, NaN]); +%! assert (b', [12, 23, 33]); +%! assert (c', [13, 24, 34]); +%! assert (d', [15, 25, 35]); + +%% delimiter as sq_string and dq_string +%! assert (strread ("1\n2\n3", "%d", "delimiter", "\n"), +%! strread ("1\n2\n3", "%d", "delimiter", '\n')) + +%% whitespace as sq_string and dq_string +%! assert (strread ("1\b2\r3\b4\t5", "%d", "whitespace", "\b\r\n\t"), +%! strread ("1\b2\r3\b4\t5", "%d", "whitespace", '\b\r\n\t'))
--- a/scripts/io/textread.m +++ b/scripts/io/textread.m @@ -19,30 +19,43 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}) ## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{n}) ## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{prop1}, @var{value1}, @dots{}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{n}, @var{prop1}, @var{value1}, @dots{}) ## Read data from a text file. ## ## The file @var{filename} is read and parsed according to @var{format}. The ## function behaves like @code{strread} except it works by parsing a file -## instead -## of a string. See the documentation of @code{strread} for details. +## instead of a string. See the documentation of @code{strread} for details. +## ## In addition to the options supported by @code{strread}, this function -## supports one more: +## supports two more: +## ## @itemize ## @item "headerlines": +## The first @var{value} number of lines of @var{filename} are skipped. +## +## @item "endofline": +## Specify a single character or "\r\n". If no value is given, it will be +## inferred from the file. If set to "" (empty string) EOLs are ignored as +## delimiters. ## @end itemize -## The first @var{value} number of lines of @var{str} are skipped. -## @seealso{strread, load, dlmread, fscanf} +## +## The optional input @var{n} specifes the number of times to use +## @var{format} when parsing, i.e., the format repeat count. +## +## @seealso{strread, load, dlmread, fscanf, textscan} ## @end deftypefn function varargout = textread (filename, format = "%f", varargin) + ## Check input if (nargin < 1) print_usage (); endif - if (!ischar (filename) || !ischar (format)) - error ("textread: first and second input arguments must be strings"); + if (! ischar (filename) || ! ischar (format)) + error ("textread: FILENAME and FORMAT arguments must be strings"); endif ## Read file @@ -51,21 +64,85 @@ error ("textread: could not open '%s' for reading", filename); endif - ## Maybe skip header lines + ## Skip header lines if requested headerlines = find (strcmpi (varargin, "headerlines"), 1); - if (! isempty (headerlines)) - hdr_lines = floor (varargin{headerlines + 1}); - ## Beware of zero valued headerline, fskipl will count lines to EOF then - if (hdr_lines > 0) - fskipl (fid, hdr_lines); - endif + ## Beware of zero valued headerline, fskipl would skip to EOF + if (! isempty (headerlines) && (varargin{headerlines + 1} > 0)) + fskipl (fid, varargin{headerlines + 1}); varargin(headerlines:headerlines+1) = []; endif - str = fread (fid, "char=>char").'; + if (nargin > 2 && isnumeric (varargin{1})) + nlines = varargin{1}; + else + nlines = Inf; + 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) + str = strcat (str, tmp_str); + tmp_str = fgets (fid); + endwhile + else + str = fread (fid, "char=>char").'; + endif fclose (fid); + if (isempty (str)) + warning ("textread: empty file"); + return; + endif + + endofline = find (strcmpi (varargin, "endofline"), 1); + if (! isempty (endofline)) + ## 'endofline' option set by user. + if (! ischar (varargin{endofline + 1})); + 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); + ## First try DOS (CRLF) + if (! isempty (findstr ("\r\n", str(1 : eol_srch_len)))) + eol_char = "\r\n"; + ## Perhaps old Macintosh? (CR) + elseif (! isempty (findstr ("\r", str(1 : eol_srch_len)))) + eol_char = "\r"; + ## Otherwise, use plain UNIX (LF) + else + eol_char = "\n"; + endif + ## Set up default endofline param value + varargin(end+1:end+2) = {'endofline', eol_char}; + endif + + ## Set up default whitespace param value if needed + if (isempty (find (strcmpi ('whitespace', varargin)))) + varargin(end+1:end+2) = {'whitespace', " \b\t"}; + endif + ## Call strread to make it do the real work [varargout{1:max (nargout, 1)}] = strread (str, format, varargin {:}); endfunction + + +%!test +%! f = tmpnam(); +%! d = rand (5, 3); +%! dlmwrite (f, d, 'precision', '%5.2f'); +%! [a, b, c] = textread (f, "%f %f %f", "delimiter", ",", "headerlines", 3); +%! unlink(f); +%! assert (a, d(4:5, 1), 1e-2); +%! assert (b, d(4:5, 2), 1e-2); +%! assert (c, d(4:5, 3), 1e-2); + +%% Test input validation +%!error textread () +%!error textread (1) +%!error <arguments must be strings> textread (1, '%f') +%!error <arguments must be strings> textread ("fname", 1) +
--- a/scripts/io/textscan.m +++ b/scripts/io/textscan.m @@ -22,23 +22,40 @@ ## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @var{param}, @var{value}, @dots{}) ## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @var{n}, @var{param}, @var{value}, @dots{}) ## @deftypefnx {Function File} {@var{C} =} textscan (@var{str}, @dots{}) -## @deftypefnx {Function File} {[@var{C}, @var{position}] =} textscan (@dots{}) -## Read data from a text file. +## @deftypefnx {Function File} {[@var{C}, @var{position}] =} textscan (@var{fid}, @dots{}) +## Read data from a text file or string. ## ## The file associated with @var{fid} is read and parsed according to ## @var{format}. The function behaves like @code{strread} except it works by ## parsing a file instead of a string. See the documentation of -## @code{strread} for details. In addition to the options supported by -## @code{strread}, this function supports one more: +## @code{strread} for details. +## +## In addition to the options supported by +## @code{strread}, this function supports a few more: +## ## @itemize +## @item "collectoutput": +## A value of 1 or true instructs textscan to concatenate consecutive columns +## of the same class in the output cell array. A value of 0 or false (default) +## leaves output in distinct columns. +## +## @item "endofline": +## Specify "\r", "\n" or "\r\n" (for CR, LF, or CRLF). If no value is given, +## it will be inferred from the file. If set to "" (empty string) EOLs are +## ignored as delimiters and added to whitespace. +## ## @item "headerlines": +## The first @var{value} number of lines of @var{fid} are skipped. +## +## @item "returnonerror": +## If set to numerical 1 or true (default), return normally when read errors +## have been encountered. If set to 0 or false, return an error and no data. ## @end itemize -## The first @var{value} number of lines of @var{str} are skipped. ## -## The optional input, @var{n}, specifes the number of lines to be read from -## the file, associated with @var{fid}. +## The optional input @var{n} specifes the number of times to use +## @var{format} when parsing, i.e., the format repeat count. ## -## The output, @var{C}, is a cell array whose length is given by the number +## The output @var{C} is a cell array whose length is given by the number ## of format specifiers. ## ## The second output, @var{position}, provides the position, in characters, @@ -47,89 +64,208 @@ ## @seealso{dlmread, fscanf, load, strread, textread} ## @end deftypefn -function [C, p] = textscan (fid, format, varargin) +function [C, position] = textscan (fid, format = "%f", varargin) ## Check input if (nargin < 1) print_usage (); - elseif (nargin == 1 || isempty (format)) + endif + + if (isempty (format)) format = "%f"; endif - if (nargin > 2 && isnumeric (varargin{1})) - nlines = varargin{1}; - args = varargin(2:end); + if (! (isa (fid, "double") && fid > 0) && ! ischar (fid)) + error ("textscan: first argument must be a file id or character string"); + endif + + if (! ischar (format)) + error ("textscan: FORMAT must be a string"); + endif + + args = varargin; + if (nargin > 2 && isnumeric (args{1})) + nlines = args{1}; else nlines = Inf; - args = varargin; endif if (! any (strcmpi (args, "emptyvalue"))) ## Matlab returns NaNs for missing values - args{end+1} = "emptyvalue"; - args{end+1} = NaN; + args(end+1:end+2) = {'emptyvalue', NaN}; + endif + + ## Check default parameter values that differ for strread & textread + + ipos = find (strcmpi (args, "whitespace")); + if (isempty (ipos)) + ## Matlab default whitespace = " \b\t" + args(end+1:end+2) = {'whitespace', " \b\t"}; + whitespace = " \b\t"; + else + ## Check if there's at least one string format specifier + fmt = strrep (format, "%", " %"); + fmt = regexp (fmt, '[^ ]+', 'match'); + fmt = strtrim (fmt(strmatch ("%", fmt))) + has_str_fmt = all (cellfun ("isempty", strfind (strtrim (fmt(strmatch ("%", fmt))), 's'))); + ## If there is a format, AND whitespace value = empty, + ## don't add a space (char(32)) to whitespace + if (! (isempty (args{ipos+1}) && has_str_fmt)) + args{ipos+1} = unique ([" ", whitespace]); + endif + endif + + if (! any (strcmpi (args, "delimiter"))) + ## Matlab says default delimiter = whitespace. + ## strread() will pick this up further + args(end+1:end+2) = {'delimiter', ""}; + endif + + collop = false; + ipos = find (strcmpi (args, "collectoutput")); + if (! isempty (ipos)) + ## Search & concatenate consecutive columns of same class requested + if (isscalar (args{ipos+1}) + && (islogical (args{ipos+1}) || isnumeric (args{ipos+1}))) + collop = args{ipos+1}; + else + warning ("textscan: illegal value for CollectOutput parameter - ignored"); + endif + ## Remove argument before call to strread() below + args(ipos:ipos+1) = []; + endif + + if (any (strcmpi (args, "returnonerror"))) + ## Because of the way strread() reads data (columnwise) this parameter + ## can't be neatly implemented. strread() will pick it up anyway + warning ('textscan: ReturnOnError is not fully implemented'); + else + ## Set default value (=true) + args(end+1:end+2) = {"returnonerror", 1}; + endif + + if (ischar (fid)) + ## Read from a text string + if (nargout == 2) + error ("textscan: cannot provide position information for character input"); + endif + str = fid; + else + ## 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}); + args(headerlines:headerlines+1) = []; + 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 endif - if (isa (fid, "double") && fid > 0 || ischar (fid)) - if (ischar (format)) - if (ischar (fid)) - if (nargout == 2) - error ("textscan: cannot provide position information for character input"); - endif - str = fid; - else - ## Maybe skip header lines - headerlines = find (strcmpi (args, "headerlines"), 1); - if (! isempty (headerlines)) - hdr_lines = floor (varargin{headerlines + 1}); - ## Beware of zero valued headerline, fskipl will count lines to EOF - if (hdr_lines > 0) - fskipl (fid, hdr_lines); - endif - endif - if (isfinite (nlines)) - str = ""; - for n = 1:nlines - str = strcat (str, fgets (fid)); - endfor - else - str = fread (fid, "char=>char").'; - endif + ## Check for empty result + if (isempty (str)) + warning ("textscan: no data read"); + C = []; + return; + endif + + ## Check value of 'endofline'. String or file doesn't seem to matter + endofline = find (strcmpi (args, "endofline"), 1); + if (! isempty (endofline)) + if (ischar (args{endofline + 1})) + eol_char = args{endofline + 1}; + if (isempty (strmatch (eol_char, {"", "\n", "\r", "\r\n"}, 'exact'))) + error ("textscan: illegal EndOfLine character value specified"); endif - - ## Determine the number of data fields - num_fields = numel (strfind (format, "%")) - ... - numel (idx_star = strfind (format, "%*")); - - ## Call strread to make it do the real work - C = cell (1, num_fields); - [C{:}] = strread (str, format, args{:}); - - if (ischar (fid) && isfinite (nlines)) - C = cellfun (@(x) x(1:nlines), C, "uniformoutput", false); - endif - - if (nargout == 2) - p = ftell (fid); - endif - else - error ("textscan: FORMAT must be a valid specification"); + error ("textscan: character value required for EndOfLine"); endif else - error ("textscan: first argument must be a file id or character string"); + ## Determine EOL from file. Search for EOL candidates in first 3000 chars + eol_srch_len = min (length (str), 3000); + ## First try DOS (CRLF) + if (! isempty (findstr ("\r\n", str(1 : eol_srch_len)))) + eol_char = "\r\n"; + ## Perhaps old Macintosh? (CR) + elseif (! isempty (findstr ("\r", str(1 : eol_srch_len)))) + eol_char = "\r"; + ## Otherwise, use plain UNIX (LF) + else + eol_char = "\n"; + endif + ## Set up the default endofline param value + args(end+1:end+2) = {'endofline', eol_char}; + endif + + ## Determine the number of data fields + num_fields = numel (strfind (format, "%")) - numel (strfind (format, "%*")); + + ## Strip trailing EOL to avoid returning stray missing values (f. strread) + if (strcmp (str(end-length (eol_char) + 1 : end), eol_char)); + str(end-length (eol_char) + 1 : end) = ""; + endif + + ## Call strread to make it do the real work + C = cell (1, num_fields); + [C{:}] = strread (str, format, args{:}); + + ## If requested, collect output columns of same class + if (collop) + C = colloutp (C); endif + if (nargout == 2) + position = ftell (fid); + endif + +endfunction + + +## Collect consecutive columns of same class into one cell column +function C = colloutp (C) + + ## Start at rightmost column and work backwards to avoid ptr mixup + ii = numel (C); + while ii > 1 + clss1 = class (C{ii}); + jj = ii; + 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 + if (jj < ii) + ## Concatenate columns into current column + C{jj} = [C{jj : ii}]; + ## Wipe concatenated columns to the right, resume search to the left + C(jj+1 : ii) = []; + ii = jj - 1; + else + ## No similar class in column to the left, search from there + --ii; + endif + endwhile + endfunction %!test %! str = "1, 2, 3, 4\n 5, , , 8\n 9, 10, 11, 12"; %! fmtstr = "%f %d %f %s"; %! c = textscan (str, fmtstr, 2, "delimiter", ",", "emptyvalue", -Inf); -%! assert (isequal (c{1}, [1;5])) +%! assert (isequal (c{1}, [1;5])); %! assert (length (c{1}), 2); -%! assert (iscellstr (c{4})) -%! assert (isequal (c{3}, [3; -Inf])) +%! assert (iscellstr (c{4})); +%! assert (isequal (c{3}, [3; -Inf])); %!test %! b = [10:10:100]; @@ -137,7 +273,60 @@ %! str = sprintf ("%g miles/hr = %g kilometers/hr\n", b); %! fmt = "%f miles/hr = %f kilometers/hr"; %! c = textscan (str, fmt); -%! assert (b(1,:)', c{1}) -%! assert (b(2,:)', c{2}) +%! assert (b(1,:)', c{1}, 1e-5); +%! assert (b(2,:)', c{2}, 1e-5); + +#%!test +#%! str = "13, 72, NA, str1, 25\r\n// Middle line\r\n36, na, 05, str3, 6"; +#%! a = textscan(str, '%d %n %f %s %n', 'delimiter', ',','treatAsEmpty', {'NA', 'na'},'commentStyle', '//'); +#%! assert (a{1}, int32([13; 36])); +#%! assert (a{2}, [72; NaN]); +#%! assert (a{3}, [NaN; 5]); +#%! assert (a{4}, {"str1"; "str3"}); +#%! assert (a{5}, [25; 6]); + +%!test +%! str = "Km:10 = hhhBjjj miles16hour\r\n"; +%! str = [str "Km:15 = hhhJjjj miles241hour\r\n"]; +%! str = [str "Km:2 = hhhRjjj miles3hour\r\n"]; +%! str = [str "Km:25 = hhhZ\r\n"]; +%! fmt = "Km:%d = hhh%1sjjj miles%dhour"; +%! a = textscan (str, fmt, 'delimiter', ' '); +%! assert (a{1}', int32([10 15 2 25])); +%! assert (a{2}', {'B' 'J' 'R' 'Z'}); +%! assert (a{3}', int32([16 241 3 0])); + +%% Test with default endofline parameter +%!test +%! c = textscan ("L1\nL2", "%s"); +%! assert (c{:}, {"L1"; "L2"}); +%% Test with endofline parameter set to '' (empty) - newline should be in word +%!test +%! c = textscan ("L1\nL2", "%s", 'endofline', ''); +%! assert (int8(c{:}{:}), int8([ 76, 49, 10, 76, 50 ])); +%!test +%! # No delimiters at all besides EOL. Skip fields, even empty fields +%! str = "Text1Text2Text\nTextText4Text\nText57Text"; +%! c = textscan (str, "Text%*dText%dText"); +%! assert (c{1}, int32 ([2; 4; 0])); + +%!test +%% CollectOutput test +%! b = [10:10:100]; +%! b = [b; 8*b/5; 8*b*1000/5]; +%! str = sprintf ("%g miles/hr = %g (%g) kilometers (meters)/hr\n", b); +%! fmt = "%f miles%s %s %f (%f) kilometers %*s"; +%! c = textscan (str, fmt, 'collectoutput', 1); +%! assert (size(c{3}), [10, 2]); +%! assert (size(c{2}), [10, 2]); + +%% Test input validation +%!error textscan () +%!error textscan (single (4)) +%!error textscan ({4}) +%!error <must be a string> textscan ("Hello World", 2) +%!error <cannot provide position information> [C, pos] = textscan ("Hello World") +%!error <character value required> textscan ("Hello World", '%s', 'EndOfLine', 3) +
--- a/scripts/linear-algebra/commutation_matrix.m +++ b/scripts/linear-algebra/commutation_matrix.m @@ -76,12 +76,12 @@ if (nargin < 1 || nargin > 2) print_usage (); else - if (! (isscalar (m) && m == round (m) && m > 0)) + if (! (isscalar (m) && m == fix (m) && m > 0)) error ("commutation_matrix: M must be a positive integer"); endif if (nargin == 1) n = m; - elseif (! (isscalar (n) && n == round (n) && n > 0)) + elseif (! (isscalar (n) && n == fix (n) && n > 0)) error ("commutation_matrix: N must be a positive integer"); endif endif @@ -95,3 +95,25 @@ endfor endfunction + +%!test +%! c = commutation_matrix(1,1); +%! assert(c,1); + +%!test +%! A = rand(3,5); +%! vc = vec(A); +%! vr = vec(A'); +%! c = commutation_matrix(3,5); +%! assert(c*vc,vr); + +%!test +%! A = rand(4,6); +%! vc = vec(A); +%! vr = vec(A'); +%! c = commutation_matrix(4,6); +%! assert(c*vc,vr); + +%!error commutation_matrix(0,0); +%!error commutation_matrix(1,0); +%!error commutation_matrix(0,1);
--- a/scripts/linear-algebra/cross.m +++ b/scripts/linear-algebra/cross.m @@ -90,3 +90,26 @@ endif endfunction + +%!test +%! x = [1 0 0]; +%! y = [0 1 0]; +%! r = [0 0 1]; +%! assert(cross(x, y), r, 2e-8); + +%!test +%! x = [1 2 3]; +%! y = [4 5 6]; +%! r = [(2*6-3*5) (3*4-1*6) (1*5-2*4)]; +%! assert(cross(x, y), r, 2e-8); + +%!test +%! x = [1 0 0; 0 1 0; 0 0 1]; +%! y = [0 1 0; 0 0 1; 1 0 0]; +%! r = [0 0 1; 1 0 0; 0 1 0]; +%! assert(cross(x, y, 2), r, 2e-8); +%! assert(cross(x, y, 1), -r, 2e-8); + +%!error cross(0,0); +%!error cross(); +
--- a/scripts/linear-algebra/duplication_matrix.m +++ b/scripts/linear-algebra/duplication_matrix.m @@ -68,7 +68,7 @@ print_usage (); endif - if (! (isscalar (n) && n == round (n) && n > 0)) + if (! (isscalar (n) && n > 0 && n == fix (n))) error ("duplication_matrix: N must be a positive integer"); endif @@ -86,3 +86,35 @@ endfor endfunction + +%!test +%! N = 2; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!test +%! N = 3; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!test +%! N = 4; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!error duplication_matrix (); +%!error duplication_matrix (0.5); +%!error duplication_matrix (-1); +%!error duplication_matrix (ones(1,4));
--- a/scripts/linear-algebra/housh.m +++ b/scripts/linear-algebra/housh.m @@ -23,8 +23,8 @@ ## ## @example ## @group -## (I - beta*housv*housv')x = norm(x)*e(j) if x(1) < 0, -## (I - beta*housv*housv')x = -norm(x)*e(j) if x(1) >= 0 +## (I - beta*housv*housv')x = norm(x)*e(j) if x(j) < 0, +## (I - beta*housv*housv')x = -norm(x)*e(j) if x(j) >= 0 ## @end group ## @end example ## @@ -91,3 +91,43 @@ endif endfunction + +%!test +%! x = [1 2 3]'; +%! j = 3; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(3) - b*hv*hv') * x; +%! d = - norm(x) * [0 0 1]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!test +%! x = [7 -3 1]'; +%! j = 2; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(3) - b*hv*hv') * x; +%! d = norm(x) * [0 1 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!test +%! x = [1 0 0]'; +%! j = 1; +%! [hv, b, z] = housh(x, j, 10); +%! r = (eye(3) - b*hv*hv') * x; +%! d = norm(x) * [1 0 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 1, 2e-8); + +%!test +%! x = [5 0 4 1]'; +%! j = 2; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(4) - b*hv*hv') * x; +%! d = - norm(x) * [0 1 0 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!error housh([0]); +%!error housh(); +
--- a/scripts/linear-algebra/isdefinite.m +++ b/scripts/linear-algebra/isdefinite.m @@ -63,3 +63,22 @@ endif endfunction + +%!test +%! A = [-1 0; 0 -1]; +%! assert (isdefinite (A), -1) + +%!test +%! A = [1 0; 0 1]; +%! assert (isdefinite (A), 1) + +%!test +%! A = [2 -1 0; -1 2 -1; 0 -1 2]; +%! assert (isdefinite (A), 1) + +%!test +%! A = [1 0; 0 0]; +%! assert (isdefinite (A), 0) + +%!error isdefinite () +%!error isdefinite ([1 2; 3 4]) \ No newline at end of file
--- a/scripts/linear-algebra/krylov.m +++ b/scripts/linear-algebra/krylov.m @@ -28,8 +28,8 @@ ## Using Householder reflections to guard against loss of orthogonality. ## ## If @var{V} is a vector, then @var{h} contains the Hessenberg matrix -## such that @code{a*u == u*h+rk*ek'}, in which @code{rk = -## a*u(:,k)-u*h(:,k)}, and @code{ek'} is the vector +## such that @xcode{a*u == u*h+rk*ek'}, in which @code{rk = +## a*u(:,k)-u*h(:,k)}, and @xcode{ek'} is the vector ## @code{[0, 0, @dots{}, 1]} of length @code{k}. Otherwise, @var{h} is ## meaningless. ##
--- a/scripts/linear-algebra/module.mk +++ b/scripts/linear-algebra/module.mk @@ -7,7 +7,6 @@ linear-algebra/cross.m \ linear-algebra/duplication_matrix.m \ linear-algebra/expm.m \ - linear-algebra/gmres.m \ linear-algebra/housh.m \ linear-algebra/isdefinite.m \ linear-algebra/ishermitian.m \
--- a/scripts/linear-algebra/null.m +++ b/scripts/linear-algebra/null.m @@ -77,3 +77,35 @@ endif endfunction + +%!test +%! A = 0; +%! assert(null(A), 1); + +%!test +%! A = 1; +%! assert(null(A), zeros(1,0)) + +%!test +%! A = [1 0; 0 1]; +%! assert(null(A), zeros(2,0)); + +%!test +%! A = [1 0; 1 0]; +%! assert(null(A), [0 1]') + +%!test +%! A = [1 1; 0 0]; +%! assert(null(A), [-1/sqrt(2) 1/sqrt(2)]', eps) + +%!test +%! tol = 1e-4; +%! A = [1 0; 0 tol-eps]; +%! assert(null(A,tol), [0 1]') + +%!test +%! tol = 1e-4; +%! A = [1 0; 0 tol+eps]; +%! assert(null(A,tol), zeros(2,0)); + +%!error null()
--- a/scripts/linear-algebra/onenormest.m +++ b/scripts/linear-algebra/onenormest.m @@ -277,6 +277,9 @@ ## Only likely to be within a factor of 10. %!test +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ('state', 42); % Initialize to guarantee reproducible results %! N = 100; %! A = rand (N); %! [nm1, v1, w1] = onenormest (A);
--- a/scripts/linear-algebra/orth.m +++ b/scripts/linear-algebra/orth.m @@ -39,6 +39,11 @@ if (nargin == 1 || nargin == 2) + if (isempty (A)) + retval = []; + return; + endif + [U, S, V] = svd (A); [rows, cols] = size (A); @@ -74,3 +79,12 @@ endif endfunction + +%!test +%! for ii=1:20 +%! A = rand (10, 10); +%! V = orth (A); +%! if (det (A) != 0) +%! assert (V'*V, eye (10), 100*eps) +%! endif +%! endfor
--- a/scripts/linear-algebra/planerot.m +++ b/scripts/linear-algebra/planerot.m @@ -34,3 +34,14 @@ G = givens (x(1), x(2)); y = G * x(:); endfunction + +%!test +%! x = [3 4]; +%! [g y] = planerot(x); +%! assert(g - [x(1) x(2); -x(2) x(1)] / sqrt(x(1)^2 + x(2)^2), zeros(2), 2e-8); +%! assert(y(2), 0, 2e-8); + +%!error planerot([0]); +%!error planerot([0 0 0]); +%!error planerot(); +
--- a/scripts/linear-algebra/qzhess.m +++ b/scripts/linear-algebra/qzhess.m @@ -90,3 +90,52 @@ endfor endfunction + +%!test +%! a = [1 2 1 3; +%! 2 5 3 2; +%! 5 5 1 0; +%! 4 0 3 2]; +%! b = [0 4 2 1; +%! 2 3 1 1; +%! 1 0 2 1; +%! 2 5 3 2]; +%! mask = [0 0 0 0; +%! 0 0 0 0; +%! 1 0 0 0; +%! 1 1 0 0]; +%! [aa, bb, q, z] = qzhess(a, b); +%! assert(inv(q) - q', zeros(4), 2e-8); +%! assert(inv(z) - z', zeros(4), 2e-8); +%! assert(q * a * z, aa, 2e-8); +%! assert(aa .* mask, zeros(4), 2e-8); +%! assert(q * b * z, bb, 2e-8); +%! assert(bb .* mask, zeros(4), 2e-8); + +%!test +%! a = [1 2 3 4 5; +%! 3 2 3 1 0; +%! 4 3 2 1 1; +%! 0 1 0 1 0; +%! 3 2 1 0 5]; +%! b = [5 0 4 0 1; +%! 1 1 1 2 5; +%! 0 3 2 1 0; +%! 4 3 0 3 5; +%! 2 1 2 1 3]; +%! mask = [0 0 0 0 0; +%! 0 0 0 0 0; +%! 1 0 0 0 0; +%! 1 1 0 0 0; +%! 1 1 1 0 0]; +%! [aa, bb, q, z] = qzhess(a, b); +%! assert(inv(q) - q', zeros(5), 2e-8); +%! assert(inv(z) - z', zeros(5), 2e-8); +%! assert(q * a * z, aa, 2e-8); +%! assert(aa .* mask, zeros(5), 2e-8); +%! assert(q * b * z, bb, 2e-8); +%! assert(bb .* mask, zeros(5), 2e-8); + +%!error qzhess([0]); +%!error qzhess(); +
--- a/scripts/linear-algebra/rank.m +++ b/scripts/linear-algebra/rank.m @@ -58,3 +58,54 @@ retval = sum (sigma > tolerance); endfunction + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3.1 4 5 6 7; +%! 2 3 4 5 6 7 8; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),4); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3.0000001 4 5 6 7; +%! 4 5 6 7 8 9 12.00001; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),4); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12.00001; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),3); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),3); + +%!test +%! A = eye(100); +%! assert(rank(A),100); + +%!test +%! A = [1, 2, 3; 1, 2.001, 3; 1, 2, 3.0000001]; +%! assert(rank(A),3) +%! assert(rank(A,0.0009),1) +%! assert(rank(A,0.0006),2) +%! assert(rank(A,0.00000002),3) \ No newline at end of file
--- a/scripts/linear-algebra/rref.m +++ b/scripts/linear-algebra/rref.m @@ -86,3 +86,43 @@ k = find (used); endfunction + +%!test +%! a = [1]; +%! [r k] = rref(a); +%! assert(r, [1], 2e-8); +%! assert(k, [1], 2e-8); + +%!test +%! a = [1 3; 4 5]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, eye(2), 2e-8); +%! assert(k == [1, 2] || k == [2, 1]); + + +%!test +%! a = [1 3; 4 5; 7 9]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, eye(3)(:,1:2), 2e-8); +%! assert(k, [1 2], 2e-8); + +%!test +%! a = [1 2 3; 2 4 6; 7 2 0]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, [1 0 (3-7/2); 0 1 (7/4); 0 0 0], 2e-8); +%! assert(k, [1 2], 2e-8); + +%!test +%! a = [1 2 1; 2 4 2.01; 2 4 2.1]; +%! tol = 0.02; +%! [r k] = rref(a, tol); +%! assert(rank(a, tol), rank(r, tol), 2e-8); +%! tol = 0.2; +%! [r k] = rref(a, tol); +%! assert(rank(a, tol), rank(r, tol), 2e-8); + +%!error rref(); +
--- a/scripts/miscellaneous/ans.m +++ b/scripts/miscellaneous/ans.m @@ -28,3 +28,7 @@ ## @noindent ## is evaluated, the value returned by @code{ans} is 25. ## @end defvr + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) +
--- a/scripts/miscellaneous/bincoeff.m +++ b/scripts/miscellaneous/bincoeff.m @@ -68,46 +68,53 @@ error ("bincoeff: N and K must be of common size or scalars"); endif - sz = size (n); - b = zeros (sz); + if (iscomplex (n) || iscomplex (k)) + error ("bincoeff: N and K must not be complex"); + endif - ind = (! (k >= 0) | (k != real (round (k))) | isnan (n)); - b(ind) = NaN; + b = zeros (size (n)); - ind = (k == 0); - b(ind) = 1; + ok = (k >= 0) & (k == fix (k)) & (! isnan (n)); + b(! ok) = NaN; - ind = ((k > 0) & ((n == real (round (n))) & (n < 0))); - b(ind) = (-1) .^ k(ind) .* exp (gammaln (abs (n(ind)) + k(ind)) - - gammaln (k(ind) + 1) - - gammaln (abs (n(ind)))); + n_int = (n == fix (n)); + idx = n_int & (n < 0) & ok; + b(idx) = (-1) .^ k(idx) .* exp (gammaln (abs (n(idx)) + k(idx)) + - gammaln (k(idx) + 1) + - gammaln (abs (n(idx)))); - ind = ((k > 0) & (n >= k)); - b(ind) = exp (gammaln (n(ind) + 1) - - gammaln (k(ind) + 1) - - gammaln (n(ind) - k(ind) + 1)); + idx = (n >= k) & ok; + b(idx) = exp (gammaln (n(idx) + 1) + - gammaln (k(idx) + 1) + - gammaln (n(idx) - k(idx) + 1)); - ind = ((k > 0) & ((n != real (round (n))) & (n < k))); - b(ind) = (1/pi) * exp (gammaln (n(ind) + 1) - - gammaln (k(ind) + 1) - + gammaln (k(ind) - n(ind)) - + log (sin (pi * (n(ind) - k(ind) + 1)))); + idx = (! n_int) & (n < k) & ok; + b(idx) = (1/pi) * exp (gammaln (n(idx) + 1) + - gammaln (k(idx) + 1) + + gammaln (k(idx) - n(idx)) + + log (sin (pi * (n(idx) - k(idx) + 1)))); ## Clean up rounding errors. - ind = (n == round (n)); - b(ind) = round (b(ind)); + b(n_int) = round (b(n_int)); - ind = (n != round (n)); - b(ind) = real (b(ind)); + idx = ! n_int; + b(idx) = real (b(idx)); endfunction -%!assert(bincoeff(4,2), 6) -%!assert(bincoeff(2,4), 0) -%!assert(bincoeff(0.4,2), -.12, 8*eps) + +%!assert(bincoeff (4, 2), 6) +%!assert(bincoeff (2, 4), 0) +%!assert(bincoeff (-4, 2), 10) +%!assert(bincoeff (5, 2), 10) +%!assert(bincoeff (50, 6), 15890700) +%!assert(bincoeff (0.4, 2), -.12, 8*eps) -%!assert(bincoeff (5, 2) == 10 && bincoeff (50, 6) == 15890700); +%!assert(bincoeff ([4 NaN 4], [-1, 2, 2.5]), NaN (1, 3)) +%% Test input validation %!error bincoeff (); +%!error bincoeff (1, 2, 3); +%!error bincoeff (ones(3),ones(2)) +%!error bincoeff (ones(2),ones(3)) -%!error bincoeff (1, 2, 3);
--- a/scripts/miscellaneous/bug_report.m +++ b/scripts/miscellaneous/bug_report.m @@ -43,3 +43,6 @@ puts ("\n"); endfunction + +## Mark file as being tested. No real test needed for this function. +%!assert (1)
--- a/scripts/miscellaneous/comma.m +++ b/scripts/miscellaneous/comma.m @@ -21,3 +21,7 @@ ## Array index, function argument, or command separator. ## @seealso{semicolon} ## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) +
--- a/scripts/miscellaneous/computer.m +++ b/scripts/miscellaneous/computer.m @@ -18,6 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{c}, @var{maxsize}, @var{endian}] =} computer () +## @deftypefnx {Function File} {@var{arch} =} computer ("arch") ## Print or return a string of the form @var{cpu}-@var{vendor}-@var{os} ## that identifies the kind of computer Octave is running on. If invoked ## with an output argument, the value is returned instead of printed. For @@ -39,42 +40,52 @@ ## If three output arguments are requested, also return the byte order ## of the current system as a character (@code{"B"} for big-endian or ## @code{"L"} for little-endian). +## +## If the argument @code{"arch"} is specified, return a string +## indicating the architecture of the computer on which Octave is +## running. ## @end deftypefn -function [c, maxsize, endian] = computer () - - if (nargin != 0) - warning ("computer: ignoring extra arguments"); - endif +function [c, maxsize, endian] = computer (a) - msg = octave_config_info ("canonical_host_type"); + if (nargin == 1 && ischar (a) && strcmpi (a, "arch")) + tmp = strsplit (octave_config_info ("canonical_host_type"), "-"); + if (numel (tmp) == 4) + c = sprintf ("%s-%s-%s", tmp{4}, tmp{3}, tmp{1}); + else + c = sprintf ("%s-%s", tmp{3}, tmp{1}); + endif + elseif (nargin == 0) + msg = octave_config_info ("canonical_host_type"); - if (strcmp (msg, "unknown")) - msg = "Hi Dave, I'm a HAL-9000"; - endif + if (strcmp (msg, "unknown")) + msg = "Hi Dave, I'm a HAL-9000"; + endif - if (nargout == 0) - printf ("%s\n", msg); - else - c = msg; - if (strcmp (octave_config_info ("USE_64_BIT_IDX_T"), "true")) - maxsize = 2^63-1; + if (nargout == 0) + printf ("%s\n", msg); else - maxsize = 2^31-1; + c = msg; + if (strcmp (octave_config_info ("USE_64_BIT_IDX_T"), "true")) + maxsize = 2^63-1; + else + maxsize = 2^31-1; + endif + if (octave_config_info ("words_big_endian")) + endian = "B"; + elseif (octave_config_info ("words_little_endian")) + endian = "L"; + else + endian = "?"; + endif endif - if (octave_config_info ("words_big_endian")) - endian = "B"; - elseif (octave_config_info ("words_little_endian")) - endian = "L"; - else - endian = "?"; - endif + else + print_usage (); endif endfunction %!assert((ischar (computer ()) %! && computer () == octave_config_info ("canonical_host_type"))); - -%!warning a =computer(2); - +%!assert(ischar (computer ("arch"))); +%!error computer (2);
--- a/scripts/miscellaneous/delete.m +++ b/scripts/miscellaneous/delete.m @@ -23,34 +23,41 @@ ## ## Deleting graphics objects is the proper way to remove ## features from a plot without clearing the entire figure. -## @seealso{clf, cla} +## @seealso{clf, cla, unlink} ## @end deftypefn ## Author: jwe function delete (arg) - if (nargin == 1) - if (ischar (arg)) - files = glob (arg).'; - if (isempty (files)) - warning ("delete: no such file: %s", arg); - endif - for i = 1:length (files) - file = files{i}; - [err, msg] = unlink (file); - if (err) - warning ("delete: %s: %s", file, msg); - endif - endfor - elseif (all (ishandle (arg(:)))) - ## Delete a graphics object. - __go_delete__ (arg); - else - error ("delete: first argument must be a filename or graphics handle"); - endif - else + if (nargin != 1) print_usage (); endif + if (ischar (arg)) + files = glob (arg); + if (isempty (files)) + warning ("delete: no such file: %s", arg); + endif + for i = 1:length (files) + file = files{i}; + [err, msg] = unlink (file); + if (err) + warning ("delete: %s: %s", file, msg); + endif + endfor + elseif (all (ishandle (arg(:)))) + ## Delete a graphics object. + __go_delete__ (arg); + else + error ("delete: first argument must be a filename or graphics handle"); + endif + endfunction + + +%% Test input validation +%!error delete () +%!error delete (1, 2) +%!error <first argument must be a filename> delete (struct ()) +
--- a/scripts/miscellaneous/edit.m +++ b/scripts/miscellaneous/edit.m @@ -54,7 +54,7 @@ ## filename. If @file{name.ext} is not modifiable, it will be copied to ## @env{HOME} before editing. ## -## @strong{WARNING!} You may need to clear name before the new definition +## @strong{Warning:} You may need to clear name before the new definition ## is available. If you are editing a .cc file, you will need ## to mkoctfile @file{name.cc} before the definition will be available. ## @end itemize
--- a/scripts/miscellaneous/fullfile.m +++ b/scripts/miscellaneous/fullfile.m @@ -26,7 +26,7 @@ if (nargin > 0) ## Discard all empty arguments - varargin(cellfun (@isempty, varargin)) = []; + varargin(cellfun ("isempty", varargin)) = []; nargs = numel (varargin); if (nargs > 1) filename = varargin{1};
--- a/scripts/miscellaneous/getappdata.m +++ b/scripts/miscellaneous/getappdata.m @@ -36,9 +36,10 @@ for nh = 1:numel(h) try appdata = get (h(nh), "__appdata__"); - catch + end_try_catch + if (! isfield (appdata, name)) appdata.(name) = []; - end_try_catch + endif val(nh) = {appdata.(name)}; endfor if (nh == 1)
--- a/scripts/miscellaneous/getfield.m +++ b/scripts/miscellaneous/getfield.m @@ -50,8 +50,8 @@ print_usage (); endif subs = varargin; - flds = cellfun (@ischar, subs); - idxs = cellfun (@iscell, subs); + flds = cellfun ("isclass", subs, "char"); + idxs = cellfun ("isclass", subs, "cell"); if (all (flds | idxs)) typs = merge (flds, {"."}, {"()"}); obj = subsref (s, struct ("type", typs, "subs", subs));
--- a/scripts/miscellaneous/gzip.m +++ b/scripts/miscellaneous/gzip.m @@ -31,7 +31,7 @@ if (nargin != 1 && nargin != 2) || (nargout > 1) print_usage (); endif - + if (nargout == 0) __xzip__ ("gzip", "gz", "gzip -r %s", varargin{:}); else
--- a/scripts/miscellaneous/info.m +++ b/scripts/miscellaneous/info.m @@ -43,3 +43,6 @@ http://www.octave.org/bugs.html\n"); endfunction + +## Mark file as being tested. No real test needed for this function. +%! assert (1)
--- a/scripts/miscellaneous/ismac.m +++ b/scripts/miscellaneous/ismac.m @@ -32,3 +32,5 @@ endfunction +%!error ismac (1); +%!assert (islogical (ismac ()));
--- a/scripts/miscellaneous/ispc.m +++ b/scripts/miscellaneous/ispc.m @@ -31,3 +31,6 @@ endif endfunction + +%!error ispc (1); +%!assert (islogical (ispc ()));
--- a/scripts/miscellaneous/isunix.m +++ b/scripts/miscellaneous/isunix.m @@ -31,3 +31,6 @@ endif endfunction + +%!error isunix (1); +%!assert (islogical (isunix ()));
--- a/scripts/miscellaneous/license.m +++ b/scripts/miscellaneous/license.m @@ -75,21 +75,15 @@ nr_licenses = rows (__octave_licenses__); if (nout > 1 || nin > 3) - error ("type `help license' for usage info"); + print_usage (); endif - if (nin == 0) + if (nin == 0) - found = false; - for p = 1:nr_licenses - if (strcmp (__octave_licenses__{p,1}, "Octave")) - found = true; - break; - endif - endfor + found = find (strcmp (__octave_licenses__(:,1), "Octave"), 1); - if (found) - result = __octave_licenses__{p,2}; + if (! isempty (found)) + result = __octave_licenses__{found,2}; else result = "unknown"; endif @@ -105,17 +99,15 @@ if (nout == 0) if (! strcmp (varargin{1}, "inuse")) - usage ("license (\"inuse\")"); + usage ('license ("inuse")'); endif - for p = 1:nr_licenses - printf ("%s\n", __octave_licenses__{p,1}); - endfor + printf ("%s\n", __octave_licenses__{:,1}); else if (! strcmp (varargin{1}, "inuse")) - usage ("retval = license (\"inuse\")"); + usage ('retval = license ("inuse")'); endif pw = getpwuid (getuid ()); @@ -125,11 +117,7 @@ username = "octave_user"; endif - retval(1:nr_licenses) = struct ("feature", "", "user", ""); - for p = 1:nr_licenses - retval(p).feature = __octave_licenses__{p,1}; - retval(p).user = username; - endfor + retval = struct ("feature", __octave_licenses__(:,1), "user", username); endif @@ -139,52 +127,61 @@ if (strcmp (varargin{1}, "test")) - found = false; - for p = 1:nr_licenses - if (strcmpi (feature, __octave_licenses__{p,1})) - found = true; - break; - endif - endfor + found = find (strcmpi (__octave_licenses__(:,1), feature), 1); if (nin == 2) - retval = found && __octave_licenses__{p,3}; + retval = ! isempty (found) && __octave_licenses__{found,3}; else - if (found) + if (! isempty (found)) if (strcmp (varargin{3}, "enable")) - __octave_licenses__{p,3} = true; + __octave_licenses__{found,3} = true; elseif (strcmp (varargin{3}, "disable")) - __octave_licenses__{p,3} = false; + __octave_licenses__{found,3} = false; else - error ("TOGGLE must be either `enable' of `disable'"); + error ("license: TOGGLE must be either `enable' or `disable'"); endif else - error ("FEATURE `%s' not found", feature); + error ("license: FEATURE `%s' not found", feature); endif endif elseif (strcmp (varargin{1}, "checkout")) if (nin != 2) - usage ("retval = license (\"checkout\", feature)"); + usage ('retval = license ("checkout", feature)'); endif - found = false; - for p = 1:nr_licenses - if (strcmpi (feature, __octave_licenses__{p,1})) - found = true; - break; - endif - endfor + found = find (strcmpi (__octave_licenses__(:,1), feature), 1); - retval = found && __octave_licenses__{p,3}; + retval = ! isempty (found) && __octave_licenses__{found,3}; else - - error ("type `help license' for usage info"); - + print_usage (); endif endif endfunction + + +%!assert (license(), "GNU General Public License") +%!assert ((license ("inuse")).feature, "Octave") + +%!test +%! lstate = license ("test", "Octave"); +%! license ("test", "Octave", "disable"); +%! assert (license ("test", "Octave"), false); +%! license ("test", "Octave", "enable"); +%! assert (license ("test", "Octave"), true); +%! if (lstate == false) +%! license ("test", "Octave", "disable"); +%! endif + +%!assert (license ("checkout", "Octave"), true) + +%% Test input validation +%!error license ("not_inuse") +%!error <TOGGLE must be either> license ("test", "Octave", "not_enable") +%!error <FEATURE `INVALID' not found> license ("test", "INVALID", "enable") +%!error license ("not_test", "Octave", "enable") +
--- a/scripts/miscellaneous/list_primes.m +++ b/scripts/miscellaneous/list_primes.m @@ -83,3 +83,9 @@ endwhile endfunction + +%!test +%! assert (list_primes(), [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41,\ +%! 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97]); +%! assert (list_primes(5), [2, 3, 5, 7, 11]); +
--- a/scripts/miscellaneous/ls.m +++ b/scripts/miscellaneous/ls.m @@ -63,7 +63,7 @@ retval = strvcat (regexp (output, '\S+', 'match'){:}); endif else - error ("ls: command exited abnormally with status %d", status); + error ("ls: command exited abnormally with status %d\n", status); endif else
--- a/scripts/miscellaneous/mexext.m +++ b/scripts/miscellaneous/mexext.m @@ -19,8 +19,11 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} mexext () ## Return the filename extension used for MEX files. +## @seealso{mex} ## @end deftypefn function retval = mexext () retval = "mex"; endfunction + +%!assert (mexext (), "mex")
--- a/scripts/miscellaneous/mkoctfile.m +++ b/scripts/miscellaneous/mkoctfile.m @@ -75,26 +75,30 @@ ## Print the configuration variable VAR@. Recognized variables are: ## ## @example -## ALL_CFLAGS FFTW_LIBS +## ALL_CFLAGS FFTW3F_LIBS ## ALL_CXXFLAGS FLIBS ## ALL_FFLAGS FPICFLAG ## ALL_LDFLAGS INCFLAGS -## BLAS_LIBS LDFLAGS -## CC LD_CXX -## CFLAGS LD_STATIC_FLAG -## CPICFLAG LFLAGS -## CPPFLAGS LIBCRUFT -## CXX LIBOCTAVE -## CXXFLAGS LIBOCTINTERP -## CXXPICFLAG LIBREADLINE +## BLAS_LIBS LAPACK_LIBS +## CC LDFLAGS +## CFLAGS LD_CXX +## CPICFLAG LD_STATIC_FLAG +## CPPFLAGS LFLAGS +## CXX LIBCRUFT +## CXXFLAGS LIBOCTAVE +## CXXPICFLAG LIBOCTINTERP ## DEPEND_EXTRA_SED_PATTERN LIBS ## DEPEND_FLAGS OCTAVE_LIBS -## DL_LD RDYNAMIC_FLAG -## DL_LDFLAGS RLD_FLAG -## F2C SED -## F2CFLAGS XTRA_CFLAGS -## F77 XTRA_CXXFLAGS -## FFLAGS +## DL_LD OCTAVE_LINK_DEPS +## DL_LDFLAGS OCT_LINK_DEPS +## EXEEXT RDYNAMIC_FLAG +## F77 READLINE_LIBS +## F77_INTEGER_8_FLAG SED +## FFLAGS XTRA_CFLAGS +## FFTW3_LDFLAGS XTRA_CXXFLAGS +## FFTW3_LIBS +## FFTW3F_LDFLAGS +## ## @end example ## ## @item --link-stand-alone
--- a/scripts/miscellaneous/module.mk +++ b/scripts/miscellaneous/module.mk @@ -50,6 +50,7 @@ miscellaneous/paren.m \ miscellaneous/parseparams.m \ miscellaneous/perl.m \ + miscellaneous/python.m \ miscellaneous/rmappdata.m \ miscellaneous/run.m \ miscellaneous/semicolon.m \ @@ -61,7 +62,6 @@ miscellaneous/tar.m \ miscellaneous/tempdir.m \ miscellaneous/tempname.m \ - miscellaneous/unimplemented.m \ miscellaneous/unix.m \ miscellaneous/unpack.m \ miscellaneous/untar.m \
--- a/scripts/miscellaneous/namelengthmax.m +++ b/scripts/miscellaneous/namelengthmax.m @@ -19,14 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} namelengthmax () ## Return the @sc{matlab} compatible maximum variable name length. Octave is -## capable of storing strings up to -## @tex -## $2^{31} - 1$ -## @end tex -## @ifnottex -## @code{2 ^ 31 - 1} -## @end ifnottex -## in length. However for @sc{matlab} compatibility all variable, function +## capable of storing strings up to @math{2^{31} - 1} in length. +## However for @sc{matlab} compatibility all variable, function, ## and structure field names should be shorter than the length supplied by ## @code{namelengthmax}. In particular variables stored to a @sc{matlab} file ## format will have their names truncated to this length. @@ -35,3 +29,6 @@ function n = namelengthmax () n = 63; endfunction + + +%!assert (namelengthmax, 63)
--- a/scripts/miscellaneous/news.m +++ b/scripts/miscellaneous/news.m @@ -36,3 +36,7 @@ endif endfunction + + +## Remove from test statistics. No real tests possible +%!assert (1)
--- a/scripts/miscellaneous/paren.m +++ b/scripts/miscellaneous/paren.m @@ -21,3 +21,7 @@ ## @deftypefnx {Operator} {} ) ## Array index or function argument delimeter. ## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) +
--- a/scripts/miscellaneous/private/__xzip__.m +++ b/scripts/miscellaneous/private/__xzip__.m @@ -36,7 +36,7 @@ if (nargin != 4 && nargin != 5) print_usage (); endif - + if (! ischar (extension) || length (extension) == 0) error ("__xzip__: EXTENSION must be a string with finite length"); endif @@ -112,10 +112,10 @@ endfunction function [d, f] = myfileparts (files) - [d, f, ext] = cellfun (@(x) fileparts (x), files, "uniformoutput", false); + [d, f, ext] = cellfun ("fileparts", files, "uniformoutput", false); f = cellfun (@(x, y) sprintf ("%s%s", x, y), f, ext, "uniformoutput", false); - idx = cellfun (@isdir, files); + idx = cellfun ("isdir", files); d(idx) = ""; f(idx) = files(idx); endfunction
new file mode 100644 --- /dev/null +++ b/scripts/miscellaneous/python.m @@ -0,0 +1,45 @@ +## Copyright (C) 2008-2011 Julian Schnidder +## Copyright (C) 2011 Carnë Draug <carandraug+dev@gmail.com> +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{output}, @var{status}] =} python (@var{scriptfile}) +## @deftypefnx {Function File} {[@var{output}, @var{status}] =} python (@var{scriptfile}, @var{argument1}, @var{argument2}, @dots{}) +## Invoke python script @var{scriptfile} with possibly a list of +## command line arguments. +## Returns output in @var{output} and status +## in @var{status}. +## @seealso{system} +## @end deftypefn + +function [output, status] = python (scriptfile = "-c ''", varargin) + + ## VARARGIN is intialized to {}(1x0) if no additional arguments are + ## supplied, so there is no need to check for it, or provide an + ## initial value in the argument list of the function definition. + + if (ischar (scriptfile) + && ((nargin != 1 && iscellstr (varargin)) + || (nargin == 1 && ! isempty (scriptfile)))) + [status, output] = system (cstrcat ("python ", scriptfile, + sprintf (" %s", varargin{:}))); + else + error ("python: invalid arguments"); + endif + +endfunction
--- a/scripts/miscellaneous/semicolon.m +++ b/scripts/miscellaneous/semicolon.m @@ -21,3 +21,7 @@ ## Array row or command separator. ## @seealso{comma} ## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) +
--- a/scripts/miscellaneous/setfield.m +++ b/scripts/miscellaneous/setfield.m @@ -50,8 +50,8 @@ endif subs = varargin(1:end-1); rhs = varargin{end}; - flds = cellfun (@ischar, subs); - idxs = cellfun (@iscell, subs); + flds = cellfun ("isclass", subs, "char"); + idxs = cellfun ("isclass", subs, "cell"); if (all (flds | idxs)) typs = merge (flds, {"."}, {"()"}); obj = subsasgn (obj, struct ("type", typs, "subs", subs), rhs);
--- a/scripts/miscellaneous/swapbytes.m +++ b/scripts/miscellaneous/swapbytes.m @@ -32,6 +32,7 @@ ## @end deftypefn function y = swapbytes (x) + if (nargin != 1) print_usage (); endif @@ -53,4 +54,11 @@ y = reshape (typecast (reshape (typecast (x(:), "uint8"), nb, numel (x)) ([nb : -1 : 1], :) (:), clx), size(x)); endif + endfunction + + +%!assert (double (swapbytes (uint16 (1:4))), [256 512 768 1024]) +%!error (swapbytes ()) +%!error (swapbytes (1, 2)) +
--- a/scripts/miscellaneous/symvar.m +++ b/scripts/miscellaneous/symvar.m @@ -28,3 +28,6 @@ function args = symvar (s) args = argnames (inline (s)); endfunction + +## This function is tested by the tests for argnames(). +%!assert (1)
--- a/scripts/miscellaneous/tempdir.m +++ b/scripts/miscellaneous/tempdir.m @@ -37,3 +37,19 @@ endif endfunction + + +%!assert (ischar (tempdir ())) + +%!test +%! old_wstate = warning ("query"); +%! warning ("off"); +%! old_tmpdir = getenv ("TMPDIR"); +%! unwind_protect +%! setenv ("TMPDIR", "__MY_TMP_DIR__"); +%! assert (tempdir (), ["__MY_TMP_DIR__" filesep()]); +%! unwind_protect_cleanup +%! setenv ("TMPDIR", old_tmpdir); +%! warning (old_wstate); +%! end_unwind_protect +
--- a/scripts/miscellaneous/tempname.m +++ b/scripts/miscellaneous/tempname.m @@ -29,3 +29,7 @@ filename = tmpnam (varargin{:}); endfunction + + +%% No tests needed for alias. +%!assert (1)
--- a/scripts/miscellaneous/unpack.m +++ b/scripts/miscellaneous/unpack.m @@ -38,12 +38,12 @@ print_usage (); endif - if (! ischar (file) && ! iscellstr (file)) + if (! ischar (file) && ! iscellstr (file)) error ("unpack: invalid input file class, %s", class(file)); endif ## character arrays of more than one string must be treated as cell strings - if (ischar (file) && ! isvector (file)) + if (ischar (file) && ! isvector (file)) file = cellstr (file); endif @@ -222,7 +222,7 @@ ## Parse the output from zip and unzip. ## Skip first line which is Archive header - output(1) = []; + output(1) = []; for i = 1:length (output) files{i} = output{i}(14:length(output{i})); endfor
new file mode 100644 --- /dev/null +++ b/scripts/miscellaneous/usejava.m @@ -0,0 +1,67 @@ +## Copyright (C) 2011 Rik Wehbring +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} usejava (@var{feature}) +## Return true if the specific Sun Java element @var{feature} is available. +## +## Possible features are: +## +## @table @asis +## @item "awt" +## Abstract Window Toolkit for GUIs. +## +## @item "desktop" +## Interactive desktop is running. +## +## @item "jvm" +## Java Virtual Machine. +## +## @item "swing" +## Swing components for lightweight GUIs. +## @end table +## +## This function is provided for compatability with @sc{matlab} scripts which +## may alter their behavior based on the availability of Java. Octave does +## not implement an interface to Java and this function always returns +## @code{false}. +## @end deftypefn + +function retval = usejava (feature) + + if (nargin != 1 || ! ischar (feature)) + print_usage (); + endif + + if (! any (strcmp (feature, {"awt", "desktop", "jvm", "swing"}))) + error ("usejava: unrecognized feature '%s'", feature); + endif + + retval = false; + +endfunction + + +%!assert (usejava ("awt"), false) + +%% Test input validation +%!error usejava () +%!error usejava (1, 2) +%!error usejava (1) +%!error <unrecognized feature> usejava ("abc") +
--- a/scripts/miscellaneous/warning_ids.m +++ b/scripts/miscellaneous/warning_ids.m @@ -284,3 +284,6 @@ function warning_ids () help ("warning_ids"); endfunction + +## Remove from test statistics. No real tests possible +%!assert (1)
--- a/scripts/miscellaneous/what.m +++ b/scripts/miscellaneous/what.m @@ -90,7 +90,7 @@ if (length (f) > 0) printf ("%s %s:\n\n", msg, p); - maxlen = max (cellfun (@length, f)); + maxlen = max (cellfun ("length", f)); ncols = max (1, floor (terminal_size()(2) / (maxlen + 3))); fmt = ""; for i = 1: ncols
--- a/scripts/miscellaneous/xor.m +++ b/scripts/miscellaneous/xor.m @@ -48,7 +48,11 @@ ## Typecast to logicals is necessary for other numeric types. z = logical (x) != logical (y); else - error ("xor: X and Y must be of common size or scalars"); + try + z = bsxfun (@xor, x, y); + catch + error ("xor: X and Y must be of compatible size or scalars"); + end_try_catch endif else print_usage ();
--- a/scripts/optimization/__all_opts__.m +++ b/scripts/optimization/__all_opts__.m @@ -67,3 +67,7 @@ endfunction + +## No test needed for internal helper function. +%!assert (1) +
--- a/scripts/optimization/fminbnd.m +++ b/scripts/optimization/fminbnd.m @@ -49,7 +49,8 @@ ## This is patterned after opt/fmin.f from Netlib, which in turn is taken from ## Richard Brent: Algorithms For Minimization Without Derivatives, Prentice-Hall (1973) -## PKG_ADD: __all_opts__ ("fminbnd"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fminbnd"); function [x, fval, info, output] = fminbnd (fun, xmin, xmax, options = struct ())
--- a/scripts/optimization/fminunc.m +++ b/scripts/optimization/fminunc.m @@ -77,7 +77,8 @@ ## @seealso{fminbnd, optimset} ## @end deftypefn -## PKG_ADD: __all_opts__ ("fminunc"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fminunc"); function [x, fval, info, output, grad, hess] = fminunc (fcn, x0, options = struct ()) @@ -358,17 +359,18 @@ endif endfunction -%!function f = rosenb (x) +%!function f = __rosenb (x) %! n = length (x); %! f = sumsq (1 - x(1:n-1)) + 100 * sumsq (x(2:n) - x(1:n-1).^2); +%!endfunction %!test -%! [x, fval, info, out] = fminunc (@rosenb, [5, -5]); +%! [x, fval, info, out] = fminunc (@__rosenb, [5, -5]); %! tol = 2e-5; %! assert (info > 0); %! assert (x, ones (1, 2), tol); %! assert (fval, 0, tol); %!test -%! [x, fval, info, out] = fminunc (@rosenb, zeros (1, 4)); +%! [x, fval, info, out] = fminunc (@__rosenb, zeros (1, 4)); %! tol = 2e-5; %! assert (info > 0); %! assert (x, ones (1, 4), tol);
--- a/scripts/optimization/fsolve.m +++ b/scripts/optimization/fsolve.m @@ -127,7 +127,8 @@ ## @end example ## @end deftypefn -## PKG_ADD: __all_opts__ ("fsolve"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fsolve"); function [x, fvec, info, output, fjac] = fsolve (fcn, x0, options = struct ()) @@ -459,7 +460,7 @@ endif endfunction -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -467,17 +468,18 @@ %! retval(1) = sin(x) + y**2 + log(z) - 7; %! retval(2) = 3*x + 2**y -z**3 + 1; %! retval(3) = x + y + z - 5; +%!endfunction %!test %! x_opt = [ 0.599054; %! 2.395931; %! 2.005014 ]; %! tol = 1.0e-5; -%! [x, fval, info] = fsolve (@f, [ 0.5; 2.0; 2.5 ]); +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ]); %! assert (info > 0); %! assert (norm (x - x_opt, Inf) < tol); %! assert (norm (fval) < tol); -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -487,15 +489,16 @@ %! retval(2) = 6*x - 4*y + exp (3*z + w) - 11; %! retval(3) = x^4 - 4*y^2 + 6*z - 8*w - 20; %! retval(4) = x^2 + 2*y^3 + z - w - 4; +%!endfunction %!test %! x_opt = [ -0.767297326653401, 0.590671081117440, 1.47190018629642, -1.52719341133957 ]; %! tol = 1.0e-5; -%! [x, fval, info] = fsolve (@f, [-1, 1, 2, -1]); +%! [x, fval, info] = fsolve (@__f, [-1, 1, 2, -1]); %! assert (info > 0); %! assert (norm (x - x_opt, Inf) < tol); %! assert (norm (fval) < tol); -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -504,17 +507,18 @@ %! retval(2) = 3*x + 2**y -z**3 + 1; %! retval(3) = x + y + z - 5; %! retval(4) = x*x + y - z*log(z) - 1.36; +%!endfunction %!test %! x_opt = [ 0.599054; %! 2.395931; %! 2.005014 ]; %! tol = 1.0e-5; -%! [x, fval, info] = fsolve (@f, [ 0.5; 2.0; 2.5 ]); +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ]); %! assert (info > 0); %! assert (norm (x - x_opt, Inf) < tol); %! assert (norm (fval) < tol); -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -522,13 +526,14 @@ %! retval(1) = sin(x) + y**2 + log(z) - 7; %! retval(2) = 3*x + 2**y -z**3 + 1; %! retval(3) = x + y + z - 5; +%!endfunction %!test %! x_opt = [ 0.599054; %! 2.395931; %! 2.005014 ]; %! tol = 1.0e-5; %! opt = optimset ("Updating", "qrp"); -%! [x, fval, info] = fsolve (@f, [ 0.5; 2.0; 2.5 ], opt); +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ], opt); %! assert (info > 0); %! assert (norm (x - x_opt, Inf) < tol); %! assert (norm (fval) < tol); @@ -552,6 +557,7 @@ %! y(1) = (1+i)*x(1)^2 - (1-i)*x(2) - 2; %! y(2) = sqrt (x(1)*x(2)) - (1-2i)*x(3) + (3-4i); %! y(3) = x(1) * x(2) - x(3)^2 + (3+2i); +%!endfunction %!test %! x_opt = [-1+i, 1-i, 2+i];
--- a/scripts/optimization/fzero.m +++ b/scripts/optimization/fzero.m @@ -93,7 +93,8 @@ ## the need for external functions and error handling. The algorithm has ## also been slightly modified. -## PKG_ADD: __all_opts__ ("fzero"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fzero"); function [x, fval, info, output] = fzero (fun, x0, options = struct ())
--- a/scripts/optimization/lsqnonneg.m +++ b/scripts/optimization/lsqnonneg.m @@ -63,7 +63,8 @@ ## @seealso{optimset, pqpnonneg} ## @end deftypefn -## PKG_ADD: __all_opts__ ("lsqnonneg"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("lsqnonneg"); ## This is implemented from Lawson and Hanson's 1973 algorithm on page ## 161 of Solving Least Squares Problems.
--- a/scripts/optimization/optimset.m +++ b/scripts/optimization/optimset.m @@ -90,9 +90,8 @@ printf (" %s\n", opts{:}); puts ("\n"); else - ## Return empty structure. - ## We're incompatible with Matlab at this point. - retval = struct (); + ## Return struct with all options initialized to [] + retval = cell2struct (repmat ({[]}, size (opts)), opts, 2); endif elseif (nargs == 1 && ischar (varargin{1})) ## Return defaults for named function. @@ -141,5 +140,9 @@ endfunction + %!assert (optimget (optimset ('tolx', 1e-2), 'tOLx'), 1e-2) %!assert (isfield (optimset ('tolFun', 1e-3), 'TolFun')) + +%!error (optimset ("%NOT_A_REAL_FUNCTION_NAME%")) +
--- a/scripts/optimization/pqpnonneg.m +++ b/scripts/optimization/pqpnonneg.m @@ -58,7 +58,8 @@ ## @seealso{optimset, lsqnonneg, qp} ## @end deftypefn -## PKG_ADD: __all_opts__ ("pqpnonneg"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("pqpnonneg"); ## This is analogical to the lsqnonneg implementation, which is ## implemented from Lawson and Hanson's 1973 algorithm on page
--- a/scripts/optimization/qp.m +++ b/scripts/optimization/qp.m @@ -108,7 +108,8 @@ ## @end table ## @end deftypefn -## PKG_ADD: __all_opts__ ("qp"); +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("qp"); function [x, obj, INFO, lambda] = qp (x0, H, varargin)
--- a/scripts/optimization/sqp.m +++ b/scripts/optimization/sqp.m @@ -416,7 +416,19 @@ info = INFO.info; - ## Check QP solution and attempt to recover if it has failed. + ## FIXME -- check QP solution and attempt to recover if it has + ## failed. For now, just warn about possible problems. + + id = "Octave:SQP-QP-subproblem"; + switch (info) + case 2 + warning (id, "sqp: QP subproblem is non-convex and unbounded"); + case 3 + warning (id, "sqp: QP subproblem failed to converge in %d iterations", + INFO.solveiter); + case 6 + warning (id, "sqp: QP subproblem is infeasible"); + endswitch ## Choose mu such that p is a descent direction for the chosen ## merit function phi. @@ -724,19 +736,21 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Test Code -%!function r = g (x) +%!function r = __g (x) %! r = [sumsq(x)-10; %! x(2)*x(3)-5*x(4)*x(5); %! x(1)^3+x(2)^3+1 ]; +%!endfunction %! -%!function obj = phi (x) +%!function obj = __phi (x) %! obj = exp(prod(x)) - 0.5*(x(1)^3+x(2)^3+1)^2; +%!endfunction %! %!test %! %! x0 = [-1.8; 1.7; 1.9; -0.8; -0.8]; %! -%! [x, obj, info, iter, nf, lambda] = sqp (x0, @phi, @g, []); +%! [x, obj, info, iter, nf, lambda] = sqp (x0, @__phi, @__g, []); %! %! x_opt = [-1.717143501952599; %! 1.595709610928535;
--- a/scripts/path/matlabroot.m +++ b/scripts/path/matlabroot.m @@ -31,5 +31,5 @@ endfunction +%!assert (matlabroot(), OCTAVE_HOME()) -
--- a/scripts/pkg/pkg.m +++ b/scripts/pkg/pkg.m @@ -20,8 +20,10 @@ ## -*- texinfo -*- ## @deftypefn {Command} {} pkg @var{command} @var{pkg_name} ## @deftypefnx {Command} {} pkg @var{command} @var{option} @var{pkg_name} -## This command interacts with the package manager. Different actions will -## be taken depending on the value of @var{command}. +## Manage packages (groups of add-on functions) for Octave. Different actions +## are available depending on the value of @var{command}. +## +## Available commands: ## ## @table @samp ## @@ -40,34 +42,44 @@ ## ## @table @code ## @item -nodeps -## The package manager will disable the dependency checking. That way it -## is possible to install a package even if it depends on another package -## that's not installed on the system. @strong{Use this option with care.} +## The package manager will disable dependency checking. With this option it +## is possible to install a package even when it depends on another package +## which is not installed on the system. @strong{Use this option with care.} ## ## @item -noauto ## The package manager will not automatically load the installed package -## when starting Octave, even if the package requests that it is. +## when starting Octave. This overrides any setting within the package. ## ## @item -auto ## The package manager will automatically load the installed package when -## starting Octave, even if the package requests that it isn't. +## starting Octave. This overrides any setting within the package. ## ## @item -local -## A local installation is forced, even if the user has system privileges. +## A local installation (package available only to current user) is forced, +## even if the user has system privileges. ## ## @item -global -## A global installation is forced, even if the user doesn't normally have -## system privileges +## A global installation (package available to all users) is forced, even if +## the user doesn't normally have system privileges. ## ## @item -forge ## Install a package directly from the Octave-Forge repository. This ## requires an internet connection and the cURL library. ## ## @item -verbose -## The package manager will print the output of all of the commands that are -## performed. +## The package manager will print the output of all commands as +## they are performed. ## @end table ## +## @item update +## Check installed Octave-Forge pacakages against repository and update any +## outdated items. This requires an internet connection and the cURL library. +## Usage: +## +## @example +## pkg update +## @end example +## ## @item uninstall ## Uninstall named packages. For example, ## @@ -90,47 +102,53 @@ ## ## @noindent ## adds the @code{image} package to the path. It is possible to load all -## installed packages at once with the command +## installed packages at once with the keyword @samp{all}. Usage: ## ## @example ## pkg load all ## @end example ## ## @item unload -## Removes named packages from the path. After unloading a package it is -## no longer possible to use the functions provided by the package. -## This command behaves like the @code{load} command. +## Remove named packages from the path. After unloading a package it is +## no longer possible to use the functions provided by the package. It is +## possible to unload all installed packages at once with the keyword +## @samp{all}. Usage: +## +## @example +## pkg unload all +## @end example ## ## @item list -## Show a list of the currently installed packages. By requesting one or two -## output argument it is possible to get a list of the currently installed -## packages. For example, +## Show the list of currently installed packages. For example, ## ## @example -## installed_packages = pkg list; +## installed_packages = pkg ("list") ## @end example ## ## @noindent ## returns a cell array containing a structure for each installed package. -## The command +## +## If two output arguments are requested @code{pkg} splits the list of +## installed packages into those which were installed by the current user, +## and those which were installed by the system administrator. ## ## @example -## [@var{user_packages}, @var{system_packages}] = pkg list +## [user_packages, system_packages] = pkg ("list") ## @end example ## -## @noindent -## splits the list of installed packages into those who are installed by -## the current user, and those installed by the system administrator. +## The option '-forge' lists packages available at the Octave-Forge repository. +## This requires an internet connection and the cURL library. For example: ## -## The option '-forge' lists packages available at the Octave-Forge repository. -## This requires an internet connection and the cURL library. +## @example +## oct_forge_pkgs = pkg ("list", "-forge") +## @end example ## ## @item describe ## Show a short description of the named installed packages, with the option -## '-verbose' also list functions provided by the package, e.g.: +## '-verbose' also list functions provided by the package. For example, ## ## @example -## pkg describe -verbose all +## pkg describe -verbose all ## @end example ## ## @noindent @@ -140,7 +158,7 @@ ## output rather than printed on screen: ## ## @example -## desc = pkg ("describe", "secs1d", "image") +## desc = pkg ("describe", "secs1d", "image") ## @end example ## ## @noindent @@ -148,7 +166,7 @@ ## error, unless a second output is requested: ## ## @example -## [ desc, flag] = pkg ("describe", "secs1d", "image") +## [desc, flag] = pkg ("describe", "secs1d", "image") ## @end example ## ## @noindent @@ -170,20 +188,20 @@ ## output argument. For example: ## ## @example -## p = pkg prefix +## pfx = pkg ("prefix") ## @end example ## ## The location in which to install the architecture dependent files can be -## independent specified with an addition argument. For example: +## independently specified with an addition argument. For example: ## ## @example ## pkg prefix ~/my_octave_packages ~/my_arch_dep_pkgs ## @end example ## ## @item local_list -## Set the file in which to look for information on the locally +## Set the file in which to look for information on locally ## installed packages. Locally installed packages are those that are -## typically available only to the current user. For example: +## available only to the current user. For example: ## ## @example ## pkg local_list ~/.octave_packages @@ -196,9 +214,9 @@ ## @end example ## ## @item global_list -## Set the file in which to look for, for information on the globally +## Set the file in which to look for information on globally ## installed packages. Globally installed packages are those that are -## typically available to all users. For example: +## available to all users. For example: ## ## @example ## pkg global_list /usr/share/octave/octave_packages @@ -210,21 +228,8 @@ ## pkg global_list ## @end example ## -## @item rebuild -## Rebuilds the package database from the installed directories. This can -## be used in cases where for some reason the package database is corrupted. -## It can also take the @option{-auto} and @option{-noauto} options to allow the -## autoloading state of a package to be changed. For example, -## -## @example -## pkg rebuild -noauto image -## @end example -## -## @noindent -## will remove the autoloading status of the image package. -## ## @item build -## Builds a binary form of a package or packages. The binary file produced +## Build a binary form of a package or packages. The binary file produced ## will itself be an Octave package that can be installed normally with ## @code{pkg}. The form of the command to build a binary package is ## @@ -236,7 +241,21 @@ ## where @code{builddir} is the name of a directory where the temporary ## installation will be produced and the binary packages will be found. ## The options @option{-verbose} and @option{-nodeps} are respected, while -## the other options are ignored. +## all other options are ignored. +## +## @item rebuild +## Rebuild the package database from the installed directories. This can +## be used in cases where the package database has been corrupted. +## It can also take the @option{-auto} and @option{-noauto} options to allow the +## autoloading state of a package to be changed. For example, +## +## @example +## pkg rebuild -noauto image +## @end example +## +## @noindent +## will remove the autoloading status of the image package. +## ## @end table ## @end deftypefn @@ -267,7 +286,8 @@ available_actions = {"list", "install", "uninstall", "load", ... "unload", "prefix", "local_list", ... - "global_list", "rebuild", "build","describe"}; + "global_list", "rebuild", "build", ... + "describe", "update"}; ## Handle input if (length (varargin) == 0 || ! iscellstr (varargin)) print_usage (); @@ -288,6 +308,8 @@ auto = 1; case "-verbose" verbose = true; + ## Send verbose output to pager immediately. Change setting locally. + page_output_immediately (true, "local"); case "-forge" octave_forge = true; case "-local" @@ -349,8 +371,8 @@ unwind_protect if (octave_forge) - [urls, local_files] = cellfun (@get_forge_download, files, "uniformoutput", false); - [files, succ] = cellfun (@urlwrite, urls, local_files, "uniformoutput", false); + [urls, local_files] = cellfun ("get_forge_download", files, "uniformoutput", false); + [files, succ] = cellfun ("urlwrite", urls, local_files, "uniformoutput", false); succ = [succ{:}]; if (! all (succ)) i = find (! succ, 1); @@ -362,7 +384,7 @@ global_list, global_install); unwind_protect_cleanup - cellfun (@unlink, local_files); + cellfun ("unlink", local_files); end_unwind_protect case "uninstall" @@ -492,6 +514,21 @@ error ("you can request at most two outputs when calling 'pkg describe'"); endswitch + case "update" + if (nargout == 0) + installed_pkgs_lst = installed_packages (local_list, global_list); + for i = 1:length (installed_pkgs_lst) + installed_pkg_name = installed_pkgs_lst{i}.name; + installed_pkg_version = installed_pkgs_lst{i}.version; + forge_pkg_version = get_forge_pkg (installed_pkg_name); + if (compare_versions (forge_pkg_version, installed_pkg_version, ">")) + feval (@pkg, "install", "-forge", installed_pkg_name); + endif + endfor + else + error ("no output arguments available"); + endif + otherwise error ("you must specify a valid action for 'pkg'. See 'help pkg' for details"); endswitch @@ -1320,7 +1357,7 @@ flags = cstrcat (flags, " RANLIB=\"", octave_config_info ("RANLIB"), "\""); endif [status, output] = shell (cstrcat ("cd '", src, "'; ", scenv, - "./configure --prefix=\"", + "./configure --prefix=\"", desc.dir, "\"", flags)); if (status != 0) rm_rf (desc.dir); @@ -1383,7 +1420,7 @@ if (isempty (filenames)) idx = []; else - idx = cellfun (@is_architecture_dependent, filenames); + idx = cellfun ("is_architecture_dependent", filenames); endif archdependent = filenames (idx); archindependent = filenames (!idx);
--- a/scripts/plot/__gnuplot_drawnow__.m +++ b/scripts/plot/__gnuplot_drawnow__.m @@ -149,7 +149,7 @@ ## Generate gnuplot title string for plot windows. if (output_to_screen (term) && ~strcmp (term, "dumb")) fig.numbertitle = get (h, "numbertitle"); - fig.name = get (h, "name"); + fig.name = strrep (get (h, "name"), "\"", "\\\""); if (strcmpi (get (h, "numbertitle"), "on")) title_str = sprintf ("Figure %d", h); else @@ -386,3 +386,7 @@ endif endif endfunction + + +## No test needed for internal helper function. +%!assert (1)
--- a/scripts/plot/__go_close_all__.m +++ b/scripts/plot/__go_close_all__.m @@ -26,3 +26,7 @@ function __go_close_all__ () close ("all", "hidden"); endfunction + + +## No test needed for internal helper function. +%!assert (1)
--- a/scripts/plot/__plt_get_axis_arg__.m +++ b/scripts/plot/__plt_get_axis_arg__.m @@ -76,3 +76,7 @@ narg = length (varargin); endfunction + + +## No test needed for internal helper function. +%!assert (1)
--- a/scripts/plot/allchild.m +++ b/scripts/plot/allchild.m @@ -48,3 +48,12 @@ end_unwind_protect endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert(get(allchild(hf),'type'),{'axes'; 'uimenu'; 'uimenu'; 'uimenu'}) +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/ancestor.m +++ b/scripts/plot/ancestor.m @@ -74,3 +74,13 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (ancestor (l, "axes"), gca); +%! assert (ancestor (l, "figure"), hf); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/axes.m +++ b/scripts/plot/axes.m @@ -28,8 +28,7 @@ function h = axes (varargin) if (nargin == 0 || nargin > 1) - ## make default axes object, and make it the current axes for the - ## current figure. + ## Create an axes object. idx = find (strcmpi (varargin(1:2:end), "parent"), 1, "first"); if (! isempty (idx) && length (varargin) >= 2*idx) cf = varargin{2*idx}; @@ -38,16 +37,19 @@ cf = gcf (); endif tmp = __go_axes__ (cf, varargin{:}); - set (ancestor (cf, "figure"), "currentaxes", tmp); + if (__is_handle_visible__ (tmp)) + set (ancestor (cf, "figure"), "currentaxes", tmp); + endif else - ## arg is axes handle, make it the current axes for the current - ## figure. + ## arg is axes handle. tmp = varargin{1}; if (length(tmp) == 1 && ishandle (tmp) && strcmp (get (tmp, "type"), "axes")) - parent = ancestor (tmp, "figure"); - set (0, "currentfigure", parent); - set (parent, "currentaxes", tmp); + if (__is_handle_visible__ (tmp)) + parent = ancestor (tmp, "figure"); + set (0, "currentfigure", parent); + set (parent, "currentaxes", tmp); + endif else error ("axes: expecting argument to be a scalar axes handle"); endif
--- a/scripts/plot/axis.m +++ b/scripts/plot/axis.m @@ -319,20 +319,14 @@ else data = get (kids, strcat (ax, "data")); scale = get (ca, strcat (ax, "scale")); - if (strcmp (scale, "log")) - if (iscell (data)) - for i = 1:length(data) - data{i}(data{i}<=0) = NaN; - endfor - else - data(data<=0) = NaN; - endif + if (strcmp (scale, "log") && any (data > 0)) + data(data<=0) = NaN; endif if (iscell (data)) - data = data (find (! cellfun (@isempty, data))); + data = data (find (! cellfun ("isempty", data))); if (! isempty (data)) - lims_min = min (cellfun (@min, cellfun (@min, data, 'uniformoutput', false)(:))); - lims_max = max (cellfun (@max, cellfun (@max, data, 'uniformoutput', false)(:))); + lims_min = min (cellfun ("min", cellfun ("min", data, 'uniformoutput', false)(:))); + lims_max = max (cellfun ("max", cellfun ("max", data, 'uniformoutput', false)(:))); lims = [lims_min, lims_max]; else lims = [0, 1]; @@ -508,3 +502,48 @@ %! loglog (1:20, "-s") %! axis tight +%!demo +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "zero") +%! box off + +%!demo +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "left") +%! box off + +%!demo +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "right") +%! box off + +%!demo +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "bottom") +%! set (gca, "yaxislocation", "zero") +%! box off + +%!demo +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "top") +%! set (gca, "yaxislocation", "zero") +%! box off +
--- a/scripts/plot/cla.m +++ b/scripts/plot/cla.m @@ -90,9 +90,8 @@ endfunction %!test -%! hf = figure (1, "visible", "off"); +%! hf = figure ("visible", "off"); %! unwind_protect -%! clf %! plot (1:10) %! cla () %! kids = get (gca, "children");
--- a/scripts/plot/clf.m +++ b/scripts/plot/clf.m @@ -21,17 +21,19 @@ ## @deftypefnx {Function File} {} clf ("reset") ## @deftypefnx {Function File} {} clf (@var{hfig}) ## @deftypefnx {Function File} {} clf (@var{hfig}, "reset") +## @deftypefnx {Function File} {@var{h} =} clf (@dots{}) ## Clear the current figure window. @code{clf} operates by deleting child ## graphics objects with visible handles (@code{handlevisibility} = on). ## If @var{hfig} is specified operate on it instead of the current figure. ## If the optional argument @code{"reset"} is specified, all objects including -## those with hidden handles are deleted. +## those with hidden handles are deleted. If an output value is +## requested, return the handle of the figure window that was cleared. ## @seealso{cla, close, delete} ## @end deftypefn ## Author: jwe -function clf (varargin) +function retval = clf (varargin) if (nargin > 2) print_usage (); @@ -74,4 +76,26 @@ ## Delete the children. delete (hc); + if (nargout > 0) + retval = hfig; + endif + endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (!isempty (get (gcf, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! clf; +%! assert (isempty (get (gcf, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/close.m +++ b/scripts/plot/close.m @@ -79,3 +79,15 @@ endwhile endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! close (hf); +%! objs = findobj ("type", "figure"); +%! assert (isempty (intersect (objs, hf))); +%! unwind_protect_cleanup +%! if (isfigure (hf)) +%! close (hf); +%! endif +%! end_unwind_protect
--- a/scripts/plot/figure.m +++ b/scripts/plot/figure.m @@ -41,7 +41,7 @@ f = tmp; varargin(1) = []; nargs--; - elseif (isnumeric (tmp) && tmp > 0 && round (tmp) == tmp) + elseif (isnumeric (tmp) && tmp > 0 && tmp == fix (tmp)) f = tmp; init_new_figure = true; varargin(1) = []; @@ -73,10 +73,21 @@ endif cf = get (0, "currentfigure"); - __add_default_menu__ (cf); + if (strcmp (get (cf, "__graphics_toolkit__"), "fltk")) + __add_default_menu__ (cf); + endif if (nargout > 0) h = f; endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (gcf, hf); +%! assert (isfigure (hf)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/findall.m +++ b/scripts/plot/findall.m @@ -42,3 +42,13 @@ end_unwind_protect endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = findall (hf); +%! all_handles = {"uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "uimenu"; "figure"}; +%! assert (get (h, 'type'), all_handles) +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/findobj.m +++ b/scripts/plot/findobj.m @@ -242,3 +242,16 @@ h = h (keepers != 0); h = reshape (h, [numel(h), 1]); endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! obj = findobj (hf, "type", "line"); +%! assert (l, obj); +%! assert (gca, findobj (hf, "type", "axes")); +%! assert (hf, findobj (hf, "type", "figure")); +%! assert (isempty (findobj (hf, "type", "xyzxyz"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/gca.m +++ b/scripts/plot/gca.m @@ -49,3 +49,12 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! ax = axes; +%! unwind_protect +%! assert (gca, ax); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/gcbf.m +++ b/scripts/plot/gcbf.m @@ -31,3 +31,6 @@ [dummy, fig] = gcbo (); endfunction + +%!test +%! assert (isempty (gcbf ));
--- a/scripts/plot/gcbo.m +++ b/scripts/plot/gcbo.m @@ -41,3 +41,6 @@ endif endfunction + +%!test +%! assert (isempty (gcbo ));
--- a/scripts/plot/gcf.m +++ b/scripts/plot/gcf.m @@ -53,3 +53,11 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (gcf, hf); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/ginput.m +++ b/scripts/plot/ginput.m @@ -21,7 +21,7 @@ ## Return which mouse buttons were pressed and keys were hit on the current ## figure. If @var{n} is defined, then wait for @var{n} mouse clicks ## before returning. If @var{n} is not defined, then @code{ginput} will -## loop until the return key is pressed. +## loop until the return key @key{RET} is pressed. ## @end deftypefn function varargout = ginput (n) @@ -42,3 +42,7 @@ endif endfunction + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/gtext.m +++ b/scripts/plot/gtext.m @@ -29,25 +29,21 @@ function gtext (s, varargin) - if (nargin > 0) - if (iscellstr (s)) - if (isempty (s)) - s = ""; - else - s = sprintf ("%s\n", s{:}); - endif - endif - if (ischar (s)) - if (! isempty (s)) - [x, y] = ginput (1); - text (x, y, s, varargin{:}); - endif - else - error ("gtext: expecting a string or cell array of strings"); - endif - else + if (nargin < 1) print_usage (); endif + if (! (ischar (s) || iscellstr (s))) + error ("gtext: S must be a string or cell array of strings"); + endif + + if (! isempty (s)) + [x, y] = ginput (1); + text (x, y, s, varargin{:}); + endif + endfunction +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
new file mode 100644 --- /dev/null +++ b/scripts/plot/guidata.m @@ -0,0 +1,52 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{data} =} guidata (@var{handle}) +## @deftypefnx {Function File} guidata (@var{handle}, @var{data}) +## @end deftypefn + +## Author: goffioul + +function varargout = guidata (varargin) + + if (nargin == 1 || nargin == 2) + h = varargin{1}; + if (ishandle (h)) + h = ancestor (h, "figure"); + if (! isempty (h)) + if (nargin == 1) + varargout{1} = get (h, "__guidata__"); + else + data = varargin{2}; + set (h, "__guidata__", data); + if (nargout == 1) + varargout{1} = data; + endif + endif + else + error ("no ancestor figure found"); + endif + else + error ("invalid object handle"); + endif + else + print_usage (); + endif + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/guihandles.m @@ -0,0 +1,70 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hdata} =} guihandles (@var{handle}) +## @deftypefnx {Function File} {@var{hdata} =} guihandles +## @end deftypefn + +## Author: goffioul + +function hdata = guihandles (varargin) + + hdata = []; + + if (nargin == 0 || nargin == 1) + if (nargin == 1) + h = varargin{1}; + if (ishandle (h)) + h = ancestor (h, "figure"); + if (isempty (h)) + error ("no ancestor figure found"); + endif + else + error ("invalid object handle"); + endif + else + h = gcf (); + endif + hdata = __make_guihandles_struct__ (h, hdata); + else + print_usage (); + endif + +endfunction + +function hdata = __make_guihandles_struct__ (h, hdata) + + tag = get (h, "tag"); + if (! isempty (tag)) + if (isfield (hdata, tag)) + hdata.(tag) = [hdata.(tag), h]; + else + try + hdata.(tag) = h; + catch + end_try_catch + endif + endif + + kids = allchild (h); + for i = 1 : length (kids) + hdata = __make_guihandles_struct__ (kids(i), hdata); + endfor + +endfunction
--- a/scripts/plot/hggroup.m +++ b/scripts/plot/hggroup.m @@ -41,3 +41,13 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = hggroup; +%! assert (findobj (hf, "type", "hggroup"), h); +%! assert (get (h, "type"), "hggroup"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/hold.m +++ b/scripts/plot/hold.m @@ -139,3 +139,35 @@ %! colorbar ("SouthOutside"); %! title ("Test script for some plot functions"); +##hold on +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0 1]); +%! assert (!ishold); +%! hold on; +%! assert (ishold); +%! p1 = fill ([0 1 1], [0 0 1],"black"); +%! p2 = fill ([0 1 0], [0 1 1], "red"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 3); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +##hold off +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0 1]); +%! assert (!ishold); +%! hold on; +%! assert (ishold); +%! p1 = fill ([0 1 1], [0 0 1],"black"); +%! hold off +%! p2 = fill ([0 1 0], [0 1 1], "red"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 1); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/isfigure.m +++ b/scripts/plot/isfigure.m @@ -34,3 +34,12 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (isfigure (hf)); +%! assert (!isfigure (-hf)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/ishghandle.m +++ b/scripts/plot/ishghandle.m @@ -26,3 +26,34 @@ ## no simulink equivalent. retval = ishandle (h); endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (ishghandle (hf)); +%! assert (!ishghandle (-hf)); +%! l = line; +%! ax = gca(); +%! assert (ishghandle (ax)); +%! assert (!ishghandle (-ax)); +%! assert (ishghandle (l)); +%! assert (!ishghandle (-l)); +%! p = patch; +%! assert (ishghandle (p)); +%! assert (!ishghandle (-p)); +%! s = surface; +%! assert (ishghandle (s)); +%! assert (!ishghandle (-s)); +%! t = text; +%! assert (ishghandle (t)); +%! assert (!ishghandle (-t)); +%! i = image; +%! assert (ishghandle (i)); +%! assert (!ishghandle (-i)); +%! hg = hggroup; +%! assert (ishghandle (hg)); +%! assert (!ishghandle (-hg)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/ishold.m +++ b/scripts/plot/ishold.m @@ -30,16 +30,12 @@ function retval = ishold (h) if (nargin == 0) - ax = gca (); fig = gcf (); + ax = get (fig, "currentaxes"); elseif (nargin == 1) if (ishandle (h)) if (isfigure (h)) ax = get (h, "currentaxes"); - if (isempty (ax)) - ax = __go_axes__ (h); - set (h, "currentaxes", ax); - endif fig = h; elseif (strcmpi (get (h, "type"), "axes")) ax = h; @@ -55,6 +51,29 @@ endif retval = (strcmpi (get (fig, "nextplot"), "add") - && strcmpi (get (ax, "nextplot"), "add")); + && ! isempty (ax) && strcmpi (get (ax, "nextplot"), "add")); endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (!ishold); +%! assert (isempty (get (hf, "currentaxes"))); +%! assert (get (hf, "NextPlot"), "add"); +%! l = plot ([0 1]); +%! assert (!ishold); +%! assert (!ishold (gca)); +%! assert (get (gca, "NextPlot"), "replace"); +%! assert (get (hf, "NextPlot"), "add"); +%! hold; +%! assert (ishold); +%! assert (ishold (gca)); +%! assert (get (gca, "NextPlot"), "add"); +%! assert (get (hf, "NextPlot"), "add"); +%! p = fill ([0 1 1], [0 0 1],"black"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 2); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/isonormals.m +++ b/scripts/plot/isonormals.m @@ -46,47 +46,49 @@ ## ## For example: ## -## @example +## @c Set example in small font to prevent overfull line +## @smallexample ## function [] = isofinish (p) -## set (gca, "PlotBoxAspectRatioMode","manual","PlotBoxAspectRatio",[1 1 1]); -## set (p, "VertexNormals", -get(p,"VertexNormals")); ## Revert normals +## set (gca, "PlotBoxAspectRatioMode", "manual", ... +## "PlotBoxAspectRatio",[1 1 1]); +## set (p, "VertexNormals", -get(p,"VertexNormals")); # Revert normals ## set (p, "FaceColor", "interp"); ## ## set (p, "FaceLighting", "phong"); -## ## light ("Position", [1 1 5]); ## Available with JHandles +## ## light ("Position", [1 1 5]); # Available with JHandles ## endfunction ## -## N = 15; ## Increase number of vertices in each direction -## iso = .4; ## Change isovalue to .1 to display a sphere +## N = 15; # Increase number of vertices in each direction +## iso = .4; # Change isovalue to .1 to display a sphere ## lin = linspace (0, 2, N); ## [x, y, z] = meshgrid (lin, lin, lin); ## c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); -## figure (); ## Open another figure window +## figure (); # Open another figure window ## ## subplot (2, 2, 1); view (-38, 20); ## [f, v, cdat] = isosurface (x, y, z, c, iso, y); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, \ -## "FaceColor", "interp", "EdgeColor", "none"); +## "FaceColor", "interp", "EdgeColor", "none"); ## isofinish (p); ## Call user function isofinish ## ## subplot (2, 2, 2); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, \ -## "FaceColor", "interp", "EdgeColor", "none"); -## isonormals (x, y, z, c, p); ## Directly modify patch +## "FaceColor", "interp", "EdgeColor", "none"); +## isonormals (x, y, z, c, p); # Directly modify patch ## isofinish (p); ## ## subplot (2, 2, 3); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, \ -## "FaceColor", "interp", "EdgeColor", "none"); -## n = isonormals (x, y, z, c, v); ## Compute normals of isosurface -## set (p, "VertexNormals", n); ## Manually set vertex normals +## "FaceColor", "interp", "EdgeColor", "none"); +## n = isonormals (x, y, z, c, v); # Compute normals of isosurface +## set (p, "VertexNormals", n); # Manually set vertex normals ## isofinish (p); ## ## subplot (2, 2, 4); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, \ -## "FaceColor", "interp", "EdgeColor", "none"); -## isonormals (x, y, z, c, v, "negate"); ## Use reverse directly +## "FaceColor", "interp", "EdgeColor", "none"); +## isonormals (x, y, z, c, v, "negate"); # Use reverse directly ## isofinish (p); -## @end example +## @end smallexample ## ## @seealso{isosurface, isocolors} ## @end deftypefn
--- a/scripts/plot/isosurface.m +++ b/scripts/plot/isosurface.m @@ -71,24 +71,27 @@ ## Another example for an isosurface geometry with different additional ## coloring ## -## @example -## N = 15; ## Increase number of vertices in each direction -## iso = .4; ## Change isovalue to .1 to display a sphere +## @c Set example in small font to prevent overfull line +## @smallexample +## N = 15; # Increase number of vertices in each direction +## iso = .4; # Change isovalue to .1 to display a sphere ## lin = linspace (0, 2, N); ## [x, y, z] = meshgrid (lin, lin, lin); ## c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); -## figure (); ## Open another figure window +## figure (); # Open another figure window ## ## subplot (2, 2, 1); view (-38, 20); ## [f, v] = isosurface (x, y, z, c, iso); ## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "none"); -## set (gca, "PlotBoxAspectRatioMode","manual", "PlotBoxAspectRatio", [1 1 1]); +## set (gca, "PlotBoxAspectRatioMode","manual", ... +## "PlotBoxAspectRatio", [1 1 1]); ## # set (p, "FaceColor", "green", "FaceLighting", "phong"); -## # light ("Position", [1 1 5]); ## Available with the JHandles package +## # light ("Position", [1 1 5]); # Available with the JHandles package ## ## subplot (2, 2, 2); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "blue"); -## set (gca, "PlotBoxAspectRatioMode","manual", "PlotBoxAspectRatio", [1 1 1]); +## set (gca, "PlotBoxAspectRatioMode","manual", ... +## "PlotBoxAspectRatio", [1 1 1]); ## # set (p, "FaceColor", "none", "FaceLighting", "phong"); ## # light ("Position", [1 1 5]); ## @@ -96,17 +99,19 @@ ## [f, v, c] = isosurface (x, y, z, c, iso, y); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", c, \ ## "FaceColor", "interp", "EdgeColor", "none"); -## set (gca, "PlotBoxAspectRatioMode","manual", "PlotBoxAspectRatio", [1 1 1]); +## set (gca, "PlotBoxAspectRatioMode","manual", ... +## "PlotBoxAspectRatio", [1 1 1]); ## # set (p, "FaceLighting", "phong"); ## # light ("Position", [1 1 5]); ## ## subplot (2, 2, 4); view (-38, 20); ## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", c, \ ## "FaceColor", "interp", "EdgeColor", "blue"); -## set (gca, "PlotBoxAspectRatioMode","manual", "PlotBoxAspectRatio", [1 1 1]); +## set (gca, "PlotBoxAspectRatioMode","manual", ... +## "PlotBoxAspectRatio", [1 1 1]); ## # set (p, "FaceLighting", "phong"); ## # light ("Position", [1 1 5]); -## @end example +## @end smallexample ## ## @seealso{isonormals, isocolors} ## @end deftypefn
--- a/scripts/plot/isprop.m +++ b/scripts/plot/isprop.m @@ -30,21 +30,26 @@ print_usage (); endif - if (! ishandle (h)) + if (! all (ishandle (h))) error ("isprop: first input argument must be a handle"); elseif (! ischar (prop)) error ("isprop: second input argument must be string"); endif - res = true; - try - v = get (h, prop); - catch - res = false; - end_try_catch + res = false (size (h)); + for n = 1:numel(res) + res(n) = true; + try + v = get (h(n), prop); + catch + res(n) = false; + end_try_catch + endfor endfunction %!assert (isprop (0, "foobar"), false) %!assert (isprop (0, "screenpixelsperinch"), true) +%!assert (isprop (zeros (2, 3), "visible"), true (2, 3)) +
--- a/scripts/plot/legend.m +++ b/scripts/plot/legend.m @@ -119,13 +119,20 @@ ca = gca (); endif - if (strcmp (get (ca, "tag"), "plotyy")) - plty = get(ca, "userdata"); - if (isscalar (plty)) + if (ishandle (ca) && isprop (ca, "__plotyy_axes__")) + plty = get (ca, "__plotyy_axes__"); + if (isscalar (plty) && ishandle (plty)) ca = [ca, plty]; - else + elseif (iscell (plty)) ca = [ca, plty{:}]; + elseif (all (ishandle (plty))) + ca = [ca, plty(:).']; + else + error ("legend.m: This should not happen. File a bug report.") endif + ## Remove duplicates while preserving order + [~, n] = unique (ca); + ca = ca (sort (n)); endif if (nargin > 0 && all (ishandle (varargin{1}))) @@ -151,7 +158,7 @@ if (nargs > 0) pos = varargin{nargs}; - if (isnumeric (pos) && isscalar (pos) && round (pos) == pos) + if (isnumeric (pos) && isscalar (pos) && pos == fix (pos)) if (pos >= -1 && pos <= 4) position = [{"northeastoutside", "best", "northeast", "northwest", "southwest", "southeast"}] {pos + 2}; @@ -288,7 +295,7 @@ if (! isempty (hlegend)) set (hlegend, "box", "off", "visible", "off"); endif - elseif (nargs == 0 && !(strcmp (position, "default") && + elseif (nargs == 0 && !(strcmp (position, "default") && strcmp (orientation, "default"))) if (! isempty (hlegend)) hax = getfield (get (hlegend, "userdata"), "handle"); @@ -298,14 +305,14 @@ h = legend (hax, hplots, text_strings, "orientation", orientation); elseif (strcmp (orientation, "default")) if (outside) - h = legend (hax, hplots, text_strings, "location", + h = legend (hax, hplots, text_strings, "location", strcat (position, "outside")); else h = legend (hax, hplots, text_strings, "location", position); endif else if (outside) - h = legend (hax, hplots, text_strings, "location", + h = legend (hax, hplots, text_strings, "location", strcat (position, "outside"), "orientation", orientation); else h = legend (hax, hplots, text_strings, "location", position,
--- a/scripts/plot/line.m +++ b/scripts/plot/line.m @@ -42,3 +42,18 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = line; +%! assert (findobj (hf, "type", "line"), h); +%! assert (get (h, "xdata"), [0 1], eps); +%! assert (get (h, "ydata"), [0 1], eps); +%! assert (get (h, "type"), "line"); +%! assert (get (h, "color"), get (0, "defaultlinecolor")); +%! assert (get (h, "linestyle"), get (0, "defaultlinelinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultlinelinewidth"), eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/loglog.m +++ b/scripts/plot/loglog.m @@ -60,3 +60,48 @@ endfunction +%!demo +%! clf (); +%! t = 1:0.01:10; +%! x = sort ((t .* (1 + rand (size (t)))) .^ 2); +%! y = ((t .* (1 + rand (size (t)))) .^ 2); +%! loglog (x, y); + +%!demo +%! clf (); +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1) +%! loglog (a, b) +%! xlabel ('loglog (a, b)') +%! +%! subplot (1, 2, 2) +%! loglog (a, abs (b)) +%! set (gca, 'ydir', 'reverse') +%! xlabel ('loglog (a, abs (b))') + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! loglog (a, b) +%! assert (get (gca, "yscale"), "log"); +%! assert (get (gca, "xscale"), "log"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! loglog (a, b) +%! axis tight +%! assert (all (get (gca, "ytick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect +
--- a/scripts/plot/meshgrid.m +++ b/scripts/plot/meshgrid.m @@ -70,3 +70,34 @@ endif endfunction + +%!test +%! x = 1:2; +%! y = 1:3; +%! z = 1:4; +%! [XX, YY, ZZ] = meshgrid (x, y, z); +%! assert (size_equal (XX, YY, ZZ)); +%! assert (ndims (XX), 3); +%! assert (size (XX), [3, 2, 4]); +%! assert (XX(1) * YY(1) * ZZ(1), x(1) * y(1) * z(1)); +%! assert (XX(end) * YY(end) * ZZ(end), x(end) * y(end) * z(end)); + +%!test +%! x = 1:2; +%! y = 1:3; +%! [XX, YY] = meshgrid (x, y); +%! assert (size_equal (XX, YY)); +%! assert (ndims (XX), 2); +%! assert (size (XX), [3, 2]); +%! assert (XX(1) * YY(1), x(1) * y(1)); +%! assert (XX(end) * YY(end), x(end) * y(end)); + +%!test +%! x = 1:3; +%! [XX1, YY1] = meshgrid (x, x); +%! [XX2, YY2] = meshgrid (x); +%! assert (size_equal (XX1, XX2, YY1, YY2)); +%! assert (ndims (XX1), 2); +%! assert (size (XX1), [3, 3]); +%! assert (XX1, XX2); +%! assert (YY1, YY2); \ No newline at end of file
--- a/scripts/plot/module.mk +++ b/scripts/plot/module.mk @@ -19,39 +19,45 @@ plot/private/__errcomm__.m \ plot/private/__errplot__.m \ plot/private/__ezplot__.m \ + plot/private/__file_filter__.m \ plot/private/__fltk_file_filter__.m \ - plot/private/__ghostscript__.m \ + plot/private/__fltk_ginput__.m \ + plot/private/__fltk_print__.m \ plot/private/__getlegenddata__.m \ + plot/private/__ghostscript__.m \ + plot/private/__gnuplot_get_var__.m \ + plot/private/__gnuplot_ginput__.m \ + plot/private/__gnuplot_has_feature__.m \ plot/private/__gnuplot_has_terminal__.m\ + plot/private/__gnuplot_open_stream__.m \ + plot/private/__gnuplot_print__.m \ + plot/private/__gnuplot_version__.m \ + plot/private/__go_draw_axes__.m \ + plot/private/__go_draw_figure__.m \ plot/private/__interp_cube__.m \ + plot/private/__is_function__.m \ plot/private/__line__.m \ + plot/private/__marching_cube__.m \ + plot/private/__next_line_color__.m \ + plot/private/__next_line_style__.m \ plot/private/__patch__.m \ plot/private/__pie__.m \ plot/private/__plt__.m \ plot/private/__pltopt__.m \ + plot/private/__print_parse_opts__.m \ plot/private/__quiver__.m \ plot/private/__scatter__.m \ plot/private/__stem__.m \ - plot/private/__tight_eps_bbox__.m + plot/private/__tight_eps_bbox__.m \ + plot/private/__uigetdir_fltk__.m \ + plot/private/__uigetfile_fltk__.m \ + plot/private/__uiputfile_fltk__.m \ + plot/private/__uiobject_split_args__.m plot_FCN_FILES = \ - plot/__fltk_ginput__.m \ - plot/__fltk_print__.m \ plot/__gnuplot_drawnow__.m \ - plot/__gnuplot_get_var__.m \ - plot/__gnuplot_ginput__.m \ - plot/__gnuplot_has_feature__.m \ - plot/__gnuplot_open_stream__.m \ - plot/__gnuplot_print__.m \ - plot/__gnuplot_version__.m \ plot/__go_close_all__.m \ - plot/__go_draw_axes__.m \ - plot/__go_draw_figure__.m \ - plot/__marching_cube__.m \ - plot/__next_line_color__.m \ - plot/__next_line_style__.m \ plot/__plt_get_axis_arg__.m \ - plot/__print_parse_opts__.m \ plot/allchild.m \ plot/ancestor.m \ plot/area.m \ @@ -103,6 +109,8 @@ plot/graphics_toolkit.m \ plot/grid.m \ plot/gtext.m \ + plot/guidata.m \ + plot/guihandles.m \ plot/hggroup.m \ plot/hidden.m \ plot/hist.m \ @@ -171,10 +179,19 @@ plot/surfnorm.m \ plot/text.m \ plot/title.m \ + plot/trimesh.m \ + plot/triplot.m \ + plot/trisurf.m \ + plot/uicontextmenu.m \ + plot/uicontrol.m \ plot/uigetdir.m \ plot/uigetfile.m \ plot/uimenu.m \ + plot/uipanel.m \ + plot/uipushtool.m \ plot/uiputfile.m \ + plot/uitoggletool.m \ + plot/uitoolbar.m \ plot/view.m \ plot/waitforbuttonpress.m \ plot/whitebg.m \
--- a/scripts/plot/ndgrid.m +++ b/scripts/plot/ndgrid.m @@ -69,3 +69,29 @@ endfor endfunction + +%!test +%! x = 1:2; +%! y = 1:3; +%! z = 1:4; +%! [XX, YY, ZZ] = ndgrid (x, y, z); +%! assert (size_equal (XX, YY, ZZ)); +%! assert (ndims (XX), 3); +%! assert (size (XX), [2, 3, 4]); +%! assert (XX(1) * YY(1) * ZZ(1), x(1) * y(1) * z(1)); +%! assert (XX(end) * YY(end) * ZZ(end), x(end) * y(end) * z(end)); + +%!test +%! x = 1:2; +%! y = 1:3; +%! [XX1, YY1] = meshgrid (x, y); +%! [XX2, YY2] = ndgrid (x, y); +%! assert (size_equal (XX1, YY1)); +%! assert (size_equal (XX2, YY2)); +%! assert (ndims (XX1), 2); +%! assert (size (XX1), [3, 2]); +%! assert (size (XX2), [2, 3]); +%! assert (XX2(1) * YY2(1), x(1) * y(1)); +%! assert (XX2(end) * YY2(end), x(end) * y(end)); +%! assert (XX1, XX2.'); +%! assert (YY1, YY2.');
--- a/scripts/plot/newplot.m +++ b/scripts/plot/newplot.m @@ -64,3 +64,13 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0, 1]); +%! newplot; +%! assert (isempty (get (gca, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/pareto.m +++ b/scripts/plot/pareto.m @@ -66,11 +66,11 @@ if (ischar (y)) y = cellstr (y); else - y = cellfun (@num2str, num2cell (y), "uniformoutput", false); + y = cellfun ("num2str", num2cell (y), "uniformoutput", false); endif endif else - y = cellfun (@int2str, num2cell (1 : numel(x)), + y = cellfun ("int2str", num2cell (1 : numel(x)), "uniformoutput", false); endif
--- a/scripts/plot/patch.m +++ b/scripts/plot/patch.m @@ -43,17 +43,11 @@ [h, varargin] = __plt_get_axis_arg__ ("patch", varargin{:}); - oldh = gca (); + [tmp, failed] = __patch__ (h, varargin{:}); - unwind_protect - axes (h); - [tmp, failed] = __patch__ (h, varargin{:}); - if (failed) - print_usage (); - endif - unwind_protect_cleanup - axes (oldh); - end_unwind_protect + if (failed) + print_usage (); + endif if (nargout > 0) retval = tmp; @@ -152,3 +146,85 @@ %! 'FaceVertexCData', jet(5), 'FaceColor', 'interp') %! view (-37.5, 30) +%!demo +%! clf +%! colormap (jet) +%! x = [0 1 1 0]; +%! y = [0 0 1 1]; +%! subplot (2, 1, 1) +%! title ("Blue, Light-Green, and Red Horizontal Bars") +%! patch (x, y + 0, 1); +%! patch (x, y + 1, 2); +%! patch (x, y + 2, 3); +%! subplot (2, 1, 2) +%! title ("Blue, Light-Green, and Red Vertical Bars") +%! patch (x + 0, y, 1 * ones (size (x))); +%! patch (x + 1, y, 2 * ones (size (x))); +%! patch (x + 2, y, 3 * ones (size (x))); + +%!demo +%! clf +%! colormap (jet) +%! x = [0 1 1 0]; +%! y = [0 0 1 1]; +%! subplot (2, 1, 1) +%! title ("Blue horizontal bars: Dark to Light") +%! patch (x, y + 0, 1, "cdatamapping", "direct"); +%! patch (x, y + 1, 9, "cdatamapping", "direct"); +%! patch (x, y + 2, 17, "cdatamapping", "direct"); +%! subplot (2, 1, 2) +%! title ("Blue vertical bars: Dark to Light") +%! patch (x + 0, y, 1 * ones (size (x)), "cdatamapping", "direct"); +%! patch (x + 1, y, 9 * ones (size (x)), "cdatamapping", "direct"); +%! patch (x + 2, y, 17 * ones (size (x)), "cdatamapping", "direct"); + +%!demo +%! clf; +%! colormap (jet); +%! x = [ 0 0; 1 1; 1 0 ]; +%! y = [ 0 0; 0 1; 1 1 ]; +%! p = patch (x, y, "facecolor", "b"); +%! title ("Two blue triangles") +%! set (p, "cdatamapping", "direct", "facecolor", "flat", "cdata", [1 32]) +%! title ("Direct mapping of colors: Light-Green UL and Blue LR triangles") + +%!demo +%! clf; +%! colormap (jet); +%! x = [ 0 0; 1 1; 1 0 ]; +%! y = [ 0 0; 0 1; 1 1 ]; +%! p = patch (x, y, [1 32]); +%! title ("Autoscaling of colors: Red UL and Blue LR triangles") + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = patch; +%! assert (findobj (hf, "type", "patch"), h); +%! assert (get (h, "xdata"), [0; 1; 0], eps); +%! assert (get (h, "ydata"), [1; 1; 0], eps); +%! assert (isempty(get (h, "zdata"))); +%! assert (isempty(get (h, "cdata"))); +%! assert (get (h, "faces"), [1, 2, 3], eps); +%! assert (get (h, "vertices"), [0 1; 1 1; 0 0], eps); +%! assert (get (h, "type"), "patch"); +%! assert (get (h, "facecolor"), [0 0 0]); +%! assert (get (h, "linestyle"), get (0, "defaultpatchlinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultpatchlinewidth"), eps); +%! assert (get (h, "marker"), get (0, "defaultpatchmarker")); +%! assert (get (h, "markersize"), get (0, "defaultpatchmarkersize")); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! c = 0.9; +%! unwind_protect +%! h = patch ([0 1 0], [0 1 1], c); +%! assert (get (gca, "clim"), [c - 1, c + 1]); +%! h = patch ([0 1 0], [0 1 1], 2 * c); +%! assert (get (gca, "clim"), [c, 2 * c]); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/pcolor.m +++ b/scripts/plot/pcolor.m @@ -80,3 +80,14 @@ endif endfunction + +%!demo +%! clf +%! [~,~,Z]=peaks; +%! pcolor(Z); + +%!demo +%! [X,Y,Z]=sombrero; +%! [Fx,Fy] = gradient(Z); +%! pcolor(X,Y,Fx+Fy); +%! shading interp;
--- a/scripts/plot/plotyy.m +++ b/scripts/plot/plotyy.m @@ -79,7 +79,7 @@ ca = get (f, "currentaxes"); if (isempty (ca)) ax = []; - elseif (strcmp (get (ca, "tag"), "plotyy")); + elseif (ishandle (ca) && isprop (ca, "__plotyy_axes__")) ax = get (ca, "__plotyy_axes__"); else ax = ca; @@ -115,8 +115,6 @@ endif end_unwind_protect - set (ax, "activepositionproperty", "position"); - if (nargout > 0) Ax = ax; H1 = h1; @@ -164,10 +162,24 @@ colors = get (ax(1), "colororder"); set (ax(2), "colororder", [colors(2:end,:); colors(1,:)]); + if (strcmp (get (ax(1), "autopos_tag"), "subplot")) + set (ax(2), "autopos_tag", "subplot"); + else + set (ax, "activepositionproperty", "position"); + endif + h2 = feval (fun2, x2, y2); set (ax(2), "yaxislocation", "right"); set (ax(2), "ycolor", getcolor (h2(1))); - set (ax(2), "position", get (ax(1), "position")); + + + if (strcmp (get(ax(1), "activepositionproperty"), "position")) + set (ax(2), "position", get (ax(1), "position")); + else + set (ax(2), "outerposition", get (ax(1), "outerposition")); + set (ax(2), "looseinset", get (ax(1), "looseinset")); + endif + set (ax(2), "xlim", xlim); set (ax(2), "color", "none"); set (ax(2), "box", "off"); @@ -186,6 +198,10 @@ addlistener (ax(1), "position", {@update_position, ax(2)}); addlistener (ax(2), "position", {@update_position, ax(1)}); + addlistener (ax(1), "outerposition", {@update_position, ax(2)}); + addlistener (ax(2), "outerposition", {@update_position, ax(1)}); + addlistener (ax(1), "looseinset", {@update_position, ax(2)}); + addlistener (ax(2), "looseinset", {@update_position, ax(1)}); addlistener (ax(1), "view", {@update_position, ax(2)}); addlistener (ax(2), "view", {@update_position, ax(1)}); addlistener (ax(1), "plotboxaspectratio", {@update_position, ax(2)}); @@ -193,25 +209,21 @@ addlistener (ax(1), "plotboxaspectratiomode", {@update_position, ax(2)}); addlistener (ax(2), "plotboxaspectratiomode", {@update_position, ax(1)}); - ## Tag the plotyy axes, so we can use that information - ## not to mirror the y axis tick marks - set (ax, "tag", "plotyy"); - - ## Cross-reference one axis to the other in the userdata - set (ax(1), "userdata", ax(2)); - set (ax(2), "userdata", ax(1)); - ## Store the axes handles for the sister axes. - try + if (ishandle (ax(1)) && ! isprop (ax(1), "__plotyy_axes__")) addproperty ("__plotyy_axes__", ax(1), "data", ax); - catch + elseif (ishandle (ax(1))) set (ax(1), "__plotyy_axes__", ax); - end_try_catch - try + else + error ("plotyy.m: This shouldn't happen. File a bug report.") + endif + if (ishandle (ax(2)) && ! isprop (ax(2), "__plotyy_axes__")) addproperty ("__plotyy_axes__", ax(2), "data", ax); - catch + elseif (ishandle (ax(2))) set (ax(2), "__plotyy_axes__", ax); - end_try_catch + else + error ("plotyy.m: This shouldn't happen. File a bug report.") + endif endfunction %!demo @@ -268,17 +280,27 @@ if (! recursion) unwind_protect recursion = true; - position = get (h, "position"); view = get (h, "view"); - plotboxaspectratio = get (h, "plotboxaspectratio"); - plotboxaspectratiomode = get (h, "plotboxaspectratiomode"); - oldposition = get (ax2, "position"); oldview = get (ax2, "view"); + plotboxaspectratio = get (h, "plotboxaspectratio"); oldplotboxaspectratio = get (ax2, "plotboxaspectratio"); + plotboxaspectratiomode = get (h, "plotboxaspectratiomode"); oldplotboxaspectratiomode = get (ax2, "plotboxaspectratiomode"); - if (! (isequal (position, oldposition) && isequal (view, oldview))) - set (ax2, "position", position, "view", view); + + if (strcmp (get(h, "activepositionproperty"), "position")) + position = get (h, "position"); + oldposition = get (ax2, "position"); + if (! (isequal (position, oldposition) && isequal (view, oldview))) + set (ax2, "position", position, "view", view); + endif + else + outerposition = get (h, "outerposition"); + oldouterposition = get (ax2, "outerposition"); + if (! (isequal (outerposition, oldouterposition) && isequal (view, oldview))) + set (ax2, "outerposition", outerposition, "view", view); + endif endif + if (! (isequal (plotboxaspectratio, oldplotboxaspectratio) && isequal (plotboxaspectratiomode, oldplotboxaspectratiomode))) set (ax2, "plotboxaspectratio", plotboxaspectratio);
--- a/scripts/plot/polar.m +++ b/scripts/plot/polar.m @@ -211,3 +211,15 @@ endif endfunction + + +%!demo +%! theta = linspace (0, 2*pi, 1000); +%! rho = sin (7*theta); +%! polar (theta, rho); + +%!demo +%! theta = linspace (0, 10*pi, 1000); +%! rho = sin (5/4*theta); +%! polar (theta, rho); +
--- a/scripts/plot/print.m +++ b/scripts/plot/print.m @@ -611,7 +611,7 @@ "print.m: error closing file '%s'", latexfile); endif ## TODO - should this be fixed in GL2PS? - latex = strrep (latex, "\\includegraphics{}", + latex = strrep (latex, "\\includegraphics{}", sprintf ("\\includegraphics{%s}", graphicsfile)); else error ("print:erroropeningfile",
--- a/scripts/plot/private/__axis_label__.m +++ b/scripts/plot/private/__axis_label__.m @@ -17,32 +17,26 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} __axis_label__ (@var{caller}, @var{txt}, @dots{}) +## @deftypefn {Function File} {} __axis_label__ (@var{caller}, @var{h}, @var{txt}, @dots{}) ## Undocumented internal function. ## @end deftypefn ## Author: jwe -function retval = __axis_label__ (caller, txt, varargin) +function retval = __axis_label__ (ah, caller, txt, varargin) - if (ischar (txt)) - ca = gca (); - - h = get (gca (), caller); + h = get (ah, caller); - set (h, "fontangle", get (ca, "fontangle"), - "fontname", get (ca, "fontname"), - "fontsize", get (ca, "fontsize"), - "fontunits", get (ca, "fontunits"), - "fontweight", get (ca, "fontweight"), - "string", txt, - varargin{:}); + set (h, "fontangle", get (ah, "fontangle"), + "fontname", get (ah, "fontname"), + "fontsize", get (ah, "fontsize"), + "fontunits", get (ah, "fontunits"), + "fontweight", get (ah, "fontweight"), + "string", txt, + varargin{:}); - if (nargout > 0) - retval = h; - endif - else - error ("%s: expecting first argument to be character string", caller); + if (nargout > 0) + retval = h; endif endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__file_filter__.m @@ -0,0 +1,93 @@ +## Copyright (C) 2010-2011 Kai Habel +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} __file_filter__ (@var{file_filter}) +## Undocumented internal function. +## @end deftypefn + +## Author: Kai Habel + +function [retval, defname, defdir] = __file_filter__ (file_filter, name) + + revtal = {}; + defname = ""; + defdir = ""; + + if (iscell (file_filter)) + [r, c] = size (file_filter); + if (c != 1 && c != 2) + error ("%s: invalid filter specification", name); + endif + if (c == 1) + retval = cell (r, 2); + for i = 1:r + retval{i, 1} = file_filter{i}; + retval{i, 2} = __default_filtername__ (file_filter{i}); + endfor + else + retval = file_filter; + for i = 1:r + if (isempty (retval{i, 2})) + retval{i, 2} = __default_filtername__ (retval{i, 1}); + endif + endfor + endif + elseif (ischar (file_filter)) + [defdir, fname, fext] = fileparts (file_filter); + if (! strcmp (fname, "*")) + defname = strcat (fname, fext); + endif + if (length (fext) > 0) + fext = strcat ("*", fext); + retval = {fext, __default_filtername__(fext)}; + endif + endif + + retval(end+1,:) = {"*", __default_filtername__("*")}; + +endfunction + +function name = __default_filtername__ (filterext) + + name = ""; + + switch (filterext) + case "*" + name = "All Files"; + case "*.m" + name = "Octave Source Files"; + case "*.c" + name = "C Source Files"; + case {"*.cc" "*.c++" "*.cpp"} + name = "C++ Source Files"; + case "*.oct" + name = "Octave Compiled Files"; + endswitch + + if (isempty (name)) + extlist = strsplit(filterext, ";"); + extlist = strrep (extlist, "*.", ""); + extlist = toupper (extlist); + extlist(end+1, :) = repmat ({","}, 1, length (extlist)); + extlist = strcat (extlist{:}); + extlist = extlist(1:end-1); + name = strcat (extlist, "-Files"); + endif + +endfunction
old mode 100755 new mode 100644 --- a/scripts/plot/private/__fltk_file_filter__.m +++ b/scripts/plot/private/__fltk_file_filter__.m @@ -1,4 +1,4 @@ -## Copyright (C) 2010-2011 Kai Habel +## Copyright (C) 2011 Michael Goffioul ## ## This file is part of Octave. ## @@ -17,56 +17,48 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} __fltk_file_filter__ (@var{file_filter}) +## @deftypefn {Function File} {@var{filterspec} =} __fltk_file_filter__ (@var{filter}) ## Undocumented internal function. ## @end deftypefn -## Author: Kai Habel +## Author: Michael Goffioul function retval = __fltk_file_filter__ (file_filter) - # converts octave's file filter format into fltk's. - retval = ""; - if (iscell (file_filter)) - [r, c] = size (file_filter); - if ((c == 0) || (c > 2)) - error ("expecting 1 or to 2 columns for file filter cell"); - endif - fltk_str = ""; - for idx = 1 : r - curr_ext = file_filter{idx, 1}; - curr_ext = strsplit (curr_ext, ";"); + retval = ""; + [r, c] = size (file_filter); + if ((c == 0) || (c > 2)) + error ("expecting 1 or to 2 columns for file filter cell"); + endif + fltk_str = ""; + for idx = 1 : r - if (length (curr_ext) > 1) - curr_ext = regexprep (curr_ext, '\*\.', ','); - curr_ext = strcat (curr_ext{:})(2 : end); - curr_ext = strcat ("*.{", curr_ext, "}"); - else - curr_ext = curr_ext{:}; - endif - - curr_desc = strcat (curr_ext(3:end), "-Files"); + curr_ext = file_filter{idx, 1}; + curr_ext = strsplit (curr_ext, ";"); - if (c == 2) - curr_desc = file_filter{idx, 2}; - curr_desc = regexprep (curr_desc, '\(', '<'); - curr_desc = regexprep (curr_desc, '\)', '>'); - endif + if (length (curr_ext) > 1) + curr_ext = regexprep (curr_ext, '\*\.', ','); + curr_ext = strcat (curr_ext{:})(2 : end); + curr_ext = strcat ("*.{", curr_ext, "}"); + else + curr_ext = curr_ext{:}; + endif - if (length (fltk_str) > 0) - fltk_str = strcat (fltk_str, "\t", curr_desc, " (", curr_ext, ")"); - else - fltk_str = strcat (curr_desc, " (", curr_ext, ")"); - endif + curr_desc = strcat (curr_ext(3:end), "-Files"); - endfor - retval = fltk_str; - elseif (ischar (file_filter)) - if (!isdir (file_filter)) - [fdir, fname, fext] = fileparts (file_filter); - if (length (fext) > 0) - retval = strcat ("*", fext, "\t*"); - endif + if (c == 2) + curr_desc = file_filter{idx, 2}; + curr_desc = regexprep (curr_desc, '\(', '<'); + curr_desc = regexprep (curr_desc, '\)', '>'); endif - endif + + if (length (fltk_str) > 0) + fltk_str = strcat (fltk_str, "\t", curr_desc, " (", curr_ext, ")"); + else + fltk_str = strcat (curr_desc, " (", curr_ext, ")"); + endif + + endfor + retval = fltk_str; + endfunction
--- a/scripts/plot/private/__ghostscript__.m +++ b/scripts/plot/private/__ghostscript__.m @@ -44,7 +44,7 @@ cleanup_cmd = ""; args = varargin; - n = find (cellfun (@isstruct, args)); + n = find (cellfun ("isclass", args, "struct")); if (! isempty (n)) f = fieldnames (args{n}); for m = 1:numel(f)
rename from scripts/plot/__gnuplot_has_feature__.m rename to scripts/plot/private/__gnuplot_has_feature__.m
rename from scripts/plot/__gnuplot_open_stream__.m rename to scripts/plot/private/__gnuplot_open_stream__.m
rename from scripts/plot/__go_draw_axes__.m rename to scripts/plot/private/__go_draw_axes__.m --- a/scripts/plot/__go_draw_axes__.m +++ b/scripts/plot/private/__go_draw_axes__.m @@ -40,10 +40,16 @@ gnuplot_term = __gnuplot_get_var__ (axis_obj.parent, "GPVAL_TERM"); ## Set to false for plotyy axes. - if (strcmp (axis_obj.tag, "plotyy")) - ymirror = false; - else - ymirror = true; + ymirror = true; + if (isfield (axis_obj, "__plotyy_axes__")) + if (all (ishandle (axis_obj.__plotyy_axes__))) + ymirror = false; + else + h = axis_obj.__plotyy_axes__; + h = h(ishandle (h)); + h = h(isprop (h, "__ploty_axes__")); + rmappdata (h, "__plotyy_axes__") + endif endif nd = __calc_dimensions__ (h); @@ -332,12 +338,59 @@ fputs (plot_stream, "unset grid;\n"); endif + xlogscale = strcmpi (axis_obj.xscale, "log"); + ylogscale = strcmpi (axis_obj.yscale, "log"); + zlogscale = strcmpi (axis_obj.zscale, "log"); + + ## Detect logscale and negative lims + if (xlogscale && all (axis_obj.xlim < 0)) + axis_obj.xsgn = -1; + if (strcmp (axis_obj.xdir, "reverse")) + axis_obj.xdir = "normal"; + elseif (strcmp (axis_obj.xdir, "normal")) + axis_obj.xdir = "reverse"; + endif + axis_obj.xtick = -flip (axis_obj.xtick); + axis_obj.xticklabel = flip (axis_obj.xticklabel); + axis_obj.xlim = -flip (axis_obj.xlim); + else + axis_obj.xsgn = 1; + endif + if (ylogscale && all (axis_obj.ylim < 0)) + axis_obj.ysgn = -1; + if (strcmp (axis_obj.ydir, "reverse")) + axis_obj.ydir = "normal"; + elseif (strcmp (axis_obj.ydir, "normal")) + axis_obj.ydir = "reverse"; + endif + axis_obj.ytick = -flip (axis_obj.ytick); + axis_obj.yticklabel = flip (axis_obj.yticklabel); + axis_obj.ylim = -flip (axis_obj.ylim); + else + axis_obj.ysgn = 1; + endif + if (zlogscale && all (axis_obj.zlim < 0)) + axis_obj.zsgn = -1; + if (strcmp (axis_obj.zdir, "reverse")) + axis_obj.zdir = "normal"; + elseif (strcmp (axis_obj.zdir, "normal")) + axis_obj.zdir = "reverse"; + endif + axis_obj.ztick = -flip (axis_obj.ztick); + axis_obj.zticklabel = flip (axis_obj.zticklabel); + axis_obj.zlim = -flip (axis_obj.zlim); + else + axis_obj.zsgn = 1; + endif + + xlim = axis_obj.xlim; + ylim = axis_obj.ylim; + zlim = axis_obj.zlim; + clim = axis_obj.clim; + do_tics (axis_obj, plot_stream, ymirror, mono, gnuplot_term); fputs (plot_stream, "unset logscale;\n"); - xlogscale = strcmpi (axis_obj.xscale, "log"); - ylogscale = strcmpi (axis_obj.yscale, "log"); - zlogscale = strcmpi (axis_obj.zscale, "log"); if (xlogscale) fprintf (plot_stream, "set logscale %s;\n", xaxisloc); endif @@ -377,11 +430,6 @@ hidden_removal = NaN; view_map = false; - xlim = axis_obj.xlim; - ylim = axis_obj.ylim; - zlim = axis_obj.zlim; - clim = axis_obj.clim; - if (! cautoscale && clim(1) == clim(2)) clim(2)++; endif @@ -409,12 +457,15 @@ endif if (xlogscale && isfield (obj, "xdata")) + obj.xdata = axis_obj.xsgn * obj.xdata; obj.xdata(obj.xdata<=0) = NaN; endif if (ylogscale && isfield (obj, "ydata")) + obj.ydata = axis_obj.ysgn * obj.ydata; obj.ydata(obj.ydata<=0) = NaN; endif if (zlogscale && isfield (obj, "zdata")) + obj.zdata = axis_obj.zsgn * obj.zdata; obj.zdata(obj.zdata<=0) = NaN; endif @@ -648,8 +699,12 @@ elseif (nd == 3 && numel (xcol) == 3) ccdat = ccol * ones (3,1); else - r = 1 + round ((size (cmap, 1) - 1) - * (ccol - clim(1))/(clim(2) - clim(1))); + if (cdatadirect) + r = round (ccol); + else + r = 1 + round ((size (cmap, 1) - 1) + * (ccol - clim(1))/(clim(2) - clim(1))); + endif r = max (1, min (r, size (cmap, 1))); color = cmap(r, :); endif @@ -665,10 +720,17 @@ ccdat = ccdat(:); endif else - warning ("\"interp\" not supported, using 1st entry of cdata"); - r = 1 + round ((size (cmap, 1) - 1) * ccol(1)); + if (sum (diff (ccol))) + warning ("\"interp\" not supported, using 1st entry of cdata"); + endif + if (cdatadirect) + r = round (ccol); + else + r = 1 + round ((size (cmap, 1) - 1) + * (ccol - clim(1))/(clim(2) - clim(1))); + endif r = max (1, min (r, size (cmap, 1))); - color = cmap(r,:); + color = cmap(r(1),:); endif endif elseif (isnumeric (obj.facecolor)) @@ -1250,6 +1312,11 @@ colorspec = get_text_colorspec (color, mono); endif + if (ischar (obj.string)) + num_lines = size (obj.string, 1); + else + num_lines = numel (obj.string); + endif switch valign ## Text offset in characters. This relies on gnuplot for font metrics. case "top" @@ -1257,17 +1324,18 @@ case "cap" dy = -0.5; case "middle" - dy = 0; + dy = 0.5 * (num_lines - 1); case "baseline" - dy = 0.5; + dy = 0.5 + (num_lines - 1); case "bottom" - dy = 0.5; + dy = 0.5 + (num_lines - 1); endswitch ## Gnuplot's Character units are different for x/y and vary with fontsize. The aspect ratio ## of 1:1.7 was determined by experiment to work for eps/ps/etc. For the MacOS aqua terminal ## a value of 2.5 is needed. However, the difference is barely noticable. dx_and_dy = [(-dy * sind (angle)), (dy * cosd(angle))] .* [1.7 1]; + ## FIXME - Multiline text produced the gnuplot "warning: ft_render: skipping glyph" if (nd == 3) ## This produces the desired vertical alignment in 3D. fprintf (plot_stream, @@ -1312,7 +1380,7 @@ fputs (plot_stream, "unset hidden3d;\n"); endif - have_data = (! (isempty (data) || all (cellfun (@isempty, data)))); + have_data = (! (isempty (data) || all (cellfun ("isempty", data)))); ## Note we don't use the [xy]2range of gnuplot as we don't use the ## dual axis plotting features of gnuplot. @@ -1392,23 +1460,57 @@ fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", axis_obj.tickdir); fputs (plot_stream, "set border 12;\n"); - else + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", axis_obj.tickdir); fputs (plot_stream, "set border 9;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 8;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); endif - else + elseif (strcmpi (axis_obj.yaxislocation, "left")) fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", axis_obj.tickdir); if (strcmpi (axis_obj.xaxislocation, "top")) fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", axis_obj.tickdir); fputs (plot_stream, "set border 6;\n"); - else + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", axis_obj.tickdir); fputs (plot_stream, "set border 3;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 2;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); endif + else # yaxislocation == zero + fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", + axis_obj.tickdir); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 4;\n"); + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 1;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", + axis_obj.tickdir); + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "unset border;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); + endif + fprintf (plot_stream, "set yzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); endif endif endif @@ -1624,6 +1726,16 @@ endfunction +function x = flip (x) + if (size (x, 1) == 1) + x = fliplr (x); + elseif (size (x, 2) == 1 || ischar (x)) + x = flipud (x); + else + x = flipud (fliplr (x)); + endif +endfunction + function fontspec = create_fontspec (f, s, gp_term) if (strcmp (f, "*") || strcmp (gp_term, "tikz")) fontspec = sprintf ("font \",%d\"", s); @@ -1919,67 +2031,67 @@ do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x2", plot_stream, true, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.xscale, gnuplot_term); + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x", plot_stream, true, mono, "border", "", "", fontname, fontspec, obj.interpreter, obj.xscale, - gnuplot_term); + obj.xsgn, gnuplot_term); elseif (strcmpi (obj.xaxislocation, "zero")) do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x", plot_stream, true, mono, "axis", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.xscale, gnuplot_term); + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x2", plot_stream, true, mono, "axis", "", "", fontname, fontspec, obj.interpreter, obj.xscale, - gnuplot_term); + obj.xsgn, gnuplot_term); else do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x", plot_stream, true, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.xscale, gnuplot_term); + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, obj.xcolor, "x2", plot_stream, true, mono, "border", "", "", fontname, fontspec, obj.interpreter, obj.xscale, - gnuplot_term); + obj.xsgn, gnuplot_term); endif if (strcmpi (obj.yaxislocation, "right")) do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y2", plot_stream, ymirror, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.yscale, gnuplot_term); + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y", plot_stream, ymirror, mono, "border", "", "", fontname, fontspec, obj.interpreter, obj.yscale, - gnuplot_term); + obj.ysgn, gnuplot_term); elseif (strcmpi (obj.yaxislocation, "zero")) do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y", plot_stream, ymirror, mono, "axis", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.yscale, gnuplot_term); + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y2", plot_stream, ymirror, mono, "axis", "", "", fontname, fontspec, obj.interpreter, obj.yscale, - gnuplot_term); + obj.ysgn, gnuplot_term); else do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y", plot_stream, ymirror, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.yscale, gnuplot_term); + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, obj.ycolor, "y2", plot_stream, ymirror, mono, "border", "", "", fontname, fontspec, obj.interpreter, obj.yscale, - gnuplot_term); + obj.ysgn, gnuplot_term); endif do_tics_1 (obj.ztickmode, obj.ztick, obj.zminortick, obj.zticklabelmode, obj.zticklabel, obj.zcolor, "z", plot_stream, true, mono, "border", obj.tickdir, ticklength, fontname, fontspec, - obj.interpreter, obj.zscale, gnuplot_term); + obj.interpreter, obj.zscale, obj.zsgn, gnuplot_term); endfunction function do_tics_1 (ticmode, tics, mtics, labelmode, labels, color, ax, plot_stream, mirror, mono, axispos, tickdir, ticklength, - fontname, fontspec, interpreter, scale, gnuplot_term) + fontname, fontspec, interpreter, scale, sgn, gnuplot_term) persistent warned_latex = false; if (strcmpi (interpreter, "tex")) for n = 1 : numel(labels) @@ -1998,6 +2110,9 @@ else fmt = "10^{%T}"; endif + if (sgn < 0) + fmt = strcat ("-", fmt); + endif else fmt = "%g"; num_mtics = 5; @@ -2157,10 +2272,31 @@ bld = false; endif + ## The text object maybe multiline, and may be of any class str = getfield (obj, fld); + if (ischar (str) && size (str, 1) > 1) + str = cellstr (str); + elseif (isnumeric (str)) + str = cellstr (num2str (str(:))); + endif + if (iscellstr (str)) + for n = 1:numel(str) + if (isnumeric (str{n})) + str{n} = num2str (str{n}); + endif + endfor + str = sprintf ("%s\n", str{:})(1:end-1); + endif + if (enhanced) if (strcmpi (obj.interpreter, "tex")) - str = __tex2enhanced__ (str, fnt, it, bld); + if (iscellstr (str)) + for n = 1:numel(str) + str{n} = __tex2enhanced__ (str{n}, fnt, it, bld); + endfor + else + str = __tex2enhanced__ (str, fnt, it, bld); + endif elseif (strcmpi (obj.interpreter, "latex")) if (! warned_latex) warning ("latex markup not supported for text objects"); @@ -2356,7 +2492,7 @@ l = length (s) - length (strfind(s,'{')) - length (strfind(s,'}')); m = regexp (s, '/([\w-]+|[\w-]+=\d+)', 'matches'); if (!isempty (m)) - l = l - sum (cellfun (@length, m)); + l = l - sum (cellfun ("length", m)); endif endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__is_function__.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{result} =} __is_function__ (@var{func}) +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function result = __is_function__ (func) + + existval = exist (func); + result = (existval == 2 || existval == 3 || existval == 5 || existval == 6); + +endfunction
--- a/scripts/plot/private/__line__.m +++ b/scripts/plot/private/__line__.m @@ -53,19 +53,69 @@ error ("line: invalid number of PROPERTY / VALUE pairs"); endif - data_args = {}; - if (num_data_args > 1) - data_args(1:4) = { "xdata", varargin{1}, "ydata", varargin{2} }; - if (num_data_args == 3) - data_args(5:6) = { "zdata", varargin{3} }; - endif - endif - other_args = {}; if (nvargs > num_data_args) other_args = varargin(num_data_args+1:end); endif - h = __go_line__ (p, data_args{:}, other_args{:}); + nlines = 0; + nvecpts = 0; + ismat = false (1, 3); + for i = 1:num_data_args + tmp = varargin{i}(:,:); + if (isvector (tmp)) + nlines = max (1, nlines); + if (! isscalar (tmp)) + if (nvecpts == 0) + nvecpts = numel (tmp); + elseif (nvecpts != numel (tmp)) + error ("line: data size mismatch"); + endif + endif + else + ismat(i) = true; + nlines = max (columns (tmp), nlines); + endif + varargin{i} = tmp; + endfor + + if (num_data_args == 0) + varargin = {[0, 1], [0, 1]}; + num_data_args = 2; + nlines = 1; + endif + + handles = zeros (nlines, 1); + + data = cell (1, 3); + + if (num_data_args > 1) + data(1) = varargin{1}; + data(2) = varargin{2}; + if (num_data_args == 3) + data(3) = varargin{3}; + endif + endif + + data_args = reshape ({"xdata", "ydata", "zdata"; data{:}}, [1, 6]); + mask = reshape ([false(1,3); ismat], [1, 6]); + + for i = 1:nlines + tmp = data(ismat); + if (! size_equal (tmp) + || (nvecpts != 0 && any (nvecpts != cellfun ("size", tmp, 1)))) + error ("line: data size_mismatch"); + endif + + data_args(mask) = cellfun (@(x) x(:,i), data(ismat), + "uniformoutput", false); + + handles(i) = __go_line__ (p, data_args{:}, other_args{:}); + + endfor + + if (nargout > 0) + h = handles; + endif endfunction
--- a/scripts/plot/private/__patch__.m +++ b/scripts/plot/private/__patch__.m @@ -31,7 +31,12 @@ failed = false; - if (isstruct (varargin{1})) + is_numeric_arg = cellfun (@isnumeric, varargin); + + if (isempty (varargin)) + args = {"xdata", [0; 1; 0], "ydata", [1; 1; 0], "facecolor", [0, 0, 0]}; + args = setvertexdata (args); + elseif (isstruct (varargin{1})) if (isfield (varargin{1}, "vertices") && isfield (varargin{1}, "faces")) args{1} = "faces"; args{2} = getfield(varargin{1}, "faces"); @@ -48,26 +53,53 @@ else failed = true; endif - elseif (isnumeric (varargin{1})) - if (nargin < 3 || ! isnumeric (varargin{2})) + elseif (is_numeric_arg(1)) + if (nargin < 3 || ! is_numeric_arg(2)) failed = true; else - x = varargin{1}; - y = varargin{2}; - iarg = 3; - if (nargin > 3 && ndims (varargin{3}) == 2 && ndims (x) == 2 - && size_equal(x, varargin{3}) && !ischar(varargin{3})) + if (nargin > 4 && all (is_numeric_arg(1:4))) + x = varargin{1}; + y = varargin{2}; z = varargin{3}; - iarg++; - else + c = varargin{4}; + iarg = 5; + elseif (nargin > 3 && all (is_numeric_arg(1:3))) + x = varargin{1}; + y = varargin{2}; + iarg = 4; + if (rem (nargin - iarg, 2) == 1) + c = varargin {iarg}; + z = varargin{3}; + iarg = 5; + else + z = []; + c = varargin{3}; + endif + elseif (nargin > 2 && all (is_numeric_arg(1:2))) + x = varargin{1}; + y = varargin{2}; z = []; + iarg = 3; + if (rem (nargin - iarg, 2) == 1) + c = varargin {iarg}; + iarg++; + else + c = []; + endif endif if (isvector (x)) x = x(:); y = y(:); z = z(:); + if (isnumeric (c)) + if (isvector (c) && numel (c) == numel (x)) + c = c(:); + elseif (size (c, 1) != numel (x) && size (c, 2) == numel (x)) + c = c.'; + endif + endif endif args{1} = "xdata"; args{2} = x; @@ -76,9 +108,7 @@ args{5} = "zdata"; args{6} = z; - if (isnumeric (varargin{iarg})) - c = varargin{iarg}; - iarg++; + if (isnumeric (c)) if (ndims (c) == 3 && size (c, 2) == 1) c = permute (c, [1, 3, 2]); @@ -100,28 +130,32 @@ endif elseif (size (c, ndims (c)) == 3) args{7} = "facecolor"; - args{8} = "flat"; + args{8} = c; args{9} = "cdata"; - args{10} = c; + args{10} = []; else ## Color Vectors - if (rows (c) != rows (x) || rows (c) != length (y)) - error ("patch: size of x, y, and c must be equal"); - else + if (isempty (c)) args{7} = "facecolor"; args{8} = "interp"; args{9} = "cdata"; args{10} = []; + elseif (isequal (size (c), size (x)) && isequal (size (c), size (y))) + args{7} = "facecolor"; + args{8} = "interp"; + args{9} = "cdata"; + args{10} = c; + else + error ("patch: size of x, y, and c must be equal"); endif endif - elseif (ischar (varargin{iarg}) && rem (nargin - iarg, 2) != 0) + elseif (ischar (c) && rem (nargin - iarg, 2) == 0) ## Assume that any additional argument over an even number is ## color string. args{7} = "facecolor"; - args{8} = tolower (varargin{iarg}); + args{8} = tolower (c); args{9} = "cdata"; args{10} = []; - iarg++; else args{7} = "facecolor"; args{8} = [0, 1, 0]; @@ -134,7 +168,7 @@ endif else args = varargin; - if (any(cellfun (@(x) strcmpi(x,"faces") || strcmpi(x, "vertices"), args))) + if (any (strcmpi (args, "faces") | strcmpi (args, "vertices"))) args = setdata (args); else args = setvertexdata (args); @@ -205,12 +239,10 @@ nc = size (faces, 1); idx = faces .'; t1 = isnan (idx); - if (any (t1(:))) - t2 = find (t1 != t1([2:end,end],:)); - idx (t1) = idx (t2 (cell2mat (cellfun (@(x) x(1)*ones(1,x(2)), - mat2cell ([1 : nc; sum(t1)], 2, ones(1,nc)), - "uniformoutput", false)))); - endif + for i = find (any (t1)) + first_idx_in_column = find (t1(:,i), 1); + idx(first_idx_in_column:end,i) = idx(first_idx_in_column-1,i); + endfor x = reshape (vert(:,1)(idx), size (idx)); y = reshape (vert(:,2)(idx), size (idx)); if (size(vert,2) > 2) @@ -285,8 +317,10 @@ if (ndims (c) == 3) fvc = reshape (c, size (c, 1) * size (c, 2), size(c, 3)); + elseif (isvector (c)) + fvc = c(:); else - fvc = c(:).'; + fvc = c.'(:); endif args = {"faces", faces, "vertices", vert, "facevertexcdata", fvc, args{:}};
rename from scripts/plot/__print_parse_opts__.m rename to scripts/plot/private/__print_parse_opts__.m --- a/scripts/plot/__print_parse_opts__.m +++ b/scripts/plot/private/__print_parse_opts__.m @@ -361,7 +361,8 @@ endfunction -%!test +## Test blocks are not allowed (and not needed) for private functions +#%!test %! opts = __print_parse_opts__ (); %! assert (opts.devopt, "pswrite"); %! assert (opts.use_color, 1); @@ -369,11 +370,11 @@ %! assert (opts.canvas_size, [576, 432]); %! assert (opts.ghostscript.device, "pswrite") -%!test +#%!test %! opts = __print_parse_opts__ ("test.pdf", "-S640,480"); %! assert (opts.canvas_size, [307.2, 230.4], 0.1); -%!test +#%!test %! opts = __print_parse_opts__ ("-dpsc", "-append", "-loose"); %! assert (opts.devopt, "pswrite"); %! assert (opts.send_to_printer, true); @@ -382,14 +383,14 @@ %! assert (opts.ghostscript.device, "pswrite") %! assert (opts.ghostscript.epscrop, false); -%!test +#%!test %! opts = __print_parse_opts__ ("-deps", "-tight"); %! assert (opts.tight_flag, true); %! assert (opts.send_to_printer, true); %! assert (opts.use_color, -1); %! assert (opts.ghostscript.device, "") -%!test +#%!test %! opts = __print_parse_opts__ ("-djpg", "foobar", "-mono", "-loose"); %! assert (opts.devopt, "jpeg") %! assert (opts.name, "foobar.jpg") @@ -401,7 +402,7 @@ %! assert (opts.printer, ""); %! assert (opts.use_color, -1); -%!test +#%!test %! opts = __print_parse_opts__ ("-ddeskjet", "foobar", "-mono", "-Pmyprinter"); %! assert (opts.ghostscript.output, "foobar.deskjet") %! assert (opts.ghostscript.device, "deskjet") @@ -410,7 +411,7 @@ %! assert (opts.printer, "-Pmyprinter"); %! assert (opts.use_color, -1); -%!test +#%!test %! opts = __print_parse_opts__ ("-f5", "-dljet3"); %! assert (opts.ghostscript.device, "ljet3") %! assert (strfind (opts.ghostscript.output, ".ljet3")) @@ -448,7 +449,7 @@ gs_binaries = horzcat (gs_binaries, {"gs", "gs.exe"}); else ## pc - Includes Win32 and mingw. - gs_binaries = horzcat (gs_binaries, {"gs.exe", "gswin32c.exe"}); + gs_binaries = horzcat (gs_binaries, {"gs.exe", "gswin32c.exe", "mgs.exe"}); endif n = 0; while (n < numel (gs_binaries) && isempty (ghostscript_binary))
--- a/scripts/plot/private/__quiver__.m +++ b/scripts/plot/private/__quiver__.m @@ -125,8 +125,8 @@ sd = sqrt (dx.^2 + dy.^2 + dz.^2) / len; if (sd != 0) s = sqrt(2) * autoscale * sd; - else # special case of identical points with multiple vectors - s = autoscale; + else # special case of identical points with multiple vectors + s = autoscale; endif uu = s * u; vv = s * v;
--- a/scripts/plot/private/__scatter__.m +++ b/scripts/plot/private/__scatter__.m @@ -368,14 +368,14 @@ if (isempty (z1)) for i = 1 : length (hlist) set (hlist(i), "vertices", [x1(i), y1(i)], "cdata", - reshape(c1(i,:),[1, size(c1)(2:end)]), + reshape(c1(i,:),[1, size(c1)(2:end)]), "facevertexcdata", c1(i,:), "markersize", size1(i)); endfor else for i = 1 : length (hlist) set (hlist(i), "vertices", [x1(i), y1(i), z1(i)], "cdata", - reshape(c1(i,:),[1, size(c1)(2:end)]), + reshape(c1(i,:),[1, size(c1)(2:end)]), "facevertexcdata", c1(i,:), "markersize", size1(i)); endfor
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__uigetdir_fltk__.m @@ -0,0 +1,34 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dirname} =} __uigetdir_fltk__ (@var{start_path}, @var{dialog_title}) +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function dirname = __uigetdir_fltk__ (start_path, dialog_title) + + if (exist("__fltk_uigetfile__") != 3) + error ("uigetdir: fltk graphics toolkit required"); + endif + + dirname = __fltk_uigetfile__ ("", dialog_title, start_path, [240, 120], "dir"); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__uigetfile_fltk__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} __uigetfile_fltk__ () +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function [retval, retpath, retindex] = __uigetfile_fltk__ (filters, title, defval, position, multiselect, defdir) + + if (exist("__fltk_uigetfile__") != 3) + error ("uigetfile: fltk graphics toolkit required"); + endif + + filters = __fltk_file_filter__ (filters); + if (length (defdir) > 0) + defval = fullfile (defdir, defval); + endif + [retval, retpath, retindex] = __fltk_uigetfile__ (filters, title, defval, position, multiselect); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__uiobject_split_args__.m @@ -0,0 +1,66 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{args}] =} __uiobject_split_args__ (@var{who}, @var{args}, @var{parent_type}, @var{use_gcf}) +## @end deftypefn + +## Author: goffioul + +function [parent, args] = __uiobject_split_args__ (who, in_args, parent_type = {}, use_gcf = 1) + + parent = []; + args = {}; + offset = 1; + + if (! isempty (in_args)) + if (ishandle (in_args{1})) + parent = in_args{1}; + offset = 2; + elseif (! ischar (in_args{1})) + error ("%s: invalid parent handle.", who); + endif + + args = in_args(offset:end); + endif + + if (rem (length (args), 2)) + error ("%s: expecting PROPERTY/VALUE pairs", who); + endif + + if (! isempty (args)) + i = find (strcmpi (args(1:2:end), "parent"), 1, "first"); + if (! isempty (i) && length (args) >= 2*i) + parent = args{2*i}; + if (! ishandle (parent)) + error ("%s: invalid parent handle.", who); + endif + args([2*i-1, 2*i]) = []; + endif + endif + + if (! isempty (parent)) + if (! isempty (parent_type) && isempty (find (strcmpi (get (parent, "type"), parent_type)))) + error ("%s: invalid parent, the parent type must be: %s", ... + who, sprintf ("%s, ", parent_type{:})(1:end-2)); + endif + elseif (use_gcf) + parent = gcf (); + endif + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/private/__uiputfile_fltk__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} __uiputfile_fltk__ () +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function [retval, retpath, retindex] = __uiputfile_fltk__ (filters, title, defval, position, tag, defdir) + + if (exist("__fltk_uigetfile__") != 3) + error ("uiputfile: fltk graphics toolkit required"); + endif + + filters = __fltk_file_filter__ (filters); + if (length (defdir) > 0) + defval = fullfile (defdir, defval); + endif + [retval, retpath, retindex] = __fltk_uigetfile__ (filters, title, defval, position, tag); + +endfunction
--- a/scripts/plot/rectangle.m +++ b/scripts/plot/rectangle.m @@ -25,15 +25,15 @@ ## @deftypefnx {Function File} {@var{h} =} rectangle (@dots{}) ## ## Draw rectangular patch defined by @var{pos} and @var{curv}. The variable -## @code{@var{pos}(1 : 2)} defines the lower left-hand corner of the patch -## and @code{@var{pos}(3 : 4)} defines its width and height. By default, the +## @code{@var{pos}(1:2)} defines the lower left-hand corner of the patch +## and @code{@var{pos}(3:4)} defines its width and height. By default, the ## value of @var{pos} is @code{[0, 0, 1, 1]}. ## ## The variable @var{curv} defines the curvature of the sides of the rectangle ## and may be a scalar or two-element vector with values between 0 and 1. ## A value of 0 represents no curvature of the side, whereas a value of 1 ## means that the side is entirely curved into the arc of a circle. -## If @var{curv} is a two-element vector, then the first element is the +## If @var{curv} is a two-element vector, then the first element is the ## curvature along the x-axis of the patch and the second along y-axis. ## ## If @var{curv} is a scalar, it represents the curvature of the shorter of the @@ -41,11 +41,11 @@ ## by ## ## @example -## min (pos (1: 2)) / max (pos (1:2)) * curv +## min (pos (1:2)) / max (pos (1:2)) * curv ## @end example ## -## Other properties are passed to the underlying patch command. If called -## with an output argument, @code{rectangle} returns the handle to the +## Other properties are passed to the underlying patch command. If called +## with an output argument, @code{rectangle} returns the handle to the ## rectangle. ## @end deftypefn ## @seealso{patch}
--- a/scripts/plot/refreshdata.m +++ b/scripts/plot/refreshdata.m @@ -83,7 +83,7 @@ obj = get (h (i)); fldnames = fieldnames (obj); m = regexpi (fieldnames(obj), '^.+datasource$', "match"); - idx = cellfun (@(x) !isempty(x), m); + idx = ! cellfun ("isempty", m); if (any (idx)) tmp = m(idx); props = [props; {vertcat(tmp{:})}];
--- a/scripts/plot/semilogx.m +++ b/scripts/plot/semilogx.m @@ -59,3 +59,60 @@ end_unwind_protect endfunction + +%!demo +%! x = 1:0.01:10; +%! y = (x .* (1 + rand (size (x)))) .^ 2; +%! semilogx (y, x); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1) +%! semilogx (x, y) +%! xlabel ('semilogx (x, y)') +%! +%! subplot (1, 2, 2) +%! semilogx (-x, y) +%! xlabel ('semilogx (-x, y)') + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1) +%! semilogx (x, y) +%! set (gca, "xdir", "reverse", "activepositionproperty", "outerposition") +%! xlabel ({"semilogx (x, y)", "xdir = reversed"}) +%! +%! subplot (1, 2, 2) +%! semilogx (-x, y) +%! set (gca, "xdir", "reverse", "activepositionproperty", "outerposition") +%! xlabel ({"semilogx (-x, y)","xdir = reversed"}) + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! semilogx (a, b) +%! assert (get (gca, "xscale"), "log"); +%! assert (get (gca, "yscale"), "linear"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! semilogx (a, b) +%! axis tight +%! assert (all (get (gca, "ytick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/semilogy.m +++ b/scripts/plot/semilogy.m @@ -60,3 +60,62 @@ end_unwind_protect endfunction + +%!demo +%! x = 1:0.01:10; +%! y = (x .* (1 + rand (size (x)))) .^ 2; +%! semilogy (x, y); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (2, 1, 1) +%! semilogy (x, y) +%! ylabel ('semilogy (x, y)') +%! +%! subplot (2, 1, 2) +%! semilogy (x, -y) +%! ylabel ('semilogy (x, -y)') + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (2, 1, 1) +%! semilogy (x, y) +%! set (gca, "ydir", "reverse", "activepositionproperty", "outerposition") +%! ylabel ({"semilogy (x, y)", "ydir = reversed"}) +%! +%! subplot (2, 1, 2) +%! semilogy (x, -y) +%! set (gca, "ydir", "reverse", "activepositionproperty", "outerposition") +%! ylabel ({"semilogy (x, -y)", "ydir = reversed"}) + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! semilogy (a, b) +%! assert (get (gca, "yscale"), "log"); +%! assert (get (gca, "xscale"), "linear"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! semilogy (a, b) +%! axis tight +%! assert (all (get (gca, "ytick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +
--- a/scripts/plot/subplot.m +++ b/scripts/plot/subplot.m @@ -66,56 +66,96 @@ ## Author: Vinayak Dutt <Dutt.Vinayak@mayo.EDU> ## Adapted-By: jwe -function h = subplot (rows, cols, index, varargin) +function h = subplot (varargin) align_axes = false; replace_axes = false; + have_position = false; + initial_args_decoded = false; - if (! (nargin >= 3) && nargin != 1) - print_usage (); - elseif (nargin > 3) - for n = 1:numel(varargin) - switch lower(varargin{n}) - case "align" - align_axes = true; - case "replace" - replace_axes = true; - otherwise - print_usage (); - endswitch - endfor + if (nargin > 2) + ## R, C, N? + arg1 = varargin{1}; + arg2 = varargin{2}; + arg3 = varargin{3}; + if (isnumeric (arg1) && isscalar (arg1) && isnumeric (arg2) + && isscalar (arg2) && isnumeric (arg3)) + rows = arg1; + cols = arg2; + index = arg3; + varargin(1:3)= []; + initial_args_decoded = true; + endif endif - if (nargin == 1) + if (! initial_args_decoded && nargin > 1) + ## check for 'position', pos, ... + if (strcmpi (varargin{1}, "position")) + arg = varargin{2}; + if (isnumeric (arg) && numel (arg) == 4) + pos = arg; + varargin(1:2) = []; + have_position = true; + initial_args_decoded = true; + else + error ("expecting position to be a 4-element numeric array"); + endif + endif + endif + + if (! initial_args_decoded && nargin > 0) + arg = varargin{1}; + if (nargin == 1 && ishandle (arg)) + ## Axes handle? + axes (arg); + cf = get (0, "currentfigure"); + set (cf, "nextplot", "add"); + return; + elseif (isscalar (arg) && arg >= 0) + ## RCN? + index = rem (arg, 10); + arg = (arg - index) / 10; + cols = rem (arg, 10); + arg = (arg - cols) / 10; + rows = rem (arg, 10); + varargin(1) = []; + initial_args_decoded = true; + else + error ("subplot: expecting axes handle or RCN argument"); + endif + endif - if (! (isscalar (rows) && rows >= 0)) - error ("subplot: input RCN has to be a positive scalar"); + if (! initial_args_decoded) + print_usage (); + endif + + if (! have_position) + cols = round (cols); + rows = round (rows); + index = round (index); + + if (any (index < 1) || any (index > rows*cols)) + error ("subplot: INDEX value must be greater than 1 and less than ROWS*COLS"); endif - tmp = rows; - index = rem (tmp, 10); - tmp = (tmp - index) / 10; - cols = rem (tmp, 10); - tmp = (tmp - cols) / 10; - rows = rem (tmp, 10); - - elseif (! (isscalar (cols) && isscalar (rows))) - error ("subplot: COLS, and ROWS must be scalars"); - elseif (any (index < 1) || any (index > rows*cols)) - error ("subplot: INDEX value must be greater than 1 and less than ROWS*COLS"); + if (cols < 1 || rows < 1 || index < 1) + error ("subplot: COLS, ROWS, and INDEX must be be positive"); + endif endif - cols = round (cols); - rows = round (rows); - index = round (index); - - if (index > cols*rows) - error ("subplot: INDEX must be less than COLS*ROWS"); - endif - - if (cols < 1 || rows < 1 || index < 1) - error ("subplot: COLS,ROWS,INDEX must be be positive"); - endif + nargs = numel (varargin); + while (nargs > 0) + arg = varargin{1}; + if (strcmpi (arg, "align")) + align_axes = true; + elseif (strcmpi (arg, "replace")) + replace_axes = true; + else + break; + endif + varargin(1) = []; + nargs--; + endwhile axesunits = get (0, "defaultaxesunits"); cf = gcf (); @@ -124,7 +164,24 @@ units = "normalized"; set (0, "defaultaxesunits", units); set (cf, "units", "pixels"); - pos = subplot_position (rows, cols, index, "position"); + + ## FIXME: At the moment we force gnuplot to use the aligned mode + ## which will set "activepositionproperty" to "position". + ## Τhis can yield to text overlap between labels and titles + ## see bug #31610 + if (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + align_axes = true; + endif + + if (! have_position) + if (align_axes) + pos = subplot_position (rows, cols, index, "position"); + elseif (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + pos = subplot_position (rows, cols, index, "outerpositiontight"); + else + pos = subplot_position (rows, cols, index, "outerposition"); + endif + endif set (cf, "nextplot", "add"); @@ -144,7 +201,11 @@ || strcmp (get (child, "tag"), "colorbar")) continue; endif - objpos = get (child, "position"); + if (align_axes) + objpos = get (child, "position"); + else + objpos = get (child, "outerposition"); + endif if (all (objpos == pos) && ! replace_axes) ## If the new axes are in exactly the same position as an ## existing axes object, use the existing axes. @@ -170,14 +231,13 @@ if (found) set (cf, "currentaxes", tmp); + elseif (align_axes) + tmp = axes ("box", "off", "position", pos, varargin{:}); + elseif (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + tmp = axes ("box", "off", "outerposition", pos, varargin{:}); else - outpos = subplot_position (rows, cols, index, "outerposition"); - tmp = axes ("looseinset", [0 0 0 0], "box", "off", - "outerposition", outpos, "position", pos); - endif - - if (align_axes || strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) - set (tmp, "activepositionproperty", "position"); + tmp = axes ("looseinset", [0 0 0 0], "box", "off", "outerposition", pos, + "autopos_tag", "subplot", varargin{:}); endif unwind_protect_cleanup @@ -193,67 +253,55 @@ function pos = subplot_position (rows, cols, index, position_property) - defaultaxesposition = get (0, "defaultaxesposition"); - defaultaxesouterposition = get (0, "defaultaxesouterposition"); - if (rows == 1 && cols == 1) ## Trivial result for subplot (1,1,1) if (strcmpi (position_property, "position")) - pos = defaultaxesposition; + pos = get (0, "defaultaxesposition"); else - pos = defaultaxesouterposition; + pos = get (0, "defaultaxesouterposition"); endif return endif - ## The outer margins surrounding all subplot "positions" are independent of - ## the number of rows and/or columns - margins.left = defaultaxesposition(1); - margins.bottom = defaultaxesposition(2); - margins.right = 1.0 - margins.left - defaultaxesposition(3); - margins.top = 1.0 - margins.bottom - defaultaxesposition(4); - - ## Fit from Matlab experiments - pc = 1 ./ [0.1860, (margins.left + margins.right - 1)]; - margins.column = 1 ./ polyval (pc , cols); - pr = 1 ./ [0.2282, (margins.top + margins.bottom - 1)]; - margins.row = 1 ./ polyval (pr , rows); - - ## Calculate the width/height of the subplot axes "position". - ## This is also consistent with Matlab - width = 1 - margins.left - margins.right - (cols-1)*margins.column; - width = width / cols; - height = 1 - margins.top - margins.bottom - (rows-1)*margins.row; - height = height / rows; + if (strcmp (position_property, "outerposition") + || strcmp (position_property, "outerpositiontight")) + margins.left = 0.05; + margins.bottom = 0.05; + margins.right = 0.05; + margins.top = 0.05; + if (strcmp (position_property, "outerpositiontight")) + margins.column = 0.; + margins.row = 0.; + else + margins.column = 0.04 / cols; + margins.row = 0.04 / rows; + endif + width = 1 - margins.left - margins.right - (cols-1)*margins.column; + width = width / cols; + height = 1 - margins.top - margins.bottom - (rows-1)*margins.row; + height = height / rows; + else + defaultaxesposition = get (0, "defaultaxesposition"); - if (strcmp (position_property, "outerposition") ) - ## Calculate the inset of the position relative to the outerposition - ## The outerpositions are assumed to be tiled. Matlab's implementation - ## has outerposition overlap. - if (rows > 1) - ## Title on top and xlabel & xticks on bottom - inset.top = margins.row * (1/3); - inset.bottom = margins.row * (2/3); - ## Matlab behavior is approximately ... - % inset.bottom = margins.row; - else - inset.bottom = margins.bottom; - inset.top = margins.top; - endif - if (cols > 1) - ## ylabel & yticks on left and some overhang for xticks on right - x = 0.1; - inset.right = x * margins.column; - inset.left = (1 - x) * margins.column; - else - inset.left = margins.left; - inset.right = margins.right; - endif - ## Apply the inset to the geometries for the "position" property. - margins.column = margins.column - inset.right - inset.left; - margins.row = margins.row - inset.top - inset.bottom; - width = width + inset.right + inset.left; - height = height + inset.top + inset.bottom; + ## The outer margins surrounding all subplot "positions" are independent + ## of the number of rows and/or columns + margins.left = defaultaxesposition(1); + margins.bottom = defaultaxesposition(2); + margins.right = 1.0 - margins.left - defaultaxesposition(3); + margins.top = 1.0 - margins.bottom - defaultaxesposition(4); + + ## Fit from Matlab experiments + pc = 1 ./ [0.1860, (margins.left + margins.right - 1)]; + margins.column = 1 ./ polyval (pc , cols); + pr = 1 ./ [0.2282, (margins.top + margins.bottom - 1)]; + margins.row = 1 ./ polyval (pr , rows); + + ## Calculate the width/height of the subplot axes "position". + ## This is also consistent with Matlab + width = 1 - margins.left - margins.right - (cols-1)*margins.column; + width = width / cols; + height = 1 - margins.top - margins.bottom - (rows-1)*margins.row; + height = height / rows; endif ## Index offsets from the lower left subplot @@ -265,12 +313,6 @@ x0 = xi .* (width + margins.column) + margins.left; y0 = yi .* (height + margins.row) + margins.bottom; - if (strcmp (position_property, "outerposition") ) - ## Shift from position(1:2) to outerposition(1:2) - x0 = x0 - inset.left; - y0 = y0 - inset.bottom; - endif - if (numel(x0) > 1) ## subplot (row, col, m:n) x1 = max (x0(:)) + width;
--- a/scripts/plot/surface.m +++ b/scripts/plot/surface.m @@ -80,9 +80,12 @@ z = varargin{3}; c = varargin{4}; - if (! size_equal (z, c)) + [z_nr, z_nc] = size (z); + [c_nr, c_nc, c_np] = size (c); + if (! (z_nr == c_nr && z_nc == c_nc && (c_np == 1 || c_np == 3))) error ("surface: Z and C must have the same size"); endif + if (isvector (x) && isvector (y) && ismatrix (z)) if (rows (z) == length (y) && columns (z) == length (x)) x = x(:)'; @@ -136,6 +139,10 @@ else error ("surface: Z argument must be a matrix"); endif + elseif (firststring == 1) + x = 1:3; + y = (x).'; + c = z = eye(3); else bad_usage = true; endif @@ -155,3 +162,24 @@ endif endfunction + +## Mark file as being tested. Tests for surface are in +## surf.m, surfc.m, surfl.m, and pcolor.m + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = surface; +%! assert (findobj (hf, "type", "surface"), h); +%! assert (get (h, "xdata"), 1:3, eps); +%! assert (get (h, "ydata"), (1:3)', eps); +%! assert (get (h, "zdata"), eye(3)); +%! assert (get (h, "cdata"), eye(3)); +%! assert (get (h, "type"), "surface"); +%! assert (get (h, "linestyle"), get (0, "defaultsurfacelinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultsurfacelinewidth"), eps); +%! assert (get (h, "marker"), get (0, "defaultsurfacemarker")); +%! assert (get (h, "markersize"), get (0, "defaultsurfacemarkersize")); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/surfc.m +++ b/scripts/plot/surfc.m @@ -45,7 +45,26 @@ drawnow (); zmin = get (ax, "zlim")(1); - [c, tmp2] = __contour__ (ax, zmin, varargin{:}); + # don't pass axis handle and/or string arguments to __contour__() + stop_idx = nargin; + for i = 2 : nargin + if (ischar (varargin{i})) + stop_idx = i - 1; + break; + endif + endfor + + start_idx = 1; + if (ishandle (varargin{1})) + start_idx = 2; + endif + + if (stop_idx - start_idx == 1 || stop_idx - start_idx == 3) + #don't pass a color matrix c to __contour__ + stop_idx -= 1; + endif + + [c, tmp2] = __contour__ (ax, zmin, varargin{start_idx:stop_idx}); tmp = [tmp; tmp2];
--- a/scripts/plot/text.m +++ b/scripts/plot/text.m @@ -47,15 +47,33 @@ endif label = varargin{offset}; - if (ischar (label) || iscellstr (label)) - varargin(1:offset) = []; - if (ischar (label)) + varargin(1:offset) = []; + + nx = numel (x); + ny = numel (y); + nz = numel (z); + if (ischar (label) || isnumeric (label)) + nt = size (label, 1); + if (nx > 1 && nt == 1) + ## Mutiple text objects with same string + label = repmat ({label}, [nx, 1]); + nt = nx; + elseif (nx > 1 && nt == nx) + ## Mutiple text objects with different strings label = cellstr (label); + elseif (ischar (label)) + ## Single text object with one or more lines + label = {label}; endif - n = numel (label); - nx = numel (x); - ny = numel (y); - nz = numel (z); + elseif (iscell (label)) + nt = numel (label); + if (nx > 1 && nt == 1) + label = repmat ({label}, [nx, 1]); + nt = nx; + elseif (! (nx > 1 && nt == nx)) + label = {label}; + nt = 1; + endif else error ("text: expecting LABEL to be a character string or cell array of character strings"); endif @@ -63,35 +81,35 @@ x = y = z = 0; nx = ny = nz = 1; label = {""}; - n = 1; + nt = 1; endif if (rem (numel (varargin), 2) == 0) - if (nx == ny && nx == nz) + if (nx == ny && nx == nz && (nt == nx || nt == 1 || nx == 1)) pos = [x(:), y(:), z(:)]; ca = gca (); - tmp = zeros (n, 1); - if (n == 1) - label = label{1}; - for i = 1:nx - tmp(i) = __go_text__ (ca, "string", label, + tmp = zeros (nt, 1); + if (nx == 1) + ## TODO - Modify __go_text__() to accept cell-strings + tmp = __go_text__ (ca, "string", "foobar", + varargin{:}, + "position", pos); + set (tmp, "string", label{1}); + elseif (nt == nx) + for n = 1:nt + tmp(n) = __go_text__ (ca, "string", label{n}, varargin{:}, - "position", pos(i,:)); - endfor - __request_drawnow__ (); - elseif (n == nx) - for i = 1:nx - tmp(i) = __go_text__ (ca, "string", label{i}, - varargin{:}, - "position", pos(i,:)); + "position", pos(n,:)); endfor __request_drawnow__ (); else error ("text: dimension mismatch for coordinates and LABEL"); endif + elseif (nt == nx || nt == 1 || nx == 1) + error ("text: dimension mismatch for coordinates"); else - error ("text: dimension mismatch for coordinates"); + error ("text: mismatch betwween coordinates and strings"); endif if (nargout > 0) @@ -142,3 +160,91 @@ %! endfor %! caxis ([-100 100]) %! title ("Vertically Aligned at Bottom") + +%!demo +%! clf +%! axis ([0 8 0 8]) +%! title (["1st title";"2nd title"]) +%! xlabel (["1st xlabel";"2nd xlabel"]) +%! ylabel (["1st ylabel";"2nd ylabel"]) +%! text (4, 4, {"Hello", "World"}, ... +%! "horizontalalignment", "center", ... +%! "verticalalignment", "middle") +%! grid on + +%!demo +%! clf +%! h = mesh (peaks, "edgecolor", 0.7 * [1 1 1], ... +%! "facecolor", "none", ... +%! "facealpha", 0); +%! title (["1st title";"2nd title"]) +%! xlabel (["1st xlabel";"2nd xlabel"]) +%! ylabel (["1st ylabel";"2nd ylabel"]) +%! zlabel (["1st zlabel";"2nd zlabel"]) +%! text (0, 0, 5, {"Hello", "World"}, ... +%! "horizontalalignment", "center", ... +%! "verticalalignment", "middle") +%! hold on +%! plot3 (0, 0, 5, "+k") +%! + +%!demo +%! clf +%! h = text (0.5, 0.3, "char"); +%! assert ("char", class (get (h, "string"))) +%! h = text (0.5, 0.4, ["char row 1"; "char row 2"]); +%! assert ("char", class (get (h, "string"))) +%! h = text (0.5, 0.6, {"cell2str (1,1)", "cell2str (1,2)"; "cell2str (2,1)", "cell2str (2,2)"}); +%! assert ("cell", class (get (h, "string"))) +%! h = text (0.5, 0.8, "foobar"); +%! set (h, "string", 1:3) +%! h = text ([0.1, 0.1], [0.3, 0.4], "one string & two objects"); +%! assert ("char", class (get (h(1), "string"))) +%! assert ("char", class (get (h(2), "string"))) +%! h = text ([0.1, 0.1], [0.5, 0.6], {"one cellstr & two objects"}); +%! assert ("cell", class (get (h(1), "string"))) +%! assert ("cell", class (get (h(2), "string"))) +%! h = text ([0.1, 0.1], [0.7, 0.8], {"cellstr 1 object 1", "cellstr 2 object 2"}); +%! assert ("char", class (get (h(1), "string"))) +%! assert ("char", class (get (h(2), "string"))) +%! h = text ([0.1, 0.1], [0.1, 0.2], ["1st string & 1st object"; "2nd string & 2nd object"]); +%! assert ("char", class (get (h(1), "string"))) +%! assert ("char", class (get (h(2), "string"))) +%! h = text (0.7, 0.6, "single string"); +%! assert ("char", class (get (h, "string"))) +%! h = text (0.7, 0.5, {"single cell-string"}); +%! assert ("cell", class (get (h, "string"))) +%! xlabel (1:2) +%! ylabel (1:2) +%! title (1:2) + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = text (0.5, 0.3, "char"); +%! assert ("char", class (get (h, "string"))) +%! h = text (0.5, 0.4, ["char row 1"; "char row 2"]); +%! assert ("char", class (get (h, "string"))) +%! h = text (0.5, 0.6, {"cell2str (1,1)", "cell2str (1,2)"; "cell2str (2,1)", "cell2str (2,2)"}); +%! assert ("cell", class (get (h, "string"))) +%! h = text (0.5, 0.8, "foobar"); +%! set (h, "string", 1:3) +%! h = text ([0.1, 0.1], [0.3, 0.4], "one string & two objects"); +%! assert ("char", class (get (h(1), "string"))) +%! assert ("char", class (get (h(2), "string"))) +%! h = text ([0.1, 0.1], [0.5, 0.6], {"one cellstr & two objects"}); +%! assert ("cell", class (get (h(1), "string"))) +%! assert ("cell", class (get (h(2), "string"))) +%! h = text ([0.1, 0.1], [0.7, 0.8], {"cellstr 1 object 1", "cellstr 2 object 2"}); +%! assert ("char", class (get (h(1), "string"))) +%! assert ("char", class (get (h(2), "string"))) +%! h = text ([0.1, 0.1], [0.1, 0.2], ["1st string & 1st object"; "2nd string & 2nd object"]); +%! assert ("char", class (get (h(1), "string"))) +%! assert ("char", class (get (h(2), "string"))) +%! h = text (0.7, 0.6, "single string"); +%! assert ("char", class (get (h, "string"))) +%! h = text (0.7, 0.5, {"single cell-string"}); +%! assert ("cell", class (get (h, "string"))) +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/title.m +++ b/scripts/plot/title.m @@ -19,21 +19,61 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} title (@var{string}) ## @deftypefnx {Function File} {} title (@var{string}, @var{p1}, @var{v1}, @dots{}) +## @deftypefnx {Function File} {} title (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} title (@dots{}) ## Create a title object and return a handle to it. ## @end deftypefn ## Author: jwe -function h = title (string, varargin) +function retval = title (varargin) - if (rem (nargin, 2) == 1) - if (nargout > 0) - h = __axis_label__ ("title", string, varargin{:}); - else - __axis_label__ ("title", string, varargin{:}); - endif - else + [h, varargin, nargin] = __plt_get_axis_arg__ ("title", varargin{:}); + + if (rem (nargin, 2) != 1) print_usage (); endif + tmp = __axis_label__ (h, "title", varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + endfunction + +%!demo +%! clf (); +%! ax=axes(); +%! xl = get(ax,"title"); +%! title("Testing title") +%! assert(get(xl,"string"),"Testing title") + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xl = get(gca (), "title"); +%! title("Testing title") +%! assert(get(xl,"string"),"Testing title") + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! ax=axes(); +%! xl = get(ax,"title"); +%! title("Testing title") +%! assert(get(xl,"string"),"Testing title") +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! xl = get(gca (), "title"); +%! title("Testing title") +%! assert(get(xl,"string"),"Testing title") +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
rename from scripts/geometry/trimesh.m rename to scripts/plot/trimesh.m --- a/scripts/geometry/trimesh.m +++ b/scripts/plot/trimesh.m @@ -39,28 +39,29 @@ triplot (tri, x, y, z, varargin{:}); else newplot (); - if (nargout > 0) - h = patch ("Vertices", [x(:), y(:), z(:)], "Faces", tri, - "FaceColor", "none", "EdgeColor", __next_line_color__(), - varargin{:}); - else - patch ("Vertices", [x(:), y(:), z(:)], "Faces", tri, - "FaceColor", "none", "EdgeColor", __next_line_color__(), - varargin{:}); - endif - + handle = patch ("Vertices", [x(:), y(:), z(:)], "Faces", tri, + "FaceColor", "none", "EdgeColor", __next_line_color__(), + varargin{:}); if (! ishold ()) set (gca(), "view", [-37.5, 30], "xgrid", "on", "ygrid", "on", "zgrid", "on"); endif + if (nargout > 0) + h = handle; + endif endif + endfunction + %!demo +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 10); %! N = 10; -%! rand ('state', 10) %! x = 3 - 6 * rand (N, N); %! y = 3 - 6 * rand (N, N); %! z = peaks (x, y); %! tri = delaunay (x(:), y(:)); %! trimesh (tri, x(:), y(:), z(:)); +
rename from scripts/geometry/triplot.m rename to scripts/plot/triplot.m --- a/scripts/geometry/triplot.m +++ b/scripts/plot/triplot.m @@ -22,7 +22,7 @@ ## @deftypefnx {Function File} {@var{h} =} triplot (@dots{}) ## Plot a triangular mesh in 2D@. The variable @var{tri} is the triangular ## meshing of the points @code{(@var{x}, @var{y})} which is returned from -## @code{delaunay}. If given, the @var{linespec} determines the properties +## @code{delaunay}. If given, @var{linespec} determines the properties ## to use for the lines. The output argument @var{h} is the graphic handle ## of the plot. ## @seealso{plot, trimesh, trisurf, delaunay} @@ -35,19 +35,24 @@ endif idx = tri(:, [1, 2, 3, 1]).'; - nt = size (tri, 1); + nt = rows (tri); + handle = plot ([x(idx); NaN(1, nt)](:), + [y(idx); NaN(1, nt)](:), varargin{:}); + if (nargout > 0) - h = plot ([x(idx); NaN(1, nt)](:), - [y(idx); NaN(1, nt)](:), varargin{:}); - else - plot ([x(idx); NaN(1, nt)](:), - [y(idx); NaN(1, nt)](:), varargin{:}); + h = handle; endif + endfunction + %!demo -%! rand ('state', 2) -%! x = rand (20, 1); -%! y = rand (20, 1); +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 2); +%! N = 20; +%! x = rand (N, 1); +%! y = rand (N, 1); %! tri = delaunay (x, y); %! triplot (tri, x, y); +
rename from scripts/geometry/trisurf.m rename to scripts/plot/trisurf.m --- a/scripts/geometry/trisurf.m +++ b/scripts/plot/trisurf.m @@ -27,7 +27,7 @@ ## @seealso{triplot, trimesh, delaunay3} ## @end deftypefn -function varargout = trisurf (tri, x, y, z, varargin) +function h = trisurf (tri, x, y, z, varargin) if (nargin < 3) print_usage (); @@ -55,11 +55,11 @@ varargin(end+(1:2)) = {"EdgeColor", "none"}; endif newplot (); - h = patch ("Faces", tri, "Vertices", [x(:), y(:), z(:)], - "FaceVertexCData", reshape (c, numel (c), 1), - varargin{:}); + handle = patch ("Faces", tri, "Vertices", [x(:), y(:), z(:)], + "FaceVertexCData", reshape (c, numel (c), 1), + varargin{:}); if (nargout > 0) - varargout = {h}; + h = handle; endif if (! ishold ()) @@ -67,11 +67,15 @@ "xgrid", "on", "ygrid", "on", "zgrid", "on"); endif endif + endfunction + %!demo +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 10); %! N = 10; -%! rand ('state', 10) %! x = 3 - 6 * rand (N, N); %! y = 3 - 6 * rand (N, N); %! z = peaks (x, y); @@ -81,22 +85,21 @@ %!demo %! x = rand (100, 1); %! y = rand (100, 1); -%! z = x.^2 + y.^2; -%! tri = delaunay (x, y); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); %! trisurf (tri, x, y, z) %!demo %! x = rand (100, 1); %! y = rand (100, 1); -%! z = x.^2 + y.^2; -%! tri = delaunay (x, y); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); %! trisurf (tri, x, y, z, "facecolor", "interp") %!demo %! x = rand (100, 1); %! y = rand (100, 1); -%! z = x.^2 + y.^2; -%! tri = delaunay (x, y); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); %! trisurf (tri, x, y, z, "facecolor", "interp", "edgecolor", "k") -
new file mode 100644 --- /dev/null +++ b/scripts/plot/uicontextmenu.m @@ -0,0 +1,30 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uicontextmenu ('Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uicontextmenu (varargin) + + [h, args] = __uiobject_split_args__ ("uicontextmenu", varargin, {"figure"}); + handle = __go_uicontextmenu__ (h, args{:}); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/uicontrol.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uicontrol ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uicontrol (@var{parent}, 'Name', value, @dots{}) +## @deftypefnx {Function File} uicontrol (@var{handle}) +## @end deftypefn + +## Author: goffioul + +function handle = uicontrol (varargin) + + if (nargin == 1 && ishandle (varargin{1}) && strcmpi (get (varargin{1}, "type"), "uicontrol")) + error ("uicontrol focusing not implemented yet."); + else + [h, args] = __uiobject_split_args__ ("uicontrol", varargin, {"figure", "uipanel", "uibuttongroup"}); + handle = __go_uicontrol__ (h, args{:}); + endif + +endfunction
--- a/scripts/plot/uigetdir.m +++ b/scripts/plot/uigetdir.m @@ -28,10 +28,19 @@ ## Author: Kai Habel -function dirname = uigetdir (init_path = pwd, dialog_name = "Choose directory?") +function dirname = uigetdir (init_path = pwd, dialog_name = "Select Directory to Open") - if (exist("__fltk_uigetfile__") != 3) - error ("uigetfile: fltk graphics toolkit required"); + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uigetdir_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uigetdir_fltk__"; + if (! __is_function__ (funcname)) + error ("uigetdir: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uigetdir: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); + endif endif if (nargin > 2) @@ -45,9 +54,13 @@ if (!isdir (init_path)) init_path = fileparts (init_path); endif - dirname = __fltk_uigetfile__ ("", dialog_name, init_path, [240, 120], "dir"); + dirname = feval (funcname, init_path, dialog_name); endfunction %!demo %! uigetdir(pwd, "Select Directory") + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/uigetfile.m +++ b/scripts/plot/uigetfile.m @@ -64,22 +64,32 @@ function [retfile, retpath, retindex] = uigetfile (varargin) - if (exist("__fltk_uigetfile__") != 3) - error ("uigetfile: fltk graphics toolkit required"); + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uigetfile_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uigetfile_fltk__"; + if (! __is_function__ (funcname)) + error ("uigetfile: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uigetfile: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); + endif endif if (nargin > 7) error ("uigetfile: number of input arguments must be less than eight"); endif - defaultvals = {"All Files(*)", #FLTK File Filter - "Open File?", #Dialog Title - pwd, #FLTK default file name - [240, 120], #Dialog Position (pixel x/y) - "off"}; #MultiSelect on/off + defaultvals = {cell(0, 2), # File Filter + "Open File", # Dialog Title + "", # Default file name + [240, 120], # Dialog Position (pixel x/y) + "off", # MultiSelect on/off + pwd}; # Default directory - outargs = cell (5, 1); - for i = 1 : 5 + outargs = cell (6, 1); + for i = 1 : 6 outargs{i} = defaultvals{i}; endfor @@ -88,9 +98,9 @@ for i = 1 : length (varargin) val = varargin{i}; if (ischar (val)) - if (strncmp (tolower (val), "multiselect", 11)) + if (strncmpi (val, "multiselect", 11)) idx1 = i; - elseif (strncmp(tolower (val), "position", 8)) + elseif (strncmpi (val, "position", 8)) idx2 = i; endif endif @@ -110,18 +120,36 @@ len = length (args); if (len > 0) file_filter = args{1}; - outargs{1} = __fltk_file_filter__ (file_filter); - if (ischar (file_filter)) - outargs{3} = file_filter; + [outargs{1}, outargs{3}, defdir] = __file_filter__ (file_filter); + if (length (defdir) > 0) + outargs{6} = defdir; + endif + else + outargs{1} = __file_filter__ (outargs{1}); + endif + + if (len > 1) + if (ischar (args{2})) + if (length (args{2}) > 0) + outargs{2} = args{2}; + endif + elseif (! isempty (args{2})) + print_usage (); endif endif - if (len > 1) - outargs{2} = args{2}; - endif - if (len > 2) - outargs{3} = args{3}; + if (ischar (args{3})) + [fdir, fname, fext] = fileparts (args{3}); + if (length (fdir) > 0) + outargs{6} = fdir; + endif + if (length (fname) > 0 || length (fext) > 0) + outargs{3} = strcat (fname, fext); + endif + elseif (! isempty (args{3})) + print_usage (); + endif endif if (stridx) @@ -153,9 +181,13 @@ endfor endif - [retfile, retpath, retindex] = __fltk_uigetfile__ (outargs{:}); + [retfile, retpath, retindex] = feval (funcname, outargs{:}); endfunction %!demo %! uigetfile({"*.gif;*.png;*.jpg", "Supported Picture Formats"}) + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/uimenu.m +++ b/scripts/plot/uimenu.m @@ -66,8 +66,10 @@ ## @group ## f = uimenu("label", "&File", "accelerator", "f"); ## e = uimenu("label", "&Edit", "accelerator", "e"); -## uimenu(f, "label", "Close", "accelerator", "q", "callback", "close (gcf)"); -## uimenu(e, "label", "Toggle &Grid", "accelerator", "g", "callback", "grid (gca)"); +## uimenu(f, "label", "Close", "accelerator", "q", ... +## "callback", "close (gcf)"); +## uimenu(e, "label", "Toggle &Grid", "accelerator", "g", ... +## "callback", "grid (gca)"); ## @end group ## @end example ## @seealso{figure} @@ -77,18 +79,7 @@ function hui = uimenu (varargin) - args = varargin; - - if (ishandle (args{1})) - h = args{1}; - args(1) = []; - else - h = gcf (); - endif - - if (rem (length (args), 2)) - error ("uimenu: expecting PROPERTY/VALUE pairs"); - endif + [h, args] = __uiobject_split_args__ ("uimenu", varargin, {"figure", "uicontextmenu", "uimenu"}); tmp = __go_uimenu__ (h, args{:}); @@ -106,3 +97,41 @@ %! e = uimenu("label", "&Edit", "accelerator", "e"); %! uimenu(f, "label", "Close", "accelerator", "q", "callback", "close (gcf)"); %! uimenu(e, "label", "Toggle &Grid", "accelerator", "g", "callback", "grid (gca)"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! ui = uimenu ("label", "mylabel"); +%! assert (findobj (hf, "type", "uimenu"), ui); +%! assert (get (ui, "label"), "mylabel"); +%! assert (get (ui, "checked"), "off"); +%! assert (get (ui, "separator"), "off"); +%! assert (get (ui, "enable"), "on"); +%! assert (get (ui, "position"), 9); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%% check for top level menus file, edit, and help +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! uif = findall (hf, "label", "&file"); +%! assert (ishghandle (uif)) +%! uie = findall (hf, "label", "&edit"); +%! assert (ishghandle (uie)) +%! uih = findall (hf, "label", "&help"); +%! assert (ishghandle (uih)) +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! uie = findall (hf, "label", "&edit"); +%! myui = uimenu (uie, "label", "mylabel"); +%! assert (ancestor (myui, "uimenu", "toplevel"), uie) +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
new file mode 100644 --- /dev/null +++ b/scripts/plot/uipanel.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uipanel ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uipanel (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uipanel (varargin) + + [h, args] = __uiobject_split_args__ ("uipanel", varargin, {"figure", "uipanel", "uibuttongroup"}); + handle = __go_uipanel__ (h, args{:}); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/uipushtool.m @@ -0,0 +1,39 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uipushtool ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uipushtool (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uipushtool (varargin) + + [h, args] = __uiobject_split_args__ ("uipushtool", varargin, {"uitoolbar"}, 0); + if (isempty (h)) + h = findobj (gcf, "-depth", 1, "type", "uitoolbar"); + if (isempty (h)) + h = uitoolbar (); + else + h = h(1); + endif + endif + handle = __go_uipushtool__ (h, args{:}); + +endfunction
--- a/scripts/plot/uiputfile.m +++ b/scripts/plot/uiputfile.m @@ -55,44 +55,74 @@ function [retfile, retpath, retindex] = uiputfile (varargin) - if (exist("__fltk_uigetfile__") != 3) - error ("uiputfile: fltk graphics toolkit required"); + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uiputfile_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uiputfile_fltk__"; + if (! __is_function__ (funcname)) + error ("uiputfile: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uiputfile: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); + endif endif if (nargin > 3) print_usage (); endif - defaultvals = {"All Files(*)", #FLTK File Filter - "Save File?", #Dialog Title - pwd, #FLTK default file name - [240, 120], #Dialog Position (pixel x/y) - "create"}; + defaultvals = {cell(0, 2), # File Filter + "Save File", # Dialog Title + "", # Default file name + [240, 120], # Dialog Position (pixel x/y) + "create", + pwd}; # Default directory - outargs = cell(5, 1); - for i = 1 : 5 + outargs = cell(6, 1); + for i = 1 : 6 outargs{i} = defaultvals{i}; endfor if (nargin > 0) file_filter = varargin{1}; - outargs{1} = __fltk_file_filter__ (file_filter); - if (ischar (file_filter)) - outargs{3} = file_filter; + [outargs{1}, outargs{3}, defdir] = __file_filter__ (file_filter); + if (length (defdir) > 0) + outargs{6} = defdir; endif + else + outargs{1} = __file_filter__ (outargs{1}); endif if (nargin > 1) - outargs{2} = varargin{2}; + if (ischar (varargin{2})) + outargs{2} = varargin{2}; + elseif (! isempty (varargin{2})) + print_usage (); + endif endif if (nargin > 2) - outargs{3} = varargin{3}; + if (ischar (varargin{3})) + [fdir, fname, fext] = fileparts (varargin{3}); + if (! isempty (fdir)) + outargs{6} = fdir; + endif + if (! isempty (fname) || ! isempty (fext)) + outargs{3} = strcat (fname, fext); + endif + elseif (! isempty (varargin{3})) + print_usage (); + endif endif - [retfile, retpath, retindex] = __fltk_uigetfile__ (outargs{:}); + [retfile, retpath, retindex] = feval (funcname, outargs{:}); endfunction %!demo %! uiputfile({"*.gif;*.png;*.jpg", "Supported Picture Formats"}) + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
new file mode 100644 --- /dev/null +++ b/scripts/plot/uitoggletool.m @@ -0,0 +1,39 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uitoggletool ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uitoggletool (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uitoggletool (varargin) + + [h, args] = __uiobject_split_args__ ("uitoggletool", varargin, {"uitoolbar"}, 0); + if (isempty (h)) + h = findobj (gcf, "-depth", 1, "type", "uitoolbar"); + if (isempty (h)) + h = uitoolbar (); + else + h = h(1); + endif + endif + handle = __go_uitoggletool__ (h, args{:}); + +endfunction
new file mode 100644 --- /dev/null +++ b/scripts/plot/uitoolbar.m @@ -0,0 +1,31 @@ +## Copyright (C) 2011 Michael Goffioul +## +## 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uitoolbar ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uitoolbar (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uitoolbar (varargin) + + [h, args] = __uiobject_split_args__ ("uitoolbar", varargin, {"figure"}); + handle = __go_uitoolbar__ (h, args{:}); + +endfunction
--- a/scripts/plot/view.m +++ b/scripts/plot/view.m @@ -93,3 +93,32 @@ endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! [az, el] = view; +%! assert ([az, el], [-37.5, 30], eps); +%! view (2); +%! [az, el] = view; +%! assert ([az, el], [0, 90], eps); +%! view ([1 1 0]); +%! [az, el] = view; +%! assert ([az, el], [135, 0], eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! line; +%! [az, el] = view; +%! assert ([az, el], [0, 90], eps); +%! view (3); +%! [az, el] = view; +%! assert ([az, el], [-37.5, 30], eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
new file mode 100644 --- /dev/null +++ b/scripts/plot/waitbar.m @@ -0,0 +1,183 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} waitbar (@var{frac}) +## @deftypefnx {Function File} {@var{h} =} waitbar (@var{frac}, @var{msg}) +## @deftypefnx {Function File} {@var{h} =} waitbar (@dots{}, "FigureProperty", "Value", @dots{}) +## @deftypefnx {Function File} {} waitbar (@var{frac}) +## @deftypefnx {Function File} {} waitbar (@var{frac}, @var{hwbar}) +## @deftypefnx {Function File} {} waitbar (@var{frac}, @var{hwbar}, @var{msg}) +## Return a handle @var{h} to a new waitbar object. The waitbar is +## filled to fraction @var{frac} which must be in the range [0, 1]. The +## optional message @var{msg} is centered and displayed above the waitbar. +## The appearance of the waitbar figure window can be configured by passing +## property/value pairs to the function. +## +## When called with a single input the current waitbar, if it exists, is +## updated to the new value @var{frac}. If there are multiple outstanding +## waitbars they can be updated individually by passing the handle @var{hwbar} +## of the specific waitbar to modify. +## @end deftypefn + +## Author: jwe + +function retval = waitbar (varargin) + + persistent curr_waitbar; + + if (nargin < 1) + print_usage (); + endif + + frac = varargin{1}; + varargin(1) = []; + + if (! (isnumeric (frac) && isscalar (frac) && frac >= 0 && frac <= 1)) + error ("waitbar: FRAC must be between 0 and 1"); + endif + + ## Use existing waitbar if it still points to a valid graphics handle. + if (nargin == 1 && ishandle (curr_waitbar)) + h = curr_waitbar; + else + h = false; + endif + + if (! isempty (varargin) && isnumeric (varargin{1})) + if (! ishandle (varargin{1})) + error ("waitbar: H must be a handle to a waitbar object"); + else + h = varargin{1}; + varargin(1) = []; + if (! isfigure (h) || ! strcmp (get (h, "tag"), "waitbar")) + error ("waitbar: H must be a handle to a waitbar object"); + endif + endif + endif + + msg = false; + + if (! isempty (varargin)) + msg = varargin{1}; + varargin(1) = []; + if (! ischar (msg)) + error ("waitbar: MSG must be a character string"); + endif + endif + + if (rem (numel (varargin), 2) != 0) + error ("waitbar: invalid number of property-value pairs"); + endif + + if (h) + p = findobj (h, "type", "patch"); + set (p, "xdata", [0; frac; frac; 0]); + ax = findobj (h, "type", "axes"); + if (ischar (msg)) + th = get (ax, "title"); + curr_msg = get (th, "string"); + if (! strcmp (msg, curr_msg)) + set (th, "string", msg); + endif + endif + else + h = __go_figure__ (NaN, "position", [250, 500, 400, 100], + "numbertitle", "off", + "toolbar", "none", "menubar", "none", + "integerhandle", "off", + "handlevisibility", "callback", + "tag", "waitbar", + varargin{:}); + + ax = axes ("parent", h, "xtick", [], "ytick", [], + "xlim", [0, 1], "ylim", [0, 1], + "xlimmode", "manual", "ylimmode", "manual", + "position", [0.1, 0.3, 0.8, 0.2]); + + patch (ax, [0; frac; frac; 0], [0; 0; 1; 1], [0, 0.35, 0.75]); + + if (! ischar (msg)) + msg = "Please wait..."; + endif + title (ax, msg); + endif + + drawnow (); + + if (nargout > 0) + retval = h; + endif + + ## If there were no errors, update current waitbar. + curr_waitbar = h; + +endfunction + + +%!demo +%! h = waitbar (0, "0.00%"); +%! for i = 0:0.01:1 +%! waitbar (i, h, sprintf ("%.2f%%", 100*i)); +%! endfor +%! close (h); + +%!demo +%! h = waitbar (0, "please wait..."); +%! for i = 0:0.01:0.6 +%! waitbar (i); +%! endfor +%! i = 0.3 +%! waitbar (i, h, "don't you hate taking a step backward?") +%! pause (0.5); +%! for i = i:0.005:0.7 +%! waitbar (i, h); +%! endfor +%! waitbar (i, h, "or stalling?") +%! pause (1); +%! for i = i:0.003:0.8 +%! waitbar (i, h, "just a little longer now") +%! endfor +%! for i = i:0.001:1 +%! waitbar (i, h, "please don't be impatient") +%! endfor +%! close (h); + +%!demo +%! h1 = waitbar (0, "Waitbar #1"); +%! h2 = waitbar (0, "Waitbar #2"); +%! h2pos = get (h2, "position"); +%! h2pos(1) += h2pos(3) + 50; +%! set (h2, "position", h2pos); +%! pause (0.5); +%! for i = 1:4 +%! waitbar (i/4, h1); +%! pause (0.5); +%! waitbar (i/4, h2); +%! pause (0.5); +%! endfor +%! pause (0.5); +%! close (h1); +%! close (h2); + +%% Test input validation +%!error <FRAC must be between 0 and 1> waitbar (-0.5) +%!error <FRAC must be between 0 and 1> waitbar (1.5) +%!error <MSG must be a character string> waitbar (0.5, struct ()) +%!error <invalid number of property-value pairs> waitbar (0.5, "msg", "Name") +
--- a/scripts/plot/whitebg.m +++ b/scripts/plot/whitebg.m @@ -40,7 +40,7 @@ h = 0; color = NaN; - if (nargin > 0 && nargin < 2) + if (nargin > 0 && nargin < 3) if (ishandle (varargin{1})) h = varargin{1}; if (nargin == 2) @@ -74,7 +74,7 @@ if (isroot) fac = get (0, "factory"); fields = fieldnames (fac); - fieldindex = intersect (find (!cellfun (@isempty, regexp(fields, 'color'))), union (find (!cellfun (@isempty, regexp(fields, 'factoryaxes.*'))), find (!cellfun (@isempty, regexp(fields, 'factoryfigure.*'))))); + fieldindex = intersect (find (!cellfun ("isempty", regexp(fields, 'color'))), union (find (!cellfun ("isempty", regexp(fields, 'factoryaxes.*'))), find (!cellfun ("isempty", regexp(fields, 'factoryfigure.*'))))); ## Check whether the factory value has been replaced for nf = 1 : numel (fieldindex); @@ -104,7 +104,7 @@ for nh = 1 : numel(h) p = get (h (nh)); fields = fieldnames (p); - fieldindex = find (!cellfun (@isempty, regexp(fields, 'color'))); + fieldindex = find (!cellfun ("isempty", regexp(fields, 'color'))); if (numel (fieldindex)) for nf = 1 : numel (fieldindex); field = fields {fieldindex (nf)}; @@ -121,7 +121,7 @@ def = get (h (nh), "default"); fields = fieldnames (def); if (! isempty (fields)) - fieldindex = find (!cellfun (@isempty, regexp(fields, 'color'))); + fieldindex = find (!cellfun ("isempty", regexp(fields, 'color'))); for nf = 1 : numel (fieldindex) defaultfield = fields {fieldindex (nf)}; defaultvalue = 1 - subsref (def, struct ("type", ".", "subs", defaultfield)); @@ -143,3 +143,22 @@ endif endif endfunction + +%!test +%! dac = get (0, "defaultaxescolor"); +%! dfc = get (0, "defaultfigurecolor"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (get (hf, "color"), dfc); +%! assert (get (gca, "color"), dac); +%! whitebg (hf); +%! assert (get (hf, "color"), 1 - dfc); +%! assert (get (gca, "color"), 1 - dac); +%! c = [0.2 0.2 0.2]; +%! whitebg (hf, c); +%! assert (get (hf, "color"), 1 - dfc); +%! assert (get (gca, "color"), c); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/xlabel.m +++ b/scripts/plot/xlabel.m @@ -39,17 +39,23 @@ print_usage (); endif - oldh = gca (); - unwind_protect - axes (h); - tmp = __axis_label__ ("xlabel", varargin{:}, - "color", get (h, "xcolor")); - unwind_protect_cleanup - axes (oldh); - end_unwind_protect + tmp = __axis_label__ (h, "xlabel", varargin{:}, + "color", get (h, "xcolor")); if (nargout > 0) retval = tmp; endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! x = xlabel ("xlabel_string"); +%! assert (get(gca, "xlabel"), x); +%! assert (get(x, "type"), "text"); +%! assert (get(x, "visible"), "on"); +%! assert (get(x, "string"), "xlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/xlim.m +++ b/scripts/plot/xlim.m @@ -44,3 +44,53 @@ retval = ret; endif endfunction + +%!demo +%! clf (); +%! line (); +%! xlim ([0.2, 0.8]); +%! title ("xlim is [0.2, 0.8]"); +%! assert (xlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! xlim ('auto'); +%! title ("xlim is auto"); +%! assert (xlim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ([0.2, 0.8]); +%! title ("xlim is [0.2, 0.8]"); +%! assert (xlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ('auto'); +%! title ("xlim is auto"); +%! assert (xlim ("mode"), "auto"); + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ([0, 1.1]); +%! assert (get (gca, "xlim"), [0, 1.1], eps); +%! assert (xlim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = plot3 ([0,1.1], [0,1], [0, 1]); +%! assert (get (gca, "xlim"), [0, 1.4], eps); +%! assert (xlim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/ylabel.m +++ b/scripts/plot/ylabel.m @@ -33,17 +33,23 @@ print_usage (); endif - oldh = gca (); - unwind_protect - axes (h); - tmp = __axis_label__ ("ylabel", varargin{:}, - "color", get (h, "ycolor")); - unwind_protect_cleanup - axes (oldh); - end_unwind_protect + tmp = __axis_label__ (h, "ylabel", varargin{:}, + "color", get (h, "ycolor")); if (nargout > 0) retval = tmp; endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! y = ylabel ("ylabel_string"); +%! assert (get(gca, "ylabel"), y); +%! assert (get(y, "type"), "text"); +%! assert (get(y, "visible"), "on"); +%! assert (get(y, "string"), "ylabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/ylim.m +++ b/scripts/plot/ylim.m @@ -44,3 +44,53 @@ retval = ret; endif endfunction + +%!demo +%! clf (); +%! line (); +%! ylim ([0.2, 0.8]); +%! title ("ylim is [0.2, 0.8]"); +%! assert (ylim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! ylim ('auto'); +%! title ("ylim is auto"); +%! assert (ylim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim ([0.2, 0.8]); +%! title ("ylim is [0.2, 0.8]"); +%! assert (ylim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim ('auto'); +%! title ("ylim is auto"); +%! assert (ylim ("mode"), "auto"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! limy = [0, 1.1]; +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim (limy); +%! assert (get (gca, "ylim"), limy, eps); +%! assert (ylim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1.1], [0, 1]); +%! assert (get (gca, "ylim"), [0, 1.4], eps); +%! assert (ylim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/zlabel.m +++ b/scripts/plot/zlabel.m @@ -33,17 +33,36 @@ print_usage (); endif - oldh = gca (); - unwind_protect - axes (h); - tmp = __axis_label__ ("zlabel", varargin{:}, - "color", get (h, "zcolor")); - unwind_protect_cleanup - axes (oldh); - end_unwind_protect + tmp = __axis_label__ (h, "zlabel", varargin{:}, + "color", get (h, "zcolor")); if (nargout > 0) retval = tmp; endif endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! z = zlabel ("zlabel_string"); +%! assert (get(gca, "zlabel"), z); +%! assert (get(z, "type"), "text"); +%! assert (get(z, "visible"), "off"); +%! assert (get(z, "string"), "zlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! plot3 (0, 0, 0); +%! unwind_protect +%! z = zlabel ("zlabel_string"); +%! assert (get(gca, "zlabel"), z); +%! assert (get(z, "type"), "text"); +%! assert (get(z, "visible"), "off"); +%! assert (get(z, "string"), "zlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/plot/zlim.m +++ b/scripts/plot/zlim.m @@ -44,3 +44,53 @@ retval = ret; endif endfunction + +%!demo +%! clf (); +%! line (); +%! zlim ([0.2, 0.8]); +%! title ("zlim is [0.2, 0.8]"); +%! assert (zlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! zlim ('auto'); +%! title ("zlim is auto"); +%! assert (zlim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim ([0.2, 0.8]); +%! title ("zlim is [0.2, 0.8]"); +%! assert (zlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim ('auto'); +%! title ("zlim is auto"); +%! assert (zlim ("mode"), "auto"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! limz = [0, 1.1]; +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim (limz); +%! assert (get (gca, "zlim"), limz, eps); +%! assert (zlim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0, 1.1]); +%! assert (get (gca, "zlim"), [0, 1.4], eps); +%! assert (zlim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect
--- a/scripts/polynomial/conv.m +++ b/scripts/polynomial/conv.m @@ -19,12 +19,12 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} conv (@var{a}, @var{b}) ## @deftypefnx {Function File} {} conv (@var{a}, @var{b}, @var{shape}) -## Convolve two vectors. +## Convolve two vectors @var{a} and @var{b}. ## -## @code{c = conv (@var{a}, @var{b})} returns a vector of length equal to +## The output convolution is a vector with length equal to ## @code{length (@var{a}) + length (@var{b}) - 1}. -## If @var{a} and @var{b} are the coefficient vectors of two polynomials, the -## returned value is the coefficient vector of the product polynomial. +## When @var{a} and @var{b} are the coefficient vectors of two polynomials, the +## convolution represents the coefficient vector of the product polynomial. ## ## The optional @var{shape} argument may be ## @@ -50,7 +50,9 @@ endif if (! (isvector (a) && isvector (b))) - error ("conv: both arguments must be vectors"); + error ("conv: both arguments A and B must be vectors"); + elseif (nargin == 3 && ! any (strcmpi (shape, {"full", "same"}))) + error ('conv: SHAPE argument must be "full" or "same"'); endif la = length (a); @@ -60,40 +62,31 @@ if (ly == 0) y = zeros (1, 0); - else - ## Use the shortest vector as the coefficent vector to filter. - ## Preserve the row/column orientation of the longer input. - if (la <= lb) - if (ly > lb) - if (size (b, 1) <= size (b, 2)) - x = [b, (zeros (1, ly - lb))]; - else - x = [b; (zeros (ly - lb, 1))]; - endif - else - x = b; - endif - y = filter (a, 1, x); - else - if (ly > la) - if (size (a, 1) <= size (a, 2)) - x = [a, (zeros (1, ly - la))]; - else - x = [a; (zeros (ly - la, 1))]; - endif - else - x = a; - endif - y = filter (b, 1, x); - endif - if (strcmp (shape, "same")) - idx = ceil ((ly - la) / 2); - y = y(idx+1:idx+la); - endif + return; + endif + + ## Use shortest vector as the coefficent vector to filter. + if (la > lb) + [a, b] = deal (b, a); # Swap vectors + lb = la; + endif + x = b; + + ## Pad longer vector to convolution length. + if (ly > lb) + x(end+1:end+ly-lb) = 0; + endif + + y = filter (a, 1, x); + + if (strcmp (shape, "same")) + idx = ceil ((ly - la) / 2); + y = y(idx+1:idx+la); endif endfunction + %!test %! x = ones(3,1); %! y = ones(1,3); @@ -112,35 +105,37 @@ %!test %! a = 1:10; %! b = 1:3; -%! assert (size(conv(a,b)), [1, numel(a)+numel(b)-1]) -%! assert (size(conv(b,a)), [1, numel(a)+numel(b)-1]) +%! assert (size (conv(a,b)), [1, numel(a)+numel(b)-1]); +%! assert (size (conv(b,a)), [1, numel(a)+numel(b)-1]); +%!test %! a = (1:10).'; %! b = 1:3; -%! assert (size(conv(a,b)), [numel(a)+numel(b)-1, 1]) -%! assert (size(conv(b,a)), [numel(a)+numel(b)-1, 1]) +%! assert (size (conv(a,b)), [numel(a)+numel(b)-1, 1]); +%! assert (size (conv(b,a)), [numel(a)+numel(b)-1, 1]); %!test %! a = 1:10; %! b = (1:3).'; -%! assert (size(conv(a,b)), [1, numel(a)+numel(b)-1]) -%! assert (size(conv(b,a)), [1, numel(a)+numel(b)-1]) +%! assert (size (conv(a,b)), [1, numel(a)+numel(b)-1]); +%! assert (size (conv(b,a)), [1, numel(a)+numel(b)-1]); %!test %! a = 1:10; %! b = 1:3; -%! assert (conv(a,b,"full"), conv(a,b)) -%! assert (conv(b,a,"full"), conv(b,a)) +%! assert (conv (a,b,"full"), conv (a,b)); +%! assert (conv (b,a,"full"), conv (b,a)); %!test %! a = 1:10; %! b = 1:3; -%! assert (conv(a,b,'same'), [4, 10, 16, 22, 28, 34, 40, 46, 52, 47]) -%! assert (conv(b,a,'same'), [28, 34, 40]) +%! assert (conv (a,b,"same"), [4, 10, 16, 22, 28, 34, 40, 46, 52, 47]); +%! assert (conv (b,a,"same"), [28, 34, 40]); %% Test input validation -%!error conv (1); -%!error conv (1,2,3,4); -%!error conv ([1, 2; 3, 4], 3); -%!error conv (2, []); +%!error conv (1) +%!error conv (1,2,3,4) +%!error conv ([1, 2; 3, 4], 3) +%!error conv (3, [1, 2; 3, 4]) +%!error conv (2, 3, "XXXX")
--- a/scripts/polynomial/mkpp.m +++ b/scripts/polynomial/mkpp.m @@ -17,50 +17,66 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{pp} =} mkpp (@var{x}, @var{p}) -## @deftypefnx {Function File} {@var{pp} =} mkpp (@var{x}, @var{p}, @var{d}) +## @deftypefn {Function File} {@var{pp} =} mkpp (@var{breaks}, @var{coefs}) +## @deftypefnx {Function File} {@var{pp} =} mkpp (@var{breaks}, @var{coefs}, @var{d}) +## +## Construct a piece-wise polynomial (pp) structure from sample points +## @var{breaks} and coefficients @var{coefs}. @var{breaks} must be a vector of +## strictly increasing values. The number of intervals is given by +## @code{@var{ni} = length (@var{breaks}) - 1}. +## When @var{m} is the polynomial order @var{coefs} must be of +## size: @var{ni} x @var{m} + 1. ## -## Construct a piecewise polynomial structure from sample points -## @var{x} and coefficients @var{p}. The i-th row of @var{p}, -## @code{@var{p} (@var{i},:)}, contains the coefficients for the polynomial -## over the @var{i}-th interval, ordered from highest to -## lowest. There must be one row for each interval in @var{x}, so -## @code{rows (@var{p}) == length (@var{x}) - 1}. +## The i-th row of @var{coefs}, +## @code{@var{coefs} (@var{i},:)}, contains the coefficients for the polynomial +## over the @var{i}-th interval, ordered from highest (@var{m}) to +## lowest (@var{0}). ## -## @var{p} may also be a multi-dimensional array, specifying a vector-valued -## or array-valued polynomial. The shape is determined by @var{d}. If @var{d} -## is -## not given, the default is @code{size (p)(1:end-2)}. If @var{d} is given, the -## leading dimensions of @var{p} are reshaped to conform to @var{d}. +## @var{coefs} may also be a multi-dimensional array, specifying a vector-valued +## or array-valued polynomial. In that case the polynomial order is defined +## by the length of the last dimension of @var{coefs}. +## The size of first dimension(s) are given by the scalar or +## vector @var{d}. If @var{d} is not given it is set to @code{1}. +## In any case @var{coefs} is reshaped to a 2d matrix of +## size @code{[@var{ni}*prod(@var{d} @var{m})] } ## ## @seealso{unmkpp, ppval, spline} ## @end deftypefn function pp = mkpp (x, P, d) + + # check number of arguments if (nargin < 2 || nargin > 3) print_usage (); endif - pp.x = x(:); - n = length (x) - 1; - if (n < 1) + + # check x + if (length (x) < 2) error ("mkpp: at least one interval is needed"); endif - nd = ndims (P); - k = size (P, nd); - if (nargin < 3) - if (nd == 2) - d = 1; - else - d = prod (size (P)(1:nd-1)); - endif + + if (!isvector (x)) + error ("mkpp: x must be a vector"); endif - pp.d = d; - pp.P = P = reshape (P, prod (d), [], k); - pp.orient = 0; + + len = length (x) - 1; + dP = length (size (P)); - if (size (P, 2) != n) - error ("mkpp: num intervals in X doesn't match num polynomials in P"); + pp = struct ("form", "pp", + "breaks", x(:).', + "coefs", [], + "pieces", len, + "order", prod (size (P)) / len, + "dim", 1); + + if (nargin == 3) + pp.dim = d; + pp.order /= prod (d); endif + + dim_vec = [pp.pieces * prod(pp.dim), pp.order]; + pp.coefs = reshape (P, dim_vec); + endfunction %!demo # linear interpolation @@ -72,3 +88,25 @@ %! xi=linspace(0,pi,50); %! plot(x,t,"x",xi,ppval(pp,xi)); %! legend("control","interp"); + +%!shared b,c,pp +%! b = 1:3; c = 1:24; pp=mkpp(b,c); +%!assert (pp.pieces,2); +%!assert (pp.order,12); +%!assert (pp.dim,1); +%!assert (size(pp.coefs),[2,12]); +%! pp=mkpp(b,c,2); +%!assert (pp.pieces,2); +%!assert (pp.order,6); +%!assert (pp.dim,2); +%!assert (size(pp.coefs),[4,6]); +%! pp=mkpp(b,c,3); +%!assert (pp.pieces,2); +%!assert (pp.order,4); +%!assert (pp.dim,3); +%!assert (size(pp.coefs),[6,4]); +%! pp=mkpp(b,c,[2,3]); +%!assert (pp.pieces,2); +%!assert (pp.order,2); +%!assert (pp.dim,[2,3]); +%!assert (size(pp.coefs),[12,2]);
--- a/scripts/polynomial/module.mk +++ b/scripts/polynomial/module.mk @@ -10,7 +10,6 @@ polynomial/poly.m \ polynomial/polyaffine.m \ polynomial/polyder.m \ - polynomial/polyderiv.m \ polynomial/polyfit.m \ polynomial/polygcd.m \ polynomial/polyint.m \
--- a/scripts/polynomial/pchip.m +++ b/scripts/polynomial/pchip.m @@ -27,8 +27,8 @@ ## ## The variable @var{x} must be a strictly monotonic vector (either ## increasing or decreasing). While @var{y} can be either a vector or -## array. In the case where @var{y} is a vector, it must have a length -## of @var{n}. If @var{y} is an array, then the size of @var{y} must +## an array. In the case where @var{y} is a vector, it must have the +## length @var{n}. If @var{y} is an array, then the size of @var{y} must ## have the form ## @tex ## $$[s_1, s_2, \cdots, s_k, n]$$ @@ -73,15 +73,22 @@ print_usage (); endif + ## make row vector x = x(:).'; n = length (x); ## Check the size and shape of y if (isvector (y)) - y = y(:).'; + y = y(:).'; ##row vector szy = size (y); + if !(size_equal (x, y)) + error ("pchip: length of X and Y must match") + endif else szy = size (y); + if (n != szy(end)) + error ("pchip: length of X and last dimension of Y must match") + endif y = reshape (y, [prod(szy(1:end-1)), szy(end)]); endif @@ -94,16 +101,12 @@ error("pchip: X must be strictly monotonic"); endif - if (columns (y) != n) - error("pchip: size of X and Y must match"); - endif - - f1 = y(:,1:n-1); + f1 = y(:, 1:n-1); ## Compute derivatives. d = __pchip_deriv__ (x, y, 2); - d1 = d(:,1:n-1); - d2 = d(:,2:n); + d1 = d(:, 1:n-1); + d2 = d(:, 2:n); ## This is taken from SLATEC. h = diag (h); @@ -114,14 +117,12 @@ c3 = del1 + del2; c2 = -c3 - del1; c3 = c3 / h; - coeffs = cat (3, c3, c2, d1, f1); - pp = mkpp (x, coeffs, szy(1:end-1)); - if (nargin == 2) - ret = pp; - else - ret = ppval (pp, xi); + ret = mkpp (x, coeffs, szy(1:end-1)); + + if (nargin == 3) + ret = ppval (ret, xi); endif endfunction @@ -138,7 +139,7 @@ %! %------------------------------------------------------------------- %! % confirm that pchip agreed better to discontinuous data than spline -%!shared x,y +%!shared x,y,y2,pp,yi1,yi2,yi3 %! x = 0:8; %! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0]; %!assert (pchip(x,y,x), y); @@ -148,3 +149,23 @@ %!assert (isempty(pchip(x',y',[]))); %!assert (isempty(pchip(x,y,[]))); %!assert (pchip(x,[y;y],x), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x,[y;y],x'), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x',[y;y],x), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x',[y;y],x'), [pchip(x,y,x);pchip(x,y,x)]) +%!test +%! x=(0:8)*pi/4;y=[sin(x);cos(x)]; +%! y2(:,:,1)=y;y2(:,:,2)=y+1;y2(:,:,3)=y-1; +%! pp=pchip(x,shiftdim(y2,2)); +%! yi1=ppval(pp,(1:4)*pi/4); +%! yi2=ppval(pp,repmat((1:4)*pi/4,[5,1])); +%! yi3=ppval(pp,[pi/2,pi]); +%!assert(size(pp.coefs),[48,4]); +%!assert(pp.pieces,8); +%!assert(pp.order,4); +%!assert(pp.dim,[3,2]); +%!assert(ppval(pp,pi),[0,-1;1,0;-1,-2],1e-14); +%!assert(yi3(:,:,2),ppval(pp,pi),1e-14); +%!assert(yi3(:,:,1),[1,0;2,1;0,-1],1e-14); +%!assert(squeeze(yi1(1,2,:)),[1/sqrt(2); 0; -1/sqrt(2);-1],1e-14); +%!assert(size(yi2),[3,2,5,4]); +%!assert(squeeze(yi2(1,2,3,:)),[1/sqrt(2); 0; -1/sqrt(2);-1],1e-14); \ No newline at end of file
--- a/scripts/polynomial/polyder.m +++ b/scripts/polynomial/polyder.m @@ -1,4 +1,4 @@ -## Copyright (C) 1995-2011 John W. Eaton +## Copyright (C) 1994-2011 John W. Eaton ## ## This file is part of Octave. ## @@ -17,27 +17,84 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} polyderiv (@var{p}) -## @deftypefnx {Function File} {[@var{k}] =} polyderiv (@var{a}, @var{b}) -## @deftypefnx {Function File} {[@var{q}, @var{d}] =} polyderiv (@var{b}, @var{a}) -## An alias for @code{polyderiv}. -## @seealso{polyderiv} +## @deftypefn {Function File} {} polyder (@var{p}) +## @deftypefnx {Function File} {[@var{k}] =} polyder (@var{a}, @var{b}) +## @deftypefnx {Function File} {[@var{q}, @var{d}] =} polyder (@var{b}, @var{a}) +## Return the coefficients of the derivative of the polynomial whose +## coefficients are given by the vector @var{p}. If a pair of polynomials +## is given, return the derivative of the product @math{@var{a}*@var{b}}. +## If two inputs and two outputs are given, return the derivative of the +## polynomial quotient @math{@var{b}/@var{a}}. The quotient numerator is +## in @var{q} and the denominator in @var{d}. +## @seealso{poly, polyint, polyreduce, roots, conv, deconv, residue, +## filter, polygcd, polyval, polyvalm} ## @end deftypefn -## Author: John W. Eaton +## Author: Tony Richardson <arichard@stark.cc.oh.us> +## Created: June 1994 +## Adapted-By: jwe function [q, d] = polyder (p, a) - if (nargin == 1) - q = polyderiv (p); - elseif (nargin == 2) - if (nargout == 2) - [q, d] = polyderiv (p, a); + if (nargin == 1 || nargin == 2) + if (! isvector (p)) + error ("polyder: argument must be a vector"); + endif + if (nargin == 2) + if (! isvector (a)) + error ("polyder: argument must be a vector"); + endif + if (nargout == 1) + ## derivative of p*a returns a single polynomial + q = polyder (conv (p, a)); + else + ## derivative of p/a returns numerator and denominator + d = conv (a, a); + if (numel (p) == 1) + q = -p * polyder (a); + elseif (numel (a) == 1) + q = a * polyder (p); + else + q = conv (polyder (p), a) - conv (p, polyder (a)); + q = polyreduce (q); + endif + + ## remove common factors from numerator and denominator + x = polygcd (q, d); + if (length(x) != 1) + q = deconv (q, x); + d = deconv (d, x); + endif + + ## move all the gain into the numerator + q = q/d(1); + d = d/d(1); + endif else - q = polyderiv (p, a); + lp = numel (p); + if (lp == 1) + q = 0; + return; + elseif (lp == 0) + q = []; + return; + endif + + ## Force P to be a row vector. + p = p(:).'; + + q = p(1:(lp-1)) .* [(lp-1):-1:1]; endif else print_usage (); endif endfunction + + +%!assert(all (all (polyder ([1, 2, 3]) == [2, 2]))); +%!assert(polyder (13) == 0); + +%!error polyder ([]); +%!error polyder ([1, 2; 3, 4]); +
--- a/scripts/polynomial/polyfit.m +++ b/scripts/polynomial/polyfit.m @@ -76,7 +76,7 @@ error ("polyfit: X and Y must be vectors of the same size"); endif - if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == round (n))) + if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == fix (n))) error ("polyfit: N must be a nonnegative integer"); endif
--- a/scripts/polynomial/polygcd.m +++ b/scripts/polynomial/polygcd.m @@ -81,3 +81,24 @@ endif endfunction + + +%!test +%! poly1 = [1 6 11 6]; % (x+1)(x+2)(x+3) +%! poly2 = [1 3 2]; % (x+1)(x+2) +%! poly3 = polygcd (poly1, poly2); +%! assert (poly3, poly2, sqrt (eps)) + +%!test +%! assert (polygcd (poly(1:8), poly(3:12)), poly(3:8), sqrt (eps)) + +%!test +%! assert (deconv (poly(1:8), polygcd (poly(1:8), poly(3:12))), poly(1:2), sqrt (eps)) + +%!test +%! for ii=1:10 +%! p = (unique (randn (10, 1)) * 10).'; +%! p1 = p(3:end); +%! p2 = p(1:end-2); +%! assert (polygcd (poly (-p1), poly (-p2)), poly (- intersect (p1, p2)), sqrt (eps)) +%! endfor
--- a/scripts/polynomial/polyint.m +++ b/scripts/polynomial/polyint.m @@ -61,3 +61,18 @@ retval = [(p ./ [lp:-1:1]), k]; endfunction + +%!test +%! A = [3, 2, 1]; +%! assert (polyint(A),polyint(A,0)); +%! assert (polyint(A),polyint(A')); +%! assert (polyint(A),[1, 1, 1, 0]); +%! assert (polyint(A,1),ones(1,4)); + +%!test +%! A = ones(1,8); +%! B = [length(A):-1:1]; +%! assert (polyint(A),[1./B, 0]); + +%!error polyint() +%!error polyint(ones(2,2))
--- a/scripts/polynomial/polyout.m +++ b/scripts/polynomial/polyout.m @@ -97,3 +97,9 @@ str = num2str (c, 5); endif endfunction + +%!assert (polyout ([3 2 1]), '3*s^2 + 2*s^1 + 1') +%!assert (polyout ([3 2 1], 'x'), '3*x^2 + 2*x^1 + 1') +%!assert (polyout ([3 2 1], 'wxyz'), '3*wxyz^2 + 2*wxyz^1 + 1') +%!assert (polyout ([5 4 3 2 1], '1'),'5*1^4 + 4*1^3 + 3*1^2 + 2*1^1 + 1') +%!error polyout ([])
--- a/scripts/polynomial/polyval.m +++ b/scripts/polynomial/polyval.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {@var{y} =} polyval (@var{p}, @var{x}) ## @deftypefnx {Function File} {@var{y} =} polyval (@var{p}, @var{x}, [], @var{mu}) ## Evaluate the polynomial @var{p} at the specified values of @var{x}. When -## @var{mu} is present evaluate the polynomial for +## @var{mu} is present, evaluate the polynomial for ## (@var{x}-@var{mu}(1))/@var{mu}(2). ## If @var{x} is a vector or matrix, the polynomial is evaluated for each of ## the elements of @var{x}. @@ -39,17 +39,19 @@ ## Created: June 1994 ## Adapted-By: jwe -function [y, dy] = polyval (p, x, s, mu) +function [y, dy] = polyval (p, x, s = [], mu) if (nargin < 2 || nargin > 4 || (nargout == 2 && nargin < 3)) print_usage (); endif - if (nargin < 3) - s = []; - endif - - if (! (isvector (p) || isempty (p))) + if (isempty (x)) + y = []; + return; + elseif (isempty (p)) + y = zeros (size (x)); + return; + elseif (! isvector (p)) error ("polyval: first argument must be a vector"); endif @@ -57,16 +59,6 @@ x = (x - mu(1)) / mu(2); endif - if (isempty (x)) - y = []; - return; - endif - - if (length (p) == 0) - y = p; - return; - endif - n = length (p) - 1; y = p(1) * ones (size (x)); for i = 2:n+1 @@ -80,10 +72,23 @@ ## dy = t * sqrt (1 + sumsq (A/s.R, 2)) * s.normr / sqrt (s.df) ## If my inference is correct, then t must equal 1 for polyval. ## This is because finv (0.5, n, n) = 1.0 for any n. - k = numel (x); - A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); - dy = sqrt (1 + sumsq (A/s.R, 2)) * s.normr / sqrt (s.df); - dy = reshape (dy, size (x)); + try + k = numel (x); + A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); + dy = sqrt (1 + sumsq (A/s.R, 2)) * s.normr / sqrt (s.df); + dy = reshape (dy, size (x)); + catch + if (isempty (s)) + error ("polyval: third input is required.") + elseif (isstruct (s) + && all (ismember ({"R", "normr", "df"}, fieldnames (s)))) + error (lasterr ()) + elseif (isstruct (s)) + error ("polyval: third input is missing the required fields."); + else + error ("polyval: third input is not a structure."); + endif + end_try_catch endif endfunction @@ -142,3 +147,6 @@ %! assert (y, polyval(p,x), eps) %! x = reshape(x, [1, 1, 5, 2]); +%!assert (zeros (1, 10), polyval ([], 1:10)) +%!assert ([], polyval (1, [])) +%!assert ([], polyval ([], []))
--- a/scripts/polynomial/ppder.m +++ b/scripts/polynomial/ppder.m @@ -17,28 +17,54 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{ppd} =} ppder (@var{pp}) -## Compute the piecewise derivative of the piecewise polynomial struct @var{pp}. +## @deftypefn {Function File} {ppd =} ppder (pp, m) +## Computes the piecewise @var{m}-th derivative of a piecewise polynomial +## struct @var{pp}. If @var{m} is omitted the first derivate is +## calculated. ## @seealso{mkpp, ppval, ppint} ## @end deftypefn -function ppd = ppder (pp) - if (nargin != 1) +function ppd = ppder (pp, m) + + if ((nargin < 1) || (nargin > 2)) print_usage (); + elseif (nargin == 1) + m = 1; endif - if (! isstruct (pp)) + + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppder: PP must be a structure"); endif [x, p, n, k, d] = unmkpp (pp); - p = reshape (p, [], k); - if (k <= 1) - pd = zeros (rows (p), 1); - k = 1; + + if (k - m <= 0) + x = [x(1) x(end)]; + pd = zeros (prod (d), 1); else - k -= 1; - pd = p(:,1:k) * diag (k:-1:1); + f = k : -1 : 1; + ff = bincoeff (f, m + 1) .* factorial (m + 1) ./ f; + k -= m; + pd = p(:,1:k) * diag (ff(1:k)); endif + ppd = mkpp (x, pd, d); endfunction +%!shared x,y,pp,ppd +%! x=0:8;y=[x.^2;x.^3+1];pp=spline(x,y); +%! ppd=ppder(pp); +%!assert(ppval(ppd,x),[2*x;3*x.^2],1e-14) +%!assert(ppd.order,3) +%! ppd=ppder(pp,2); +%!assert(ppval(ppd,x),[2*ones(size(x));6*x],1e-14) +%!assert(ppd.order,2) +%! ppd=ppder(pp,3); +%!assert(ppd.order,1) +%!assert(ppd.pieces,8) +%!assert(size(ppd.coefs),[16,1]) +%! ppd=ppder(pp,4); +%!assert(ppd.order,1) +%!assert(ppd.pieces,1) +%!assert(size(ppd.coefs),[2,1]) +%!assert(ppval(ppd,x),zeros(size(y)),1e-14)
--- a/scripts/polynomial/ppint.m +++ b/scripts/polynomial/ppint.m @@ -28,7 +28,7 @@ if (nargin < 1 || nargin > 2) print_usage (); endif - if (! isstruct (pp)) + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppint: PP must be a structure"); endif @@ -39,17 +39,20 @@ pi = p / diag (k:-1:1); k += 1; if (nargin == 1) - pi(:,k) = 0; + pi(:, k) = 0; else - pi(:,k) = repmat (c(:), n, 1); + pi(:, k) = repmat (c(:), n, 1); endif ppi = mkpp (x, pi, d); - ## Adjust constants so the the result is continuous. - - jumps = reshape (ppjumps (ppi), prod (d), n-1); - ppi.P(:,2:n,k) -= cumsum (jumps, 2); + tmp = -cumsum (ppjumps (ppi), length (d) + 1); + ppi.coefs(prod(d)+1:end, k) = tmp(:); endfunction +%!shared x,y,pp,ppi +%! x=0:8;y=[ones(size(x));x+1];pp=spline(x,y); +%! ppi=ppint(pp); +%!assert(ppval(ppi,x),[x;0.5*x.^2+x],1e-14) +%!assert(ppi.order,5)
--- a/scripts/polynomial/ppjumps.m +++ b/scripts/polynomial/ppjumps.m @@ -28,29 +28,57 @@ if (nargin != 1) print_usage (); endif - if (! isstruct (pp)) + + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppjumps: PP must be a structure"); endif ## Extract info. - x = pp.x; - P = pp.P; - d = pp.d; - [nd, n, k] = size (P); + [x, P, n, k, d] = unmkpp(pp); + nd = length (d) + 1; ## Offsets. - dx = diff (x(1:n)).'; - dx = dx(ones (1, nd), :); # spread (do nothing in 1D) + dx = diff(x(1:n)); + dx = repmat (dx, [prod(d), 1]); + dx = reshape (dx, [d, n-1]); + dx = shiftdim (dx, nd - 1); - ## Use Horner scheme to get limits from the left. - llim = P(:,1:n-1,1); - for i = 2:k; + ## Use Horner scheme. + if (k>1) + llim = shiftdim (reshape (P(1:(n-1) * prod(d), 1), [d, n-1]), nd - 1); + endif + + for i = 2 : k; llim .*= dx; - llim += P(:,1:n-1,i); + llim += shiftdim (reshape (P(1:(n-1) * prod (d), i), [d, n-1]), nd - 1); endfor - rlim = P(:,2:n,k); # limits from the right - jumps = reshape (rlim - llim, [d, n-1]); - + rlim = shiftdim (ppval (pp, x(2:end-1)), nd - 1); + jumps = shiftdim (rlim - llim, 1); endfunction + +%!test +%! p = [1 6 11 6]; +%! x = linspace (5, 6, 4); +%! y = polyval (p, x); +%! pp = spline (x, y); +%! jj = ppjumps (pp); +%! assert (jj, [0 0], eps) + +%!test +%! +%! breaks = [0 1 2]; +%! pp1 = poly (-[1 2 3]); +%! pp2 = poly (-([1 2 3]+1)); +%! pp = mkpp (breaks, [pp1;pp2]); +%! assert (ppjumps (pp), 0, eps) + +%!test +%! +%! breaks = [0 1 2]; +%! pp1 = poly (-[1 2 3]); +%! pp2 = poly (([1 2 3]+1)); +%! pp = mkpp (breaks, [pp1;pp2]); +%! j = - 2 * polyval (pp1, 1); +%! assert (ppjumps (pp), j, eps)
--- a/scripts/polynomial/ppval.m +++ b/scripts/polynomial/ppval.m @@ -18,16 +18,18 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{yi} =} ppval (@var{pp}, @var{xi}) -## Evaluate piecewise polynomial @var{pp} at the points @var{xi}. -## If @var{pp} is scalar-valued, the result is an array of the same shape as -## @var{xi}. -## Otherwise, the size of the result is @code{[pp.d, length(@var{xi})]} if -## @var{xi} is a vector, or @code{[pp.d, size(@var{xi})]} if it is a -## multi-dimensional array. If pp.orient is 1, the dimensions are permuted as +## Evaluate piece-wise polynomial structure @var{pp} at the points @var{xi}. +## If @var{pp} describes a scalar polynomial function, the result is an +## array of the same shape as @var{xi}. +## Otherwise, the size of the result is @code{[pp.dim, length(@var{xi})]} if +## @var{xi} is a vector, or @code{[pp.dim, size(@var{xi})]} if it is a +## multi-dimensional array. +## +##, the dimensions are permuted as ## in interp1, to ## @code{[pp.d, length(@var{xi})]} and @code{[pp.d, size(@var{xi})]} ## respectively. -## @seealso{mkpp, unmkpp, spline} +## @seealso{mkpp, unmkpp, spline, pchip, interp1} ## @end deftypefn function yi = ppval (pp, xi) @@ -35,48 +37,85 @@ if (nargin != 2) print_usage (); endif - if (! isstruct (pp)) - error ("ppval: PP must be a structure"); + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) + error ("ppval: first argument must be a pp-form structure"); endif ## Extract info. - x = pp.x; - P = pp.P; - d = pp.d; - k = size (P, 3); - nd = size (P, 1); + [x, P, n, k, d] = unmkpp (pp); - ## Determine resulting shape. - if (d == 1) # scalar case - yisz = size (xi); - elseif (isvector (xi)) # this is special - yisz = [d, length(xi)]; - else # general - yisz = [d, size(xi)]; + ## dimension checks + sxi = size (xi); + if (isvector (xi)) + xi = xi(:).'; endif + nd = length (d); + ## Determine intervals. - xi = xi(:); xn = numel (xi); + idx = lookup (x, xi, "lr"); - idx = lookup (x, xi, "lr"); + P = reshape (P, [d, n * k]); + P = shiftdim (P, nd); + P = reshape (P, [n, k, d]); + Pidx = P(idx(:), :);#2d matrix size x: coefs*prod(d) y: prod(sxi) + + if (isvector(xi)) + Pidx = reshape (Pidx, [xn, k, d]); + Pidx = shiftdim (Pidx, 1); + dimvec = [d, xn]; + else + Pidx = reshape (Pidx, [sxi, k, d]); + Pidx = shiftdim (Pidx, length (sxi)); + dimvec = [d, sxi]; + endif + ndv = length (dimvec); ## Offsets. - dx = (xi - x(idx)).'; - dx = dx(ones (1, nd), :); # spread (do nothing in 1D) + dx = (xi - x(idx)); + dx = repmat (dx, [prod(d), 1]); + dx = reshape (dx, dimvec); + dx = shiftdim (dx, ndv - 1); ## Use Horner scheme. - yi = P(:,idx,1); - for i = 2:k; + yi = Pidx; + if (k > 1) + yi = shiftdim (reshape (Pidx(1,:), dimvec), ndv - 1); + endif + + for i = 2 : k; yi .*= dx; - yi += P(:,idx,i); + yi += shiftdim (reshape (Pidx(i,:), dimvec), ndv - 1); endfor ## Adjust shape. - yi = reshape (yi, yisz); - if (d != 1 && pp.orient == 1) - ## Switch dimensions to match interp1 order. - yi = shiftdim (yi, length (d)); + if ((numel (xi) > 1) || (length (d) == 1)) + yi = reshape (shiftdim (yi, 1), dimvec); + endif + + if (isvector (xi) && (d == 1)) + yi = reshape (yi, sxi); + elseif (isfield (pp, "orient") && strcmp (pp.orient, "first")) + yi = shiftdim(yi, nd); endif + ## + #if (d == 1) + # yi = reshape (yi, sxi); + #endif + endfunction + +%!shared b,c,pp,pp2,xi,abserr +%! b = 1:3; c = ones(2); pp=mkpp(b,c);abserr = 1e-14;pp2=mkpp(b,[c;c],2); +%! xi = [1.1 1.3 1.9 2.1]; +%!assert (ppval(pp,1.1), 1.1, abserr); +%!assert (ppval(pp,2.1), 1.1, abserr); +%!assert (ppval(pp,xi), [1.1 1.3 1.9 1.1], abserr); +%!assert (ppval(pp,xi.'), [1.1 1.3 1.9 1.1].', abserr); +%!assert (ppval(pp2,1.1), [1.1;1.1], abserr); +%!assert (ppval(pp2,2.1), [1.1;1.1], abserr); +%!assert (ppval(pp2,xi), [1.1 1.3 1.9 1.1;1.1 1.3 1.9 1.1], abserr); +%!assert (ppval(pp2,xi'), [1.1 1.3 1.9 1.1;1.1 1.3 1.9 1.1], abserr); +%!assert (size(ppval(pp2,[xi;xi])), [2 2 4]);
--- a/scripts/polynomial/spline.m +++ b/scripts/polynomial/spline.m @@ -83,15 +83,15 @@ ## Check the size and shape of y ndy = ndims (y); szy = size (y); - if (ndy == 2 && (szy(1) == 1 || szy(2) == 1)) - if (szy(1) == 1) + if (ndy == 2 && (szy(1) == n || szy(2) == n)) + if (szy(2) == n) a = y.'; else a = y; szy = fliplr (szy); endif else - a = reshape (y, [prod(szy(1:end-1)), szy(end)]).'; + a = shiftdim (reshape (y, [prod(szy(1:end-1)), szy(end)]), 1); endif for k = (1:columns (a))(any (isnan (a))) @@ -120,9 +120,9 @@ if (n == 2) d = (dfs + dfe) / (x(2) - x(1)) ^ 2 + ... - 2 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 3; + 2 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 3; c = (-2 * dfs - dfe) / (x(2) - x(1)) - ... - 3 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 2; + 3 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 2; b = dfs; a = a(1,:); @@ -132,7 +132,7 @@ a = a(1:n-1,:); else if (n == 3) - dg = 1.5 * h(1) - 0.5 * h(2); + 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)); @@ -153,9 +153,9 @@ endif c(1,:) = (3 / h(1) * (a(2,:) - a(1,:)) - 3 * dfs - - c(2,:) * h(1)) / (2 * h(1)); + - 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)); + + c(n-1,:) * h(n-1)) / (2 * h(n-1)); 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)); @@ -229,15 +229,14 @@ - h(1:n-1, idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:)); d = diff (c) ./ (3 * h(1:n-1, idx)); - d = d(1:n-1,:); - c = c(1:n-1,:); - b = b(1:n-1,:); - a = a(1:n-1,:); + d = d(1:n-1,:);d = d.'(:); + c = c(1:n-1,:);c = c.'(:); + b = b(1:n-1,:);b = b.'(:); + a = a(1:n-1,:);a = a.'(:); endif endif - coeffs = cat (3, d.', c.', b.', a.'); - ret = mkpp (x, coeffs, szy(1:end-1)); + ret = mkpp (x, cat (2, d, c, b, a), szy(1:end-1)); if (nargin == 3) ret = ppval (ret, xi); @@ -263,6 +262,9 @@ %!assert (isempty(spline(x',y',[]))); %!assert (isempty(spline(x,y,[]))); %!assert (spline(x,[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x,[y;y],x'), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x',[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x',[y;y],x'), [spline(x,y,x);spline(x,y,x)],abserr) %! y = cos(x) + i*sin(x); %!assert (spline(x,y,x), y, abserr) %!assert (real(spline(x,y,x)), real(y), abserr);
--- a/scripts/polynomial/unmkpp.m +++ b/scripts/polynomial/unmkpp.m @@ -47,18 +47,37 @@ ## @end deftypefn function [x, P, n, k, d] = unmkpp (pp) - if (nargin == 0) + + if (nargin != 1) print_usage (); endif - if (! isstruct (pp)) - error ("unmkpp: expecting piecewise polynomial structure"); + if (! (isstruct (pp) && isfield (pp, "form") && strcmp (pp.form, "pp"))) + error ("unmkpp: PP must be a piecewise polynomial structure"); endif - x = pp.x; - P = pp.P; - n = size (P, 2); - k = size (P, 3); - d = pp.d; - if (d == 1) - P = reshape (P, n, k); - endif + x = pp.breaks; + P = pp.coefs; + n = pp.pieces; + k = pp.order; + d = pp.dim; + endfunction + + +%!test +%! b = 1:3; +%! c = 1:24; +%! pp = mkpp (b,c); +%! [x, P, n, k, d] = unmkpp (pp); +%! assert (x, b); +%! assert (P, reshape (c, [2 12])); +%! assert (n, 2); +%! assert (k, 12); +%! assert (d, 1); + +%% Test input validation +%!error unmkpp () +%!error unmkpp (1,2) +%!error <piecewise polynomial structure> unmkpp (1) +%!error <piecewise polynomial structure> unmkpp (struct ("field1", "pp")) +%!error <piecewise polynomial structure> unmkpp (struct ("form", "not_a_pp")) +
new file mode 100644 --- /dev/null +++ b/scripts/prefs/addpref.m @@ -0,0 +1,74 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} addpref (@var{group}, @var{pref}, @var{val}) +## Add a preference @var{pref} and associated value @var{val} to the +## named 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 corresponding value @var{val} may be any +## value, or, if @var{pref} is a cell array of strings, @var{val} +## must be a cell array of values with the same size as @var{pref}. +## @seealso{pref, getpref, ispref, rmpref, setpref} +## @end deftypefn + +## Author: jwe + +function addpref (group, pref, val) + + if (nargin == 3) + if (ischar (group)) + prefs = loadprefs (); + if (ischar (pref)) + if (isfield (group, pref)) + error ("preference %s already exists in group %s", pref, group); + else + prefs.(group).(pref) = val; + endif + elseif (iscellstr (pref)) + if (size_equal (pref, val)) + for i = 1:numel(pref) + if (isfield (group, pref{i})) + error ("preference %s already exists in group %s", + pref{i}, group); + else + prefs.(group).(pref{i}) = val; + endif + endfor + else + error ("size mismatch for pref and val"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + saveprefs (prefs); + else + error ("expecting group to be a character string"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/getpref.m @@ -0,0 +1,95 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} getpref (@var{group}, @var{pref}, @var{default}) +## Return the preference value corresponding to the named preference +## @var{pref} in the preference group @var{group}. +## +## The named preference group must be a character string. +## +## If @var{pref} does not exist in @var{group} and @var{default} is +## specified, return @var{default}. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. The corresponding default value @var{default} +## may be any value, or, if @var{pref} is a cell array of strings, +## @var{default} must be a cell array of values with the same size as +## @var{pref}. +## +## If neither @var{pref} nor @var{default} are specified, return a +## structure of preferences for the preference group @var{group}. +## +## If no arguments are specified, return a structure containing all +## groups of preferences and their values. +## @seealso{addpref, ispref, rmpref, setpref} +## @end deftypefn + +## Author: jwe + +function retval = getpref (group, pref, default) + + if (nargin == 0) + retval = loadprefs (); + elseif (nargin == 1) + if (ischar (group)) + prefs = loadprefs (); + if (isfield (prefs, group)) + retval = prefs.(group); + else + retval = []; + endif + else + error ("expecting group to be a character string"); + endif + elseif (nargin == 2 || nargin == 3) + grp = getpref (group); + if (ischar (pref)) + if (isfield (grp, pref)) + retval = grp.(pref); + elseif (nargin == 3) + retval = default; + else + error ("preference %s does not exist in group %s", pref, group); + endif + elseif (iscellstr (pref)) + if (nargin == 2 || size_equal (pref, default)) + for i = 1:numel(pref) + if (isfield (grp, pref{i})) + retval.(pref) = grp.(pref{i}); + elseif (nargin == 3) + retval.(pref) = default{i}; + else + error ("preference %s does not exist in group %s", pref{i}, group); + endif + endfor + else + error ("size mismatch for pref and default"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/ispref.m @@ -0,0 +1,59 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} ispref (@var{group}, @var{pref}) +## Return true if the named preference @var{pref} exists in 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. +## +## If @var{pref} is not specified, return true if the the preference +## group @var{group} exists. +## @seealso{addpref, getpref, rmpref, setpref} +## @end deftypefn + +## Author: jwe + +function retval = ispref (group, pref) + + if (nargin == 1) + retval = isfield (loadprefs (), group); + elseif (nargin == 2) + if (isfield (prefs, group)) + grp = prefs.(group); + if (ischar (pref) || iscellstr (pref)) + retval = isfield (grp, pref); + else + retval = false; + endif + else + retval = false; + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/module.mk @@ -0,0 +1,20 @@ +FCN_FILE_DIRS += prefs + +prefs_PRIVATE_FCN_FILES = \ + prefs/private/loadprefs.m \ + prefs/private/prefsfile.m \ + prefs/private/saveprefs.m + +prefs_FCN_FILES = \ + prefs/addpref.m \ + prefs/getpref.m \ + prefs/ispref.m \ + prefs/rmpref.m \ + prefs/setpref.m \ + $(prefs_PRIVATE_FCN_FILES) + +FCN_FILES += $(prefs_FCN_FILES) + +PKG_ADD_FILES += prefs/PKG_ADD + +DIRSTAMP_FILES += prefs/$(octave_dirstamp)
new file mode 100644 --- /dev/null +++ b/scripts/prefs/private/loadprefs.m @@ -0,0 +1,43 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} loadprefs () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = loadprefs () + + file = prefsfile (); + + s = stat (file); + + if (isstruct (s) && S_ISREG (s.mode)) + tmp = load (file); + retval= tmp.prefs; + else + retval = []; + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/private/prefsfile.m @@ -0,0 +1,53 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} prefsfile () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = prefsfile () + + retval = "~/.octave_prefs"; + + ## Transition users to new filename if necessary + ## FIXME: Delete before 3.6.0 release + oldname = tilde_expand ("~/.octave-prefs"); + if (exist (oldname, "file")) + newname = tilde_expand (retval); + if (exist (newname, "file")) + error (["Octave uses the file ~/.octave_prefs to store preferences.\n",... + " The old file name was ~/.octave-prefs.\n",... + " Both files exist."... + " User must manually delete one of the files.\n"]); + endif + status = movefile (oldname, newname); + if (! status) + error (["Octave uses the file ~/.octave_prefs to store preferences.\n", + " The old file name was ~/.octave-prefs.\n", + " User must manually rename the old file to the new name.\n"]); + 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.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/private/saveprefs.m @@ -0,0 +1,36 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} saveprefs () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = saveprefs (s) + + prefs = s; + + save (prefsfile (), "prefs"); + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/rmpref.m @@ -0,0 +1,61 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {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. +## +## If @var{pref} is not specified, remove the preference group +## @var{group}. +## +## It is an error to remove a nonexistent preference or group. +## @seealso{addpref, getpref, rmpref, setpref} +## @end deftypefn + +## Author: jwe + +function retval = rmpref (group, pref) + + prefs = loadprefs (); + + if (nargin == 1) + if (ischar (group)) + retval = isfield (prefs, group); + 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); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
new file mode 100644 --- /dev/null +++ b/scripts/prefs/setpref.m @@ -0,0 +1,67 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} setpref (@var{group}, @var{pref}, @var{val}) +## Set a preference @var{pref} to the given @var{val} in the named +## 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 corresponding value @var{val} may be any +## value, or, if @var{pref} is a cell array of strings, @var{val} +## must be a cell array of values with the same size as @var{pref}. +## +## If the named preference or group does not exist, it is added. +## @seealso{pref, getpref, ispref, rmpref, setpref} +## @end deftypefn + +## Author: jwe + +function setpref (group, pref, val) + + if (nargin == 3) + if (ischar (group)) + prefs = loadprefs (); + if (ischar (pref)) + prefs.(group).(pref) = val; + elseif (iscellstr (pref)) + if (size_equal (pref, val)) + for i = 1:numel(pref) + prefs.(group).(pref{i}) = val; + endfor + else + error ("size mismatch for pref and val"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + saveprefs (prefs); + else + error ("expecting group to be a character string"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
--- a/scripts/set/ismember.m +++ b/scripts/set/ismember.m @@ -77,6 +77,14 @@ print_usage (); endif + ## lookup() does not handle logical values + if (islogical (A)) + A = uint8 (A); + endif + if (islogical (s)) + s = uint8 (s); + endif + [A, s] = validargs ("ismember", A, s, varargin{:}); if (nargin == 2)
--- a/scripts/set/powerset.m +++ b/scripts/set/powerset.m @@ -75,3 +75,9 @@ endif endfunction + + +%!test +%! c = sort (cellstr ({ [], [1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]})); +%! p = sort (cellstr (powerset ([1, 2, 3]))); +%! assert (p, c);
--- a/scripts/set/private/validargs.m +++ b/scripts/set/private/validargs.m @@ -37,12 +37,12 @@ elseif (nargin == 4) if (strcmpi (byrows_arg, "rows")) if (iscell (x) || iscell (y)) - error ("%s: cells not supported with ""rows"""); + error ('%s: cells not supported with "rows"', caller); elseif (! (ismatrix (x) && ismatrix (y))) error ("%s: input arguments must be arrays or cell arrays of strings", caller); else if (ndims (x) > 2 || ndims (y) > 2) - error ("%s: need 2-dimensional matrices for ""rows""", caller); + error ('%s: need 2-dimensional matrices for "rows"', caller); elseif (columns (x) != columns (y) && ! (isempty (x) || isempty (y))) error ("%s: number of columns must match", caller); endif
--- a/scripts/set/setxor.m +++ b/scripts/set/setxor.m @@ -4,14 +4,14 @@ ## 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 +## 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. +## 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 @@ -20,17 +20,16 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} setxor (@var{a}, @var{b}) ## @deftypefnx {Function File} {} setxor (@var{a}, @var{b}, 'rows') +## @deftypefnx {Function File} {[@var{c}, @var{ia}, @var{ib}] =} setxor (@var{a}, @var{b}) ## ## Return the elements exclusive to @var{a} or @var{b}, sorted in ascending ## order. If @var{a} and @var{b} are both column vectors return a column ## vector, otherwise return a row vector. ## @var{a}, @var{b} may be cell arrays of string(s). ## -## @deftypefnx {Function File} {[@var{c}, @var{ia}, @var{ib}] =} setxor (@var{a}, @var{b}) -## -## Return index vectors @var{ia} and @var{ib} such that @code{a(ia)} and -## @code{b(ib)} are -## disjoint sets whose union is @var{c}. +## With three output arguments, return index vectors @var{ia} and @var{ib} +## such that @code{a(ia)} and @code{b(ib)} are disjoint sets whose union +## is @var{c}. ## ## @seealso{unique, union, intersect, setdiff, ismember} ## @end deftypefn
--- a/scripts/signal/autoreg_matrix.m +++ b/scripts/signal/autoreg_matrix.m @@ -47,3 +47,16 @@ endfor endfunction + + +%!test +%! K=4; +%! A = zeros(1,K+1); +%! A(1) = 1; +%! B = eye(K+1); +%! B(:,1) = 1; +%! assert (autoreg_matrix(A,K),B); + +%!error autoreg_matrix() +%!error autoreg_matrix(1) +%!error autoreg_matrix(ones(4,1),5)
--- a/scripts/signal/bartlett.m +++ b/scripts/signal/bartlett.m @@ -34,7 +34,7 @@ print_usage (); endif - if (! (isscalar (m) && (m == round (m)) && (m > 0))) + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) error ("bartlett: M has to be an integer > 0"); endif @@ -47,3 +47,17 @@ endif endfunction + +%!assert (bartlett (1), 1); +%!assert (bartlett (2), zeros (2,1)); +%!assert (bartlett (16), fliplr (bartlett (16))); +%!assert (bartlett (15), fliplr (bartlett (15))); +%!test +%! N = 9; +%! A = bartlett (N); +%! assert (A (ceil (N/2)), 1); + +%!error bartlett (); +%!error bartlett (0.5); +%!error bartlett (-1); +%!error bartlett (ones(1,4));
--- a/scripts/signal/blackman.m +++ b/scripts/signal/blackman.m @@ -33,7 +33,7 @@ print_usage (); endif - if (! (isscalar (m) && (m == round (m)) && (m > 0))) + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) error ("blackman: M has to be an integer > 0"); endif @@ -46,3 +46,18 @@ endif endfunction + +%!assert (blackman (1), 1); +%!assert (blackman (2), zeros(2,1), 1e-6); +%!assert (blackman (16), fliplr (blackman (16))); +%!assert (blackman (15), fliplr (blackman (15))); +%!test +%! N = 9; +%! A = blackman (N); +%! assert (A (ceil (N/2)), 1, 1e-6); +%! assert ([A(1), A(length (A))], zeros (1, 2), 1e-6); + +%!error blackman (); +%!error blackman (0.5); +%!error blackman (-1); +%!error blackman (ones(1,4));
--- a/scripts/signal/detrend.m +++ b/scripts/signal/detrend.m @@ -45,7 +45,7 @@ p = 0; elseif (ischar (p) && strcmpi (p, "linear")) p = 1; - elseif (!isscalar (p) || p < 0 || p != round (p)) + elseif (!isscalar (p) || p < 0 || p != fix (p)) error ("detrend: second input argument must be 'constant', 'linear' or a positive integer"); endif else
--- a/scripts/signal/fftfilt.m +++ b/scripts/signal/fftfilt.m @@ -54,8 +54,12 @@ [r_x, c_x] = size (x); [r_b, c_b] = size (b); - if min ([r_b, c_b]) != 1 - error ("fftfilt: B should be a vector"); + if (! isvector (b)) + error ("fftfilt: B must be a vector"); + endif + + if (ndims (x) != 2) + error ("fftfilt: X must be a 1-D or 2-D array"); endif l_b = r_b * c_b; @@ -64,18 +68,18 @@ if (nargin == 2) ## Use FFT with the smallest power of 2 which is >= length (x) + ## length (b) - 1 as number of points ... - n = 2 ^ (ceil (log (r_x + l_b - 1) / log (2))); + n = 2 ^ nextpow2 (r_x + l_b - 1); B = fft (b, n); - y = ifft (fft (x, n) .* B(:,ones (1, c_x))); + y = ifft (fft (x, n) .* B(:, ones (1, c_x))); else ## Use overlap-add method ... if (! (isscalar (n))) error ("fftfilt: N has to be a scalar"); endif - n = 2 ^ (ceil (log (max ([n, l_b])) / log (2))); + n = 2 ^ nextpow2 (max ([n, l_b])); L = n - l_b + 1; B = fft (b, n); - B = B(:,ones (c_x,1)); + B = B(:, ones (c_x,1)); R = ceil (r_x / L); y = zeros (r_x, c_x); for r = 1:R; @@ -89,20 +93,59 @@ endfor endif - y = y(1:r_x,:); + y = y(1:r_x, :); if (transpose) y = y.'; endif - ## Final cleanups: if both x and b are real respectively integer, y - ## should also be + ## Final cleanups: If both x and b are real, y should be real. + ## If both x and b are integer, y should be integer. if (isreal (b) && isreal (x)) y = real (y); endif - if (! any (b - round (b))) - idx = !any (x - round (x)); - y(:,idx) = round (y(:,idx)); + if (! any (b - fix (b))) + idx = !any (x - fix (x)); + y(:, idx) = round (y(:, idx)); endif endfunction + + +%!shared b, x, r +%!test +%! b = [1 1]; +%! x = [1, zeros(1,9)]; +%! assert(fftfilt(b, x ), [1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b, x.'), [1 1 0 0 0 0 0 0 0 0].', eps); +%! assert(fftfilt(b.',x ), [1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b.',x.'), [1 1 0 0 0 0 0 0 0 0].', eps); + +%!test +%! r = sqrt(1/2) * (1+i); +%! b = b*r; +%! assert(fftfilt(b, x ), r*[1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b, r*x), r*r*[1 1 0 0 0 0 0 0 0 0], eps); +%! assert(fftfilt(b, x.'), r*[1 1 0 0 0 0 0 0 0 0].', eps); + +%!test +%! b = [1 1]; +%! 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 = fftfilt (b, x); +%! assert (y,y0); + +%!test +%! b = rand (10, 1); +%! x = rand (10, 1); +%! y0 = filter (b, 1, x); +%! y = filter (b, 1, x); +%! assert (y, y0); + +%% Test input validation +%!error fftfilt (1) +%!error fftfilt (1, 2, 3, 4) +%!error fftfilt (ones (2), 1) +%!error fftfilt (2, ones (3,3,3)) +%!error fftfilt (2, 1, ones (2)) +
--- a/scripts/signal/fftshift.m +++ b/scripts/signal/fftshift.m @@ -58,9 +58,7 @@ sz = size (x); sz2 = ceil (sz(dim) / 2); idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = [sz2+1:sz(dim), 1:sz2]; retval = x(idx{:}); else
--- a/scripts/signal/hamming.m +++ b/scripts/signal/hamming.m @@ -33,7 +33,7 @@ print_usage (); endif - if (! (isscalar (m) && (m == round (m)) && (m > 0))) + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) error ("hamming: M has to be an integer > 0"); endif @@ -45,3 +45,17 @@ endif endfunction + +%!assert (hamming (1), 1); +%!assert (hamming (2), (0.54 - 0.46)*ones(2,1)); +%!assert (hamming (16), fliplr (hamming (16))); +%!assert (hamming (15), fliplr (hamming (15))); +%!test +%! N = 15; +%! A = hamming (N); +%! assert (A (ceil (N/2)), 1); + +%!error hamming (); +%!error hamming (0.5); +%!error hamming (-1); +%!error hamming (ones(1,4));
--- a/scripts/signal/hanning.m +++ b/scripts/signal/hanning.m @@ -33,7 +33,7 @@ print_usage (); endif - if (! (isscalar (m) && (m == round (m)) && (m > 0))) + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) error ("hanning: M has to be an integer > 0"); endif @@ -45,3 +45,17 @@ endif endfunction + +%!assert (hanning (1), 1); +%!assert (hanning (2), zeros(2,1)); +%!assert (hanning (16), fliplr (hanning (16))); +%!assert (hanning (15), fliplr (hanning (15))); +%!test +%! N = 15; +%! A = hanning (N); +%! assert (A (ceil (N/2)), 1); + +%!error hanning (); +%!error hanning (0.5); +%!error hanning (-1); +%!error hanning (ones(1,4));
--- a/scripts/signal/ifftshift.m +++ b/scripts/signal/ifftshift.m @@ -45,10 +45,7 @@ nd = ndims (x); sz = size (x); sz2 = floor (sz(dim) / 2); - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = [sz2+1:sz(dim), 1:sz2]; retval = x(idx{:}); else
--- a/scripts/signal/sinc.m +++ b/scripts/signal/sinc.m @@ -45,3 +45,10 @@ endif endfunction + + +%!assert (sinc (0), 1); +%!assert (sinc (1), 0,1e-6); +%!assert (sinc (1/2), 2/pi, 1e-6) + +%!error sinc()
--- a/scripts/signal/sinewave.m +++ b/scripts/signal/sinewave.m @@ -43,3 +43,13 @@ endif endfunction + +%!assert (sinewave (1), 0); +%!assert (sinewave (1, 4, 1), 1); +%!assert (sinewave (1, 12, 1), 1/2, 1e-6); +%!assert (sinewave (1, 12, 2), sqrt (3)/2, 1e-6); +%!assert (sinewave (1, 20, 1), (sqrt (5)-1)/4, 1e-6); +%!assert (sinewave (1), sinewave (1, 1,0)); +%!assert (sinewave (3, 4), sinewave(3, 4, 0)); + +%!error sinewave ();
--- a/scripts/signal/unwrap.m +++ b/scripts/signal/unwrap.m @@ -55,11 +55,8 @@ error ("unwrap: DIM must be an integer and a valid dimension"); endif else - ## Find the first non-singleton dimension - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); endif rng = 2*pi; @@ -74,17 +71,14 @@ ## Take first order difference to see so that wraps will show up ## as large values, and the sign will show direction. - idx = cell (); - for i = 1:nd - idx{i} = 1:sz(i); - endfor + idx = repmat ({':'}, nd, 1); idx{dim} = [1,1:m-1]; d = x(idx{:}) - x; - ## Find only the peaks, and multiply them by the range so that there - ## are kronecker deltas at each wrap point multiplied by the range - ## value. - p = rng * (((d > tol) > 0) - ((d < -tol) > 0)); + ## Find only the peaks, and multiply them by the appropriate amount + ## of ranges so that there are kronecker deltas at each wrap point + ## multiplied by the appropriate amount of range values. + p = ceil(abs(d)./rng) .* rng .* (((d > tol) > 0) - ((d < -tol) > 0)); ## Now need to "integrate" this so that the deltas become steps. r = cumsum (p, dim); @@ -95,7 +89,7 @@ endfunction -%!function t = xassert(a,b,tol) +%!function t = __xassert(a,b,tol) %! if (nargin == 1) %! t = all(a(:)); %! else @@ -110,6 +104,7 @@ %! t = 1; %! endif %! endif +%!endfunction %! %!test %! @@ -120,18 +115,42 @@ %! w = r - 2*pi*floor((r+pi)/(2*pi)); # wrapped into [-pi,pi] %! tol = 1e3*eps; # maximum expected deviation %! -%! t(++i) = xassert(r, unwrap(w), tol); #unwrap single row -%! t(++i) = xassert(r', unwrap(w'), tol); #unwrap single column -%! t(++i) = xassert([r',r'], unwrap([w',w']), tol); #unwrap 2 columns -%! t(++i) = xassert([r;r], unwrap([w;w],[],2), tol); #verify that dim works -%! t(++i) = xassert(r+10, unwrap(10+w), tol); #verify that r(1)>pi works +%! t(++i) = __xassert(r, unwrap(w), tol); #unwrap single row +%! t(++i) = __xassert(r', unwrap(w'), tol); #unwrap single column +%! t(++i) = __xassert([r',r'], unwrap([w',w']), tol); #unwrap 2 columns +%! t(++i) = __xassert([r;r], unwrap([w;w],[],2), tol); #check that dim works +%! t(++i) = __xassert(r+10, unwrap(10+w), tol); #check r(1)>pi works %! -%! t(++i) = xassert(w', unwrap(w',[],2)); #unwrap col by rows should not change it -%! t(++i) = xassert(w, unwrap(w,[],1)); #unwrap row by cols should not change it -%! t(++i) = xassert([w;w], unwrap([w;w])); #unwrap 2 rows by cols should not change them +%! t(++i) = __xassert(w', unwrap(w',[],2)); #unwrap col by rows should not change it +%! t(++i) = __xassert(w, unwrap(w,[],1)); #unwrap row by cols should not change it +%! t(++i) = __xassert([w;w], unwrap([w;w])); #unwrap 2 rows by cols should not change them %! %! ## verify that setting tolerance too low will cause bad results. -%! t(++i) = xassert(any(abs(r - unwrap(w,0.8)) > 100)); +%! t(++i) = __xassert(any(abs(r - unwrap(w,0.8)) > 100)); %! %! assert(all(t)); - +%! +%!test +%! A = [pi*(-4), pi*(-2+1/6), pi/4, pi*(2+1/3), pi*(4+1/2), pi*(8+2/3), pi*(16+1), pi*(32+3/2), pi*64]; +%! assert (unwrap(A), unwrap(A, pi)); +%! assert (unwrap(A, pi), unwrap(A, pi, 2)); +%! assert (unwrap(A', pi), unwrap(A', pi, 1)); +%! +%!test +%! A = [pi*(-4); pi*(2+1/3); pi*(16+1)]; +%! B = [pi*(-2+1/6); pi*(4+1/2); pi*(32+3/2)]; +%! C = [pi/4; pi*(8+2/3); pi*64]; +%! D = [pi*(-2+1/6); pi*(2+1/3); pi*(8+2/3)]; +%! E(:, :, 1) = [A, B, C, D]; +%! E(:, :, 2) = [A+B, B+C, C+D, D+A]; +%! F(:, :, 1) = [unwrap(A), unwrap(B), unwrap(C), unwrap(D)]; +%! F(:, :, 2) = [unwrap(A+B), unwrap(B+C), unwrap(C+D), unwrap(D+A)]; +%! assert (unwrap(E), F); +%! +%!test +%! A = [0, 2*pi, 4*pi, 8*pi, 16*pi, 65536*pi]; +%! B = [pi*(-2+1/6), pi/4, pi*(2+1/3), pi*(4+1/2), pi*(8+2/3), pi*(16+1), pi*(32+3/2), pi*64]; +%! assert (unwrap(A), zeros(1, length(A))); +%! assert (diff(unwrap(B), 1)<2*pi, true(1, length(B)-1)); +%! +%!error unwrap()
new file mode 100644 --- /dev/null +++ b/scripts/sparse/bicg.m @@ -0,0 +1,255 @@ +## Copyright (C) 2006 Sylvain Pelissier <sylvain.pelissier@gmail.com> +## Copyright (C) 2011 Carlo de Falco +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## +## @deftypefn {Function File} {@var{x} =} bicg (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} bicg (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} bicg (@var{A}, @var{b}, ...) +## Solve @code{A x = b} using the Bi-conjugate gradient iterative method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given +## or set to [] the default value 1e-6 is used. +## @item @var{maxit} the maximum number of outer iterations, +## if not given or set to [] the default value +## @code{min (20, numel (b))} is used. +## @item @var{x0} the initial guess, if not given or set to [] +## the default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x, "notransp") = A*x} +## and @code{f(x, "transp") = A'*x}. +## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as +## a function handle or inline function @code{g} such that +## @code{g(x, 'notransp') = M1 \ x} or @code{g(x, 'notransp') = M2 \ x} and +## @code{g(x, 'transp') = M1' \ x} or @code{g(x, 'transp') = M2' \ x}. +## +## If colled with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## @item 1: the maximum number of iterations was reached before convergence +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## @item @var{relres} is the final value of the relative residual. +## @item @var{iter} is the number of iterations performed. +## @item @var{resvec} is a vector containing the relative residual at each iteration. +## @end itemize +## +## @seealso{bicgstab,cgs,gmres,pcg} +## +## @end deftypefn + + +function [x, flag, res1, k, resvec] = bicg (A, b, tol, maxit, M1, M2, x0) + + if (nargin >= 2 && isvector (full (b))) + + if (ischar (A)) + fun = str2func (A); + Ax = @(x) feval (fun, x, "notransp"); + Atx = @(x) feval (fun, x, "transp"); + elseif (ismatrix (A)) + Ax = @(x) A * x; + Atx = @(x) A' * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x, "notransp"); + Atx = @(x) feval (A, x, "transp"); + else + error (["bicg: first argument is expected to " ... + "be a function or a square matrix"]); + endif + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif + + if (nargin < 5 || isempty (M1)) + M1m1x = @(x, ignore) x; + M1tm1x = M1m1x; + elseif (ischar (M1)) + fun = str2func (M1); + M1m1x = @(x) feval (fun, x, "notransp"); + M1tm1x = @(x) feval (fun, x, "transp"); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + M1tm1x = @(x) M1' \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x, "notransp"); + M1tm1x = @(x) feval (M1, x, "transp"); + else + error (["bicg: preconditioner is expected to " ... + "be a function or matrix"]); + endif + + if (nargin < 6 || isempty (M2)) + M2m1x = @(x, ignore) x; + M2tm1x = M2m1x; + elseif (ischar (M2)) + fun = str2func (M2); + M2m1x = @(x) feval (fun, x, "notransp"); + M2tm1x = @(x) feval (fun, x, "transp"); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + M2tm1x = @(x) M2' \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x, "notransp"); + M2tm1x = @(x) feval (M2, x, "transp"); + else + error (["bicg: preconditioner is expected to " ... + "be a function or matrix"]); + endif + + Pm1x = @(x) M2m1x (M1m1x (x)); + Ptm1x = @(x) M1tm1x (M2tm1x (x)); + + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif + + y = x = x0; + c = b; + + r0 = b - Ax (x); + s0 = c - Atx (y); + + d = Pm1x (r0); + f = Ptm1x (s0); + + bnorm = norm (b); + res0 = Inf; + + if (any (r0 != 0)) + + for k = 1:maxit + + a = (s0' * Pm1x (r0)) ./ (f' * Ax (d)); + + x += a * d; + y += conj (a) * f; + + r1 = r0 - a * Ax (d); + s1 = s0 - conj (a) * Atx (f); + + beta = (s1' * Pm1x (r1)) ./ (s0' * Pm1x (r0)); + + d = Pm1x (r1) + beta * d; + f = Ptm1x (s1) + conj (beta) * f; + + r0 = r1; + s0 = s1; + + res1 = norm (b - Ax (x)) / bnorm; + if (res1 < tol) + flag = 0; + if (nargout < 2) + printf ("bicg converged at iteration %i ", k); + printf ("to a solution with relative residual %e\n", res1); + endif + break; + endif + + if (res0 <= res1) + flag = 3; + printf ("bicg stopped at iteration %i ", k); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the method stagnated.\n"); + printf ("The iterate returned (number %i) ", k-1); + printf ("has relative residual %e\n", res0); + break + endif + res0 = res1; + if (nargout > 4) + resvec(k) = res0; + endif + endfor + + if (k == maxit) + flag = 1; + printf ("bicg stopped at iteration %i ", maxit); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the maximum number of iterations was reached. "); + printf ("The iterate returned (number %i) has ", maxit); + printf ("relative residual %e\n", res1); + endif + + else + flag = 0; + if (nargout < 2) + printf ("bicg converged after 0 interations\n"); + endif + endif + + else + print_usage (); + endif + +endfunction; + + +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! [x, flag, relres, iter, resvec] = bicg (A, b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); +%! + +%!function y = afun (x, t, a) +%! switch t +%! case "notransp" +%! y = a * x; +%! case "transp" +%! y = a' * x; +%! endswitch +%!endfunction +%! +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! +%! [x, flag, relres, iter, resvec] = bicg (@(x, t) afun (x, t, A), +%! b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a' * a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = bicg (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7);
--- a/scripts/sparse/bicgstab.m +++ b/scripts/sparse/bicgstab.m @@ -1,4 +1,5 @@ ## Copyright (C) 2008-2011 Radek Salac +## Copyright (C) 2011 Carlo de Falco ## ## This file is part of Octave. ## @@ -17,155 +18,181 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} bicgstab (@var{A}, @var{b}) -## @deftypefnx {Function File} {} bicgstab (@var{A}, @var{b}, @var{tol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) -## This procedure attempts to solve a system of linear equations A*x = b for x. -## The @var{A} must be square, symmetric and positive definite real matrix N*N. -## The @var{b} must be a one column vector with a length of N. -## The @var{tol} specifies the tolerance of the method, the default value is -## 1e-6. -## The @var{maxit} specifies the maximum number of iterations, the default value -## is min(20,N). -## The @var{M1} specifies a preconditioner, can also be a function handler which -## returns M\X. -## The @var{M2} combined with @var{M1} defines preconditioner as -## preconditioner=M1*M2. -## The @var{x0} is the initial guess, the default value is zeros(N,1). +## +## @deftypefn {Function File} {@var{x} =} bicgstab (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} bicgstab (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} bicgstab (@var{A}, @var{b}, ...) +## Solve @code{A x = b} using the stabilizied Bi-conjugate gradient iterative method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given or set to +## [] the default value 1e-6 is used. +## @item @var{maxit} the maximum number of outer iterations, if not +## given or set to [] the default value @code{min (20, numel (b))} is +## used. +## @item @var{x0} the initial guess, if not given or set to [] the +## default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x) = A*x}. ## -## The value @var{x} is a computed result of this procedure. -## The value @var{flag} can be 0 when we reach tolerance in @var{maxit} -## iterations, 1 when -## we don't reach tolerance in @var{maxit} iterations and 3 when the procedure -## stagnates. -## The value @var{relres} is a relative residual - norm(b-A*x)/norm(b). -## The value @var{iter} is an iteration number in which x was computed. -## The value @var{resvec} is a vector of @var{relres} for each iteration. +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as a function handle or +## inline function @code{g} such that @code{g(x) = M1 \ x} or @code{g(x) = M2 \ x}. +## +## If called with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## @item 1: the maximum number of iterations was reached before convergence +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## @item @var{relres} is the final value of the relative residual. +## @item @var{iter} is the number of iterations performed. +## @item @var{resvec} is a vector containing the relative residual at each iteration. +## @end itemize +## +## @seealso{bicg,cgs,gmres,pcg} ## ## @end deftypefn -function [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, M1, M2, x0) +function [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, + M1, M2, x0) + + if (nargin >= 2 && nargin <= 7 && isvector (full (b))) - if (nargin < 2 || nargin > 7 || nargout > 5) - print_usage (); - elseif (!(isnumeric (A) && issquare (A))) - error ("bicgstab: A must be a square numeric matrix"); - elseif (!isvector (b)) - error ("bicgstab: B must be a vector"); - elseif (!any (b)) - error ("bicgstab: B must not be a vector of all zeros"); - elseif (rows (A) != rows (b)) - error ("bicgstab: A and B must have the same number of rows"); - elseif (nargin > 2 && !isscalar (tol)) - error ("bicgstab: TOL must be a scalar"); - elseif (nargin > 3 && !isscalar (maxit)) - error ("bicgstab: MAXIT must be a scalar"); - elseif (nargin > 4 && ismatrix (M1) && (rows (M1) != rows (A) || columns (M1) != columns (A))) - error ("bicgstab: M1 must have the same number of rows and columns as A"); - elseif (nargin > 5 && (!ismatrix (M2) || rows (M2) != rows (A) || columns (M2) != columns (A))) - error ("bicgstab: M2 must have the same number of rows and columns as A"); - elseif (nargin > 6 && !isvector (x0)) - error ("bicgstab: X0 must be a vector"); - elseif (nargin > 6 && rows (x0) != rows (b)) - error ("bicgstab: X0 must have the same number of rows as B"); - endif + if (ischar (A)) + A = str2func (A); + elseif (ismatrix (A)) + Ax = @(x) A * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x); + else + error (["bicgstab: first argument is expected " ... + "to be a function or a square matrix"]); + endif - ## Default tolerance. - if (nargin < 3) - tol = 1e-6; - endif + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif - ## Default maximum number of iteration. - if (nargin < 4) - maxit = min (rows (b), 20); - endif + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif - ## Left preconditioner. - if (nargin == 5) - if (isnumeric (M1)) - precon = @(x) M1 \ x; + if (nargin < 5 || isempty (M1)) + M1m1x = @(x) x; + elseif (ischar (M1)) + M1m1x = str2func (M1); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x); + else + error (["bicgstab: preconditioner is " ... + "expected to be a function or matrix"]); endif - elseif (nargin > 5) - if (issparse (M1) && issparse (M2)) - precon = @(x) M2 \ (M1 \ x); - else - M = M1*M2; - precon = @(x) M \ x; - endif - else - precon = @(x) x; - endif - ## specifies initial estimate x0 - if (nargin < 7) - x = zeros (rows (b), 1); - else - x = x0; - endif - - norm_b = norm (b); - - res = b - A*x; - rr = res; + if (nargin < 6 || isempty (M2)) + M2m1x = @(x) x; + elseif (ischar (M2)) + M2m1x = str2func (M2); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x); + else + error (["bicgstab: preconditioner is "... + "expected to be a function or matrix"]); + endif - ## Vector of the residual norms for each iteration. - resvec = [norm(res)/norm_b]; + precon = @(x) M2m1x (M1m1x (x)); - ## Default behaviour we don't reach tolerance tol within maxit iterations. - flag = 1; + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif - for iter = 1:maxit - rho_1 = res' * rr; - - if (iter == 1) - p = res; + ## specifies initial estimate x0 + if (nargin < 7) + x = zeros (rows (b), 1); else - beta = (rho_1 / rho_2) * (alpha / omega); - p = res + beta * (p - omega * v); + x = x0; endif - phat = precon (p); + norm_b = norm (b); + + res = b - Ax (x); + rr = res; - v = A * phat; - alpha = rho_1 / (rr' * v); - s = res - alpha * v; + ## Vector of the residual norms for each iteration. + resvec = norm(res) / norm_b; - shat = precon (s); + ## Default behaviour we don't reach tolerance tol within maxit iterations. + flag = 1; + + for iter = 1:maxit + rho_1 = res' * rr; - t = A * shat; - omega = (t' * s) / (t' * t); - x = x + alpha * phat + omega * shat; - res = s - omega * t; - rho_2 = rho_1; + if (iter == 1) + p = res; + else + beta = (rho_1 / rho_2) * (alpha / omega); + p = res + beta * (p - omega * v); + endif + + phat = precon (p); - relres = norm (res) / norm_b; - resvec = [resvec; relres]; + v = Ax (phat); + alpha = rho_1 / (rr' * v); + s = res - alpha * v; + + shat = precon (s); + + t = Ax (shat); + omega = (t' * s) / (t' * t); + x = x + alpha * phat + omega * shat; + res = s - omega * t; + rho_2 = rho_1; - if (relres <= tol) - ## We reach tolerance tol within maxit iterations. - flag = 0; - break; - elseif (resvec (end) == resvec (end - 1)) - ## The method stagnates. - flag = 3; - break; - endif - endfor + relres = norm (res) / norm_b; + resvec = [resvec; relres]; + + if (relres <= tol) + ## We reach tolerance tol within maxit iterations. + flag = 0; + break; + elseif (resvec(end) == resvec(end - 1)) + ## The method stagnates. + flag = 3; + break; + endif + endfor - if (nargout < 2) - if (flag == 0) - printf (["bicgstab converged at iteration %i ", - "to a solution with relative residual %e\n"],iter,relres); - elseif (flag == 3) - printf (["bicgstab stopped at iteration %i ", - "without converging to the desired tolerance %e\n", - "because the method stagnated.\n", - "The iterate returned (number %i) has relative residual %e\n"],iter,tol,iter,relres); - else - printf (["bicgstab stopped at iteration %i ", - "without converging to the desired toleranc %e\n", - "because the maximum number of iterations was reached.\n", - "The iterate returned (number %i) has relative residual %e\n"],iter,tol,iter,relres); + if (nargout < 2) + if (flag == 0) + printf ("bicgstab converged at iteration %i ", iter); + printf ("to a solution with relative residual %e\n", relres); + elseif (flag == 3) + printf ("bicgstab stopped at iteration %i ", iter); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the method stagnated.\n"); + printf ("The iterate returned (number %i) ", iter); + printf ("has relative residual %e\n", relres); + else + printf ("bicgstab stopped at iteration %i ", iter); + printf ("without converging to the desired toleranc %e\n", tol); + printf ("because the maximum number of iterations was reached.\n"); + printf ("The iterate returned (number %i) ", iter); + printf ("has relative residual %e\n", relres); + endif endif + + else + print_usage (); endif endfunction @@ -176,3 +203,36 @@ %! b = [7;-1;4] %! [x, flag, relres, iter, resvec] = bicgstab(A, b) +%!shared A, b, n, M1, M2 +%! +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); +%! +%!test +%! tol = 1e-8; +%! maxit = 15; +%! +%! function y = afun (x, a) +%! y = a * x; +%! endfunction +%! +%! [x, flag, relres, iter, resvec] = bicgstab (@(x) afun (x, A), b, +%! tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a'*a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7);
--- a/scripts/sparse/cgs.m +++ b/scripts/sparse/cgs.m @@ -1,4 +1,5 @@ ## Copyright (C) 2008-2011 Radek Salac +## Copyright (C) 2011 Carlo de Falco ## ## This file is part of Octave. ## @@ -17,134 +18,165 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cgs (@var{A}, @var{b}) -## @deftypefnx {Function File} {} cgs (@var{A}, @var{b}, @var{tol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) -## This procedure attempts to solve a system of linear equations A*x = b for x. -## The @var{A} must be square, symmetric and positive definite real matrix N*N. -## The @var{b} must be a one column vector with a length of N. -## The @var{tol} specifies the tolerance of the method, default value is 1e-6. -## The @var{maxit} specifies the maximum number of iteration, default value is -## MIN(20,N). -## The @var{M1} specifies a preconditioner, can also be a function handler which -## returns M\X. -## The @var{M2} combined with @var{M1} defines preconditioner as -## preconditioner=M1*M2. -## The @var{x0} is initial guess, default value is zeros(N,1). +## +## @deftypefn {Function File} {@var{x} =} cgs (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} cgs (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} cgs (@var{A}, @var{b}, ...) +## Solve @code{A x = b}, where @var{A} is a square matrix, using the +## Conjugate Gradients Squared method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given or set to [] +## the default value 1e-6 is used. +## @item @var{maxit} the maximum number of outer iterations, if not +## given or set to [] the default value @code{min (20, numel (b))} is +## used. +## @item @var{x0} the initial guess, if not given or set to [] the +## default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x) = A*x}. ## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as a function +## handle or inline function @code{g} such that @code{g(x) = M1 \ x} or +## @code{g(x) = M2 \ x}. +## +## If called with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## @item 1: the maximum number of iterations was reached before convergence +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## @item @var{relres} is the final value of the relative residual. +## @item @var{iter} is the number of iterations performed. +## @item @var{resvec} is a vector containing the relative residual at +## each iteration. +## @end itemize +## +## @seealso{pcg,bicgstab,bicg,gmres} ## @end deftypefn function [x, flag, relres, iter, resvec] = cgs (A, b, tol, maxit, M1, M2, x0) - if (nargin < 2 || nargin > 7 || nargout > 5) - print_usage (); - elseif (!(isnumeric (A) && issquare (A))) - error ("cgs: A must be a square numeric matrix"); - elseif (!isvector (b)) - error ("cgs: B must be a vector"); - elseif (rows (A) != rows (b)) - error ("cgs: A and B must have the same number of rows"); - elseif (nargin > 2 && !isscalar (tol)) - error ("cgs: TOL must be a scalar"); - elseif (nargin > 3 && !isscalar (maxit)) - error ("cgs: MAXIT must be a scalar"); - elseif (nargin > 4 && ismatrix (M1) && (rows (M1) != rows (A) || columns (M1) != columns (A))) - error ("cgs: M1 must have the same number of rows and columns as A"); - elseif (nargin > 5 && (!ismatrix (M2) || rows (M2) != rows (A) || columns (M2) != columns (A))) - error ("cgs: M2 must have the same number of rows and columns as A"); - elseif (nargin > 6 && !isvector (x0)) - error ("cgs: X0 must be a vector"); - elseif (nargin > 6 && rows (x0) != rows (b)) - error ("cgs: X0 must have the same number of rows as B"); - endif + if (nargin >= 2 && nargin <= 7 && isvector (full (b))) - ## Default tolerance. - if (nargin < 3) - tol = 1e-6; - endif + if (ischar (A)) + A = str2func (A); + elseif (ismatrix (A)) + Ax = @(x) A * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x); + else + error (["cgs: first argument is expected to "... + "be a function or a square matrix"]); + endif + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif - ## Default maximum number of iteration. - if (nargin < 4) - maxit = min (rows (b),20); - endif - - ## Left preconditioner. - if (nargin == 5) - if (isnumeric (M1)) - precon = @(x) M1 \ x; - endif - elseif (nargin > 5) - if (issparse (M1) && issparse (M2)) - precon = @(x) M2 \ (M1 \ x); + if (nargin < 5 || isempty (M1)) + M1m1x = @(x) x; + elseif (ischar (M1)) + M1m1x = str2func (M1); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x); else - M = M1*M2; - precon = @(x) M \ x; + error ("cgs: preconditioner is expected to be a function or matrix"); endif - else - precon = @(x) x; - endif - ## Specifies initial estimate x0. - if (nargin < 7) - x = zeros (rows (b), 1); - else + if (nargin < 6 || isempty (M2)) + M2m1x = @(x) x; + elseif (ischar (M2)) + M2m1x = str2func (M2); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x); + else + error ("cgs: preconditioner is expected to be a function or matrix"); + endif + + precon = @(x) M2m1x (M1m1x (x)); + + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif + + x = x0; - endif - res = b - A * x; - norm_b = norm (b); - ## Vector of the residual norms for each iteration. - resvec = [ norm(res)/norm_b ]; - ro = 0; - ## Default behavior we don't reach tolerance tol within maxit iterations. - flag = 1; - for iter = 1 : maxit + res = b - Ax (x); + norm_b = norm (b); + ## Vector of the residual norms for each iteration. + resvec = norm (res) / norm_b; + ro = 0; + ## Default behavior we don't reach tolerance tol within maxit iterations. + flag = 1; + for iter = 1:maxit - z = precon (res); + z = precon (res); - ## Cache. - ro_old = ro; - ro = res' * z; - if (iter == 1) - p = z; - else - beta = ro / ro_old; - p = z + beta * p; - endif - ## Cache. - q = A * p; - alpha = ro / (p' * q); - x = x + alpha * p; + ## Cache. + ro_old = ro; + ro = res' * z; + if (iter == 1) + p = z; + else + beta = ro / ro_old; + p = z + beta * p; + endif + ## Cache. + q = Ax (p); + alpha = ro / (p' * q); + x = x + alpha * p; + + res = res - alpha * q; + relres = norm (res) / norm_b; + resvec = [resvec; relres]; - res = res - alpha * q; - relres = norm(res) / norm_b; - resvec = [resvec;relres]; - - if (relres <= tol) - ## We reach tolerance tol within maxit iterations. - flag = 0; - break; - elseif (resvec (end) == resvec (end - 1)) - ## The method stagnates. - flag = 3; - break; - endif - endfor; + if (relres <= tol) + ## We reach tolerance tol within maxit iterations. + flag = 0; + break + elseif (resvec (end) == resvec (end - 1)) + ## The method stagnates. + flag = 3; + break + endif + endfor - if (nargout < 1) - if ( flag == 0 ) - printf (["cgs converged at iteration %i ", - "to a solution with relative residual %e\n"],iter,relres); - elseif (flag == 3) - printf (["cgs stopped at iteration %i ", - "without converging to the desired tolerance %e\n", - "because the method stagnated.\n", - "The iterate returned (number %i) has relative residual %e\n"],iter,tol,iter,relres); - else - printf (["cgs stopped at iteration %i ", - "without converging to the desired tolerance %e\n", - "because the maximum number of iterations was reached.\n", - "The iterate returned (number %i) has relative residual %e\n"],iter,tol,iter,relres); + if (nargout < 1) + if (flag == 0) + printf ("cgs converged at iteration %i to a solution with relative residual %e\n", + iter, relres); + elseif (flag == 3) + printf (["cgs stopped at iteration %i without converging to the desired tolerance %e\n", + "because the method stagnated.\n", + "The iterate returned (number %i) has relative residual %e\n"], + iter, tol, iter, relres); + else + printf (["cgs stopped at iteration %i without converging to the desired tolerance %e\n", + "because the maximum number of iterations was reached.\n", + "The iterate returned (number %i) has relative residual %e\n"], + iter, tol, iter, relres); + endif endif + + else + print_usage (); endif endfunction @@ -156,3 +188,31 @@ %! A=[5 -1 3;-1 2 -2;3 -2 3] %! b=[7;-1;4] %! [a,b,c,d,e]=cgs(A,b) + +%!shared A, b, n, M +%! +%!test +%! n = 100; +%! A = spdiags ([-ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 1000; +%! M = 4*eye (n); +%! [x, flag, relres, iter, resvec] = cgs (A, b, tol, maxit, M); +%! assert (x, ones (size (b)), 1e-7); +%! +%!test +%! tol = 1e-8; +%! maxit = 15; +%! +%! [x, flag, relres, iter, resvec] = cgs (@(x) A * x, b, tol, maxit, M); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a'*a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = cgs (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7);
--- a/scripts/sparse/etreeplot.m +++ b/scripts/sparse/etreeplot.m @@ -20,7 +20,7 @@ ## @deftypefn {Function File} {} etreeplot (@var{A}) ## @deftypefnx {Function File} {} etreeplot (@var{A}, @var{node_style}, @var{edge_style}) ## Plot the elimination tree of the matrix @var{A} or -## @code{@var{A}+@var{A}'} if @var{A} in not symmetric. The optional +## @xcode{@var{A}+@var{A}'} if @var{A} in not symmetric. The optional ## parameters @var{node_style} and @var{edge_style} define the output ## style. ## @seealso{treeplot, gplot}
rename from scripts/linear-algebra/gmres.m rename to scripts/sparse/gmres.m --- a/scripts/linear-algebra/gmres.m +++ b/scripts/sparse/gmres.m @@ -1,17 +1,17 @@ ## Copyright (C) 2009-2011 Carlo de Falco -## +## ## 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 ## <http://www.gnu.org/licenses/>. @@ -49,35 +49,28 @@ ## ## @itemize @minus ## @item @var{flag} indicates the exit status: -## ## @table @asis -## @item 0 : iteration converged to within the specified tolerance -## -## @item 1 : maximum number of iterations exceeded -## -## @item 2 : unused, but skipped for compatibility -## -## @item 3 : algorithm reached stagnation +## @item 0 : iteration converged to within the specified tolerance +## @item 1 : maximum number of iterations exceeded +## @item 2 : unused, but skipped for compatibility +## @item 3 : algorithm reached stagnation ## @end table -## ## @item @var{relres} is the final value of the relative residual. -## ## @item @var{iter} is a vector containing the number of outer iterations and ## total iterations performed. -## ## @item @var{resvec} is a vector containing the relative residual at each ## iteration. ## @end itemize ## -## @seealso{pcg, cgs, bicgstab} +## @seealso{bicg, bicgstab, cgs, pcg} ## @end deftypefn -function [x, flag, prec_res_norm, itcnt] = gmres (A, b, restart, rtol, maxit, M1, M2, x0) +function [x, flag, presn, it] = gmres (A, b, restart, rtol, maxit, M1, M2, x0) if (nargin < 2 || nargin > 8) - print_usage (); + print_usage (); endif - + if (ischar (A)) Ax = str2func (A); elseif (ismatrix (A)) @@ -111,7 +104,7 @@ else error ("gmres: preconditioner M1 must be a function or matrix"); endif - + if (nargin < 7 || isempty (M2)) M2m1x = @(x) x; elseif (ischar (M2)) @@ -130,62 +123,67 @@ x0 = zeros (size (b)); endif - x_old = x0; + x_old = x0; x = x_old; prec_res = Pm1x (b - Ax (x_old)); - prec_res_norm = norm (prec_res, 2); - + presn = norm (prec_res, 2); + B = zeros (restart + 1, 1); V = zeros (rows (x), restart); H = zeros (restart + 1, restart); ## begin loop iter = 1; - restart_it = restart + 1; + restart_it = restart + 1; resids = zeros (maxit, 1); - resids(1) = prec_res_norm; + resids(1) = presn; prec_b_norm = norm (Pm1x (b), 2); flag = 1; - while ((iter <= maxit * restart) && (prec_res_norm > rtol * prec_b_norm)) - + while (iter <= maxit * restart && presn > rtol * prec_b_norm) + ## restart if (restart_it > restart) restart_it = 1; - x_old = x; + x_old = x; prec_res = Pm1x (b - Ax (x_old)); - prec_res_norm = norm (prec_res, 2); - B(1) = prec_res_norm; + presn = norm (prec_res, 2); + B(1) = presn; H(:) = 0; - V(:, 1) = prec_res / prec_res_norm; - endif - + V(:, 1) = prec_res / presn; + endif + ## basic iteration tmp = Pm1x (Ax (V(:, restart_it))); - [V(:,restart_it+1), H(1:restart_it+1, restart_it)] = mgorth (tmp, V(:,1:restart_it)); - + [V(:,restart_it+1), H(1:restart_it+1, restart_it)] = ... + mgorth (tmp, V(:,1:restart_it)); + Y = (H(1:restart_it+1, 1:restart_it) \ B (1:restart_it+1)); - - little_res = B(1:restart_it+1) - H(1:restart_it+1, 1:restart_it) * Y(1:restart_it); - prec_res_norm = norm (little_res, 2); - + + little_res = B(1:restart_it+1) - ... + H(1:restart_it+1, 1:restart_it) * Y(1:restart_it); + + presn = norm (little_res, 2); + x = x_old + V(:, 1:restart_it) * Y(1:restart_it); - - resids(iter) = prec_res_norm ; + + resids(iter) = presn; if (norm (x - x_old, inf) <= eps) flag = 3; break endif - restart_it++ ; iter++; + restart_it++ ; + iter++; endwhile - if (prec_res_norm > rtol * prec_b_norm) + if (presn > rtol * prec_b_norm) flag = 0; endif resids = resids(1:iter-1); - itcnt = [floor(maxit/restart), rem(maxit, restart)]; + it = [floor(maxit/restart), rem(maxit, restart)]; + endfunction @@ -193,12 +191,12 @@ %! dim = 100; %!test %! A = spdiags ([-ones(dim,1) 2*ones(dim,1) ones(dim,1)], [-1:1], dim, dim); -%! b = ones(dim, 1); +%! b = ones(dim, 1); %! x = gmres (A, b, 10, 1e-10, dim, @(x) x./diag(A), [], b); %! assert(x, A\b, 1e-9*norm(x,inf)); %! %!test -%! x = gmres (A, b, dim, 1e-10, 1e4, @(x) diag(diag(A))\x, [], b); +%! x = gmres (A, b, dim, 1e-10, 1e4, @(x) diag(diag(A))\x, [], b); %! assert(x, A\b, 1e-7*norm(x,inf)); %! %!test
--- a/scripts/sparse/gplot.m +++ b/scripts/sparse/gplot.m @@ -54,3 +54,31 @@ endif endfunction + + +%!demo +%! ## Binary Tree Representation +%! A = [0 1 0 0 0 0 0 +%! 1 0 1 1 0 0 0 +%! 0 1 0 0 0 0 0 +%! 0 1 0 0 1 0 0 +%! 0 0 0 1 0 1 1 +%! 0 0 0 0 1 0 0 +%! 0 0 0 0 1 0 0]; +%! +%! xy = [1, 0 +%! 1.5, 1 +%! 2, 0 +%! 2.5, 2 +%! 3.5, 1 +%! 3, 0 +%! 4, 0]; +%! +%! clf; +%! gplot (A, xy, "o-"); +%! set (get (gca, ("children")), "markersize", 12); +%! title ("gplot() of Binary Tree Adjacency matrix"); + +%% Mark graphical function as tested by demo block +%!assert (1); +
--- a/scripts/sparse/module.mk +++ b/scripts/sparse/module.mk @@ -1,10 +1,15 @@ FCN_FILE_DIRS += sparse +sparse_PRIVATE_FCN_FILES = \ + sparse/private/__sprand_impl__.m + sparse_FCN_FILES = \ + sparse/bicg.m \ sparse/bicgstab.m \ sparse/cgs.m \ sparse/colperm.m \ sparse/etreeplot.m \ + sparse/gmres.m \ sparse/gplot.m \ sparse/nonzeros.m \ sparse/pcg.m \ @@ -22,7 +27,8 @@ sparse/spy.m \ sparse/svds.m \ sparse/treelayout.m \ - sparse/treeplot.m + sparse/treeplot.m \ + $(sparse_PRIVATE_FCN_FILES) FCN_FILES += $(sparse_FCN_FILES)
--- a/scripts/sparse/nonzeros.m +++ b/scripts/sparse/nonzeros.m @@ -27,12 +27,13 @@ print_usage (); endif - [i, j, t] = find (s); + [~, ~, t] = find (s); t = t(:); endfunction + %!assert(nonzeros([1,2;3,0]),[1;3;2]) %!assert(nonzeros([1,2,3,0]),[1;2;3]) %!assert(nonzeros(sparse([1,2;3,0])),[1;3;2])
new file mode 100644 --- /dev/null +++ b/scripts/sparse/private/__sprand_impl__.m @@ -0,0 +1,63 @@ +## Copyright (C) 2004-2011 Paul Kienzle +## Copyright (C) 2011 Jordi Gutiérrez Hermoso +## +## 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 +## <http://www.gnu.org/licenses/>. +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} __sprand_impl__ (@var{s}, @var{randfun}) +## @deftypefnx {Function File} {} __sprand_impl__ (@var{m}, @var{n}, @var{d}, @var{funname}, @var{randfun}) +## Undocumented internal function. +## @end deftypefn + +## Actual implementation of sprand and sprandn happens here. + +function S = __sprand_impl__ (varargin) + + if (nargin == 2) + m = varargin{1}; + randfun = varargin{2}; + [i, j] = find (m); + [nr, nc] = size (m); + S = sparse (i, j, randfun (size (i)), nr, nc); + return; + endif + + [m, n, d, funname, randfun] = deal(varargin{:}); + + if (!(isscalar (m) && m == fix (m) && m > 0)) + error ("%s: M must be an integer greater than 0", funname); + endif + + if (!(isscalar (n) && n == fix (n) && n > 0)) + error ("%s: N must be an integer greater than 0", funname); + endif + + if (d < 0 || d > 1) + error ("%s: density D must be between 0 and 1", funname); + endif + + mn = m*n; + k = round (d*mn); + idx = randperm (mn, k); + + [i, j] = ind2sub ([m, n], idx); + S = sparse (i, j, randfun (k, 1), m, n); + +endfunction \ No newline at end of file
--- a/scripts/sparse/spconvert.m +++ b/scripts/sparse/spconvert.m @@ -43,3 +43,25 @@ endif endfunction + + +%!test +%! i = [1; 3; 5]; +%! j = [2; 4; 6]; +%! v = [7; 8; 9]; +%! s = spconvert ([i, j, v]); +%! assert (issparse (s)); +%! [fi, fj, fv] = find (s); +%! assert (isequal (i, fi) && isequal (j, fj) && isequal (v, fv)); +%! s = spconvert ([i, j, v, j]); +%! [fi, fj, fv] = find (s); +%! assert (isequal (i, fi) && isequal (j, fj) && isequal (complex (v, j), fv)); +%! assert (size (spconvert ([1, 1, 3; 5, 15, 0])), [5, 15]); + +%% Test input validation +%!error spconvert () +%!error spconvert (1, 2) +%!error spconvert ({[1 2 3]}) +%!error spconvert ([1 2]) +%!error spconvert ([1 2 3i]) +%!error spconvert ([1 2 3 4 5])
--- a/scripts/sparse/sprand.m +++ b/scripts/sparse/sprand.m @@ -27,12 +27,9 @@ ## @var{d} should be between 0 and 1. Values will be uniformly ## distributed between 0 and 1. ## -## Note: sometimes the actual density may be a bit smaller than @var{d}. -## This is unlikely to happen for large, truly sparse, matrices. -## ## If called with a single matrix argument, a random sparse matrix is ## generated wherever the matrix @var{S} is non-zero. -## @seealso{sprandn} +## @seealso{sprandn, sprandsym} ## @end deftypefn ## Author: Paul Kienzle <pkienzle@users.sf.net> @@ -47,48 +44,39 @@ function S = sprand (m, n, d) - if (nargin != 1 && nargin != 3) + if (nargin == 1 ) + S = __sprand_impl__ (m, @rand); + elseif ( nargin == 3) + S = __sprand_impl__ (m, n, d, "sprand", @rand); + else print_usage (); endif - if (nargin == 1) - [i, j, v] = find (m); - [nr, nc] = size (m); - S = sparse (i, j, rand (size (v)), nr, nc); - return; - endif - - if (!(isscalar (m) && m == fix (m) && m > 0)) - error ("sprand: M must be an integer greater than 0"); - endif - - if (!(isscalar (n) && n == fix (n) && n > 0)) - error ("sprand: N must be an integer greater than 0"); - endif - - if (d < 0 || d > 1) - error ("sprand: density D must be between 0 and 1"); - endif - - mn = m*n; - ## how many entries in S would be satisfactory? - k = round (d*mn); - idx = unique (fix (rand (min (k*1.01, k+10), 1) * mn)) + 1; - ## idx contains random numbers in [1,mn] - ## generate 1% or 10 more random values than necessary in order to - ## reduce the probability that there are less than k distinct - ## values; maybe a better strategy could be used but I don't think - ## it's worth the price - - ## actual number of entries in S - k = min (length (idx), k); - j = floor ((idx(1:k)-1)/m); - i = idx(1:k) - j*m; - if (isempty (i)) - S = sparse (m, n); - else - S = sparse (i, j+1, rand (k, 1), m, n); - endif - endfunction +%!test +%! s = sprand (4, 10, 0.1); +%! assert (size (s), [4, 10]); +%! assert (nnz (s) / numel (s), 0.1); + +%% Test 1-input calling form +%!test +%! s = sprand (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j, v] = find (s); +%! assert (sort (i), [1 2 3]'); +%! assert (sort (j), [2 3 3]'); +%! assert (all (v > 0 & v < 1)); + +%% Test input validation +%!error sprand () +%!error sprand (1, 2) +%!error sprand (1, 2, 3, 4) +%!error sprand (ones(3), 3, 0.5) +%!error sprand (3.5, 3, 0.5) +%!error sprand (0, 3, 0.5) +%!error sprand (3, ones(3), 0.5) +%!error sprand (3, 3.5, 0.5) +%!error sprand (3, 0, 0.5) +%!error sprand (3, 3, -1) +%!error sprand (3, 3, 2) +
--- a/scripts/sparse/sprandn.m +++ b/scripts/sparse/sprandn.m @@ -27,41 +27,48 @@ ## @var{d} should be between 0 and 1. Values will be normally ## distributed with mean of zero and variance 1. ## -## Note: sometimes the actual density may be a bit smaller than @var{d}. -## This is unlikely to happen for large really sparse matrices. -## ## If called with a single matrix argument, a random sparse matrix is ## generated wherever the matrix @var{S} is non-zero. -## @seealso{sprand} +## @seealso{sprand, sprandsym} ## @end deftypefn ## Author: Paul Kienzle <pkienzle@users.sf.net> function S = sprandn (m, n, d) - if (nargin == 1) - [i, j, v] = find (m); - [nr, nc] = size (m); - S = sparse (i, j, randn (size (v)), nr, nc); - elseif (nargin == 3) - mn = m*n; - k = round (d*mn); - idx = unique (fix (rand (min (k*1.01, k+10), 1) * mn)) + 1; - ## idx contains random numbers in [1,mn] - ## generate 1% or 10 more random values than necessary in order to - ## reduce the probability that there are less than k distinct - ## values; maybe a better strategy could be used but I don't think - ## it's worth the price. - ## actual number of entries in S - k = min (length (idx), k); - j = floor ((idx(1:k)-1)/m); - i = idx(1:k) - j*m; - if (isempty (i)) - S = sparse (m, n); - else - S = sparse (i, j+1, randn (k, 1), m, n); - endif + if (nargin == 1 ) + S = __sprand_impl__ (m, @randn); + elseif ( nargin == 3) + S = __sprand_impl__ (m, n, d, "sprandn", @randn); else print_usage (); endif + endfunction + + +%!test +%! s = sprandn (4, 10, 0.1); +%! assert (size (s), [4, 10]); +%! assert (nnz (s) / numel (s), 0.1); + +%% Test 1-input calling form +%!test +%! s = sprandn (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j] = find (s); +%! assert (sort (i), [1 2 3]'); +%! assert (sort (j), [2 3 3]'); + +%% Test input validation +%!error sprandn () +%!error sprandn (1, 2) +%!error sprandn (1, 2, 3, 4) +%!error sprandn (ones(3), 3, 0.5) +%!error sprandn (3.5, 3, 0.5) +%!error sprandn (0, 3, 0.5) +%!error sprandn (3, ones(3), 0.5) +%!error sprandn (3, 3.5, 0.5) +%!error sprandn (3, 0, 0.5) +%!error sprandn (3, 3, -1) +%!error sprandn (3, 3, 2) +
--- a/scripts/sparse/sprandsym.m +++ b/scripts/sparse/sprandsym.m @@ -1,4 +1,5 @@ ## Copyright (C) 2004-2011 David Bateman and Andy Adler +## Copyright (C) 2011 Jordi Gutiérrez Hermoso ## ## This file is part of Octave. ## @@ -24,9 +25,6 @@ ## @var{d} should be between 0 and 1. Values will be normally ## distributed with mean of zero and variance 1. ## -## Note: sometimes the actual density may be a bit smaller than @var{d}. -## This is unlikely to happen for large really sparse matrices. -## ## If called with a single matrix argument, a random sparse matrix is ## generated wherever the matrix @var{S} is non-zero in its lower ## triangular part. @@ -34,44 +32,145 @@ ## @end deftypefn function S = sprandsym (n, d) - if (nargin == 1) - [i, j, v] = find (tril (n)); - [nr, nc] = size (n); - S = sparse (i, j, randn (size (v)), nr, nc); - S = S + tril (S, -1)'; - elseif (nargin == 2) - m1 = floor (n/2); - n1 = m1 + rem (n, 2); - mn1 = m1*n1; - k1 = round (d*mn1); - idx1 = unique (fix (rand (min (k1*1.01, k1+10), 1) * mn1)) + 1; - ## idx contains random numbers in [1,mn] generate 1% or 10 more - ## random values than necessary in order to reduce the probability - ## that there are less than k distinct values; maybe a better - ## strategy could be used but I don't think it's worth the price. - ## Actual number of entries in S. - k1 = min (length (idx1), k1); - j1 = floor ((idx1(1:k1)-1)/m1); - i1 = idx1(1:k1) - j1*m1; - - n2 = ceil (n/2); - nn2 = n2*n2; - k2 = round (d*nn2); - idx2 = unique (fix (rand (min (k2*1.01, k1+10), 1) * nn2)) + 1; - k2 = min (length (idx2), k2); - j2 = floor ((idx2(1:k2)-1)/n2); - i2 = idx2(1:k2) - j2*n2; - - if (isempty (i1) && isempty (i2)) - S = sparse (n, n); - else - S1 = sparse (i1, j1+1, randn (k1, 1), m1, n1); - S = [tril(S1), sparse(m1,m1); ... - sparse(i2,j2+1,randn(k2,1),n2,n2), triu(S1,1)']; - S = S + tril (S, -1)'; - endif - else + if (nargin != 1 && nargin != 2) print_usage (); endif + + if (nargin == 1) + [i, j] = find (tril (n)); + [nr, nc] = size (n); + S = sparse (i, j, randn (size (i)), nr, nc); + S = S + tril (S, -1)'; + return; + endif + + if (!(isscalar (n) && n == fix (n) && n > 0)) + error ("sprandsym: N must be an integer greater than 0"); + endif + + if (d < 0 || d > 1) + error ("sprandsym: density D must be between 0 and 1"); + endif + + ## Actual number of nonzero entries + k = round (n^2*d); + + ## Diagonal nonzero entries, same parity as k + r = pick_rand_diag (n, k); + + ## Off diagonal nonzero entries + m = (k - r)/2; + + ondiag = randperm (n, r); + offdiag = randperm (n*(n - 1)/2, m); + + ## Row index + i = lookup (cumsum (0:n), offdiag - 1) + 1; + + ## Column index + j = offdiag - (i - 1).*(i - 2)/2; + + diagvals = randn (1, r); + offdiagvals = randn (1, m); + + S = sparse ([ondiag, i, j], [ondiag, j, i], + [diagvals, offdiagvals, offdiagvals], n, n); + endfunction + +function r = pick_rand_diag (n, k) + ## Pick a random number R of entries for the diagonal of a sparse NxN + ## square matrix with exactly K nonzero entries, ensuring that this R + ## is chosen uniformly over all such matrices. + ## + ## Let D be the number of diagonal entries and M the number of + ## off-diagonal entries. Then K = D + 2*M. Let A = N*(N-1)/2 be the + ## number of available entries in the upper triangle of the matrix. + ## Then, by a simple counting argument, there is a total of + ## + ## T = nchoosek (N, D) * nchoosek (A, M) + ## + ## symmetric NxN matrices with a total of K nonzero entries and D on + ## the diagonal. Letting D range from mod (K,2) through min (N,K), and + ## dividing by this sum, we obtain the probability P for D to be each + ## of those values. + ## + ## However, we cannot use this form for computation, as the binomial + ## coefficients become unmanageably large. Instead, we use the + ## successive quotients Q(i) = T(i+1)/T(i), which we easily compute to + ## be + ## + ## (N - D)*(N - D - 1)*M + ## Q = ------------------------------- + ## (D + 2)*(D + 1)*(A - M + 1) + ## + ## Then, after prepending 1, the cumprod of these quotients is + ## + ## C = [ T(1)/T(1), T(2)/T(1), T(3)/T(1), ..., T(N)/T(1) ] + ## + ## Their sum is thus S = sum (T)/T(1), and then C(i)/S is the desired + ## probability P(i) for i=1:N. The cumsum will finally give the + ## distribution function for computing the random number of entries on + ## the diagonal R. + ## + ## Thanks to Zsbán Ambrus <ambrus@math.bme.hu> for most of the ideas + ## of the implementation here, especially how to do the computation + ## numerically to avoid overflow. + + ## Degenerate case + if k == 1 + r = 1; + return + endif + + ## Compute the stuff described above + a = n*(n - 1)/2; + d = [mod(k,2):2:min(n,k)-2]; + m = (k - d)/2; + q = (n - d).*(n - d - 1).*m ./ (d + 2)./(d + 1)./(a - m + 1); + + ## Slight modification from discussion above: pivot around the max in + ## order to avoid overflow (underflow is fine, just means effectively + ## zero probabilities). + [~, midx] = max (cumsum (log (q))) ; + midx++; + lc = fliplr (cumprod (1./q(midx-1:-1:1))); + rc = cumprod (q(midx:end)); + + ## Now c = t(i)/t(midx), so c > 1 == []. + c = [lc, 1, rc]; + s = sum (c); + p = c/s; + + ## Add final d + d(end+1) = d(end) + 2; + + ## Pick a random r using this distribution + r = d(sum (cumsum (p) < rand) + 1); + +endfunction + +%!test +%! s = sprandsym (10, 0.1); +%! assert (issparse (s)); +%! assert (issymmetric (s)); +%! assert (size (s), [10, 10]); +%! assert (nnz (s) / numel (s), 0.1, .01); + +%% Test 1-input calling form +%!test +%! s = sprandsym (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j] = find (s); +%! assert (sort (i), [2 3]'); +%! assert (sort (j), [2 3]'); + +%% Test input validation +%!error sprandsym () +%!error sprandsym (1, 2, 3) +%!error sprandsym (ones(3), 0.5) +%!error sprandsym (3.5, 0.5) +%!error sprandsym (0, 0.5) +%!error sprandsym (3, -1) +%!error sprandsym (3, 2) +
--- a/scripts/sparse/spy.m +++ b/scripts/sparse/spy.m @@ -21,7 +21,7 @@ ## @deftypefnx {Function File} {} spy (@dots{}, @var{markersize}) ## @deftypefnx {Function File} {} spy (@dots{}, @var{line_spec}) ## Plot the sparsity pattern of the sparse matrix @var{x}. If the argument -## @var{markersize} is given as an scalar value, it is used to determine the +## @var{markersize} is given as a scalar value, it is used to determine the ## point size in the plot. If the string @var{line_spec} is given it is ## passed to @code{plot} and determines the appearance of the plot. ## @seealso{plot} @@ -41,7 +41,11 @@ endif for i = 1:length (varargin) if (ischar (varargin{i})) - line_spec = varargin{i}; + if (length (varargin{i}) == 1) + line_spec = [line_spec, varargin{i}]; + else + line_spec = varargin{i}; + endif elseif (isscalar (varargin{i})) markersize = varargin{i}; else @@ -61,3 +65,11 @@ axis ([0, n+1, 0, m+1], "ij"); endfunction + + +%!demo +%! clf; +%! spy (sprand (10,10, 0.2)); + +%% Mark graphical function as tested by demo block +%!assert (1);
--- a/scripts/sparse/svds.m +++ b/scripts/sparse/svds.m @@ -150,6 +150,8 @@ ## Scale everything by the 1-norm to make things more stable. b = A / max_a; b_opts = opts; + ## Call to eigs is always a symmetric matrix by construction + b_opts.issym = true; b_opts.tol = opts.tol / max_a; b_sigma = sigma; if (!ischar (b_sigma)) @@ -249,8 +251,12 @@ %! s = s(idx); %! u = u(:,idx); %! v = v(:,idx); +%! old_state1 = randn ("state"); +%! restore_state1 = onCleanup (@() randn ("state", old_state1)); +%! old_state2 = rand ("state"); +%! restore_state2 = onCleanup (@() rand ("state", old_state2)); %! randn ('state', 42); % Initialize to make normest function reproducible -%! rand ('state', 42) +%! rand ('state', 42); %! opts.v0 = rand (2*n,1); % Initialize eigs ARPACK starting vector %! % to guarantee reproducible results %!test @@ -277,3 +283,4 @@ %!test %! s = svds (speye (10)); %! assert (s, ones (6, 1), 2*eps); +
--- a/scripts/sparse/treelayout.m +++ b/scripts/sparse/treelayout.m @@ -202,10 +202,26 @@ endif endfunction -%!demo +%!test %! % Compute a simple tree layout -%! [x,y,h,s]=treelayout([0 1 2 2]) +%! [x, y, h, s] = treelayout ([0, 1, 2, 2]); +%! assert (x, [1.5, 1.5, 2, 1]); +%! assert (y, [3, 2, 1, 1]); +%! assert (h, 2); +%! assert (s, 2); -%!demo +%!test %! % Compute a simple tree layout with defined postorder permutation -%! [x,y,h,s]=treelayout([0 1 2 2],[1 2 3 4]) +%! [x, y, h, s] = treelayout ([0, 1, 2, 2], [1, 2, 4, 3]); +%! assert (x, [1.5, 1.5, 1, 2]); +%! assert (y, [3, 2, 1, 1]); +%! assert (h, 2); +%! assert (s, 2); + +%!test +%! % Compute a simple tree layout with defined postorder permutation +%! [x, y, h, s] = treelayout ([0, 1, 2, 2], [4, 2, 3, 1]); +%! assert (x, [0, 0, 0, 1]); +%! assert (y, [0, 0, 0, 3]); +%! assert (h, 0); +%! assert (s, 1);
--- a/scripts/specfun/bessel.m +++ b/scripts/specfun/bessel.m @@ -91,3 +91,4 @@ error ("bessel: you must use besselj, bessely, besseli, or besselk"); endfunction +%!error bessel ()
--- a/scripts/specfun/factorial.m +++ b/scripts/specfun/factorial.m @@ -29,7 +29,7 @@ function x = factorial (n) if (nargin != 1) print_usage (); - elseif (any (n(:) < 0 | n(:) != round (n(:)))) + elseif (any (n(:) < 0 | n(:) != fix (n(:)))) error ("factorial: N must all be nonnegative integers"); endif x = round (gamma (n+1));
rename from scripts/elfun/lcm.m rename to scripts/specfun/lcm.m --- a/scripts/elfun/lcm.m +++ b/scripts/specfun/lcm.m @@ -34,7 +34,7 @@ if (nargin > 1) if (common_size (varargin{:}) != 0) error ("lcm: all args must be of the same size or scalar"); - elseif (! all (cellfun (@isnumeric, varargin))) + elseif (! all (cellfun ("isnumeric", varargin))) error ("lcm: all arguments must be numeric"); endif
--- a/scripts/specfun/module.mk +++ b/scripts/specfun/module.mk @@ -7,6 +7,7 @@ specfun/factor.m \ specfun/factorial.m \ specfun/isprime.m \ + specfun/lcm.m \ specfun/legendre.m \ specfun/nchoosek.m \ specfun/nthroot.m \
--- a/scripts/specfun/nthroot.m +++ b/scripts/specfun/nthroot.m @@ -35,8 +35,9 @@ ## @end group ## @end example ## -## @var{n} must be a scalar. If @var{n} is not an even integer and @var{X} has -## negative entries, an error is produced. +## @var{x} must have all real entries. @var{n} must be a scalar. +## If @var{n} is an even integer and @var{X} has negative entries, an +## error is produced. ## @seealso{realsqrt, sqrt, cbrt} ## @end deftypefn @@ -46,7 +47,11 @@ print_usage (); endif - if (! isscalar (n)) + if (any (iscomplex (x(:)))) + error ("nthroot: X must not contain complex values"); + endif + + if (! isscalar (n) || n == 0) error ("nthroot: N must be a nonzero scalar"); endif @@ -58,7 +63,7 @@ y = 1 ./ nthroot (x, -n); else ## Compute using power. - if (n == round (n) && mod (n, 2) == 1) + if (n == fix (n) && mod (n, 2) == 1) y = abs (x) .^ (1/n) .* sign (x); elseif (any (x(:) < 0)) error ("nthroot: if X contains negative values, N must be an odd integer"); @@ -66,7 +71,7 @@ y = x .^ (1/n); endif - if (finite (n) && n > 0 && n == round (n)) + if (finite (n) && n > 0 && n == fix (n)) ## Correction. y = ((n-1)*y + x ./ (y.^(n-1))) / n; y = merge (finite (y), y, x); @@ -76,8 +81,18 @@ endfunction -%!assert(nthroot(-32,5), -2); -%!assert(nthroot(81,4), 3); -%!assert(nthroot(Inf,4), Inf); -%!assert(nthroot(-Inf,7), -Inf); -%!assert(nthroot(-Inf,-7), 0); +%!assert (nthroot(-32,5), -2); +%!assert (nthroot(81,4), 3); +%!assert (nthroot(Inf,4), Inf); +%!assert (nthroot(-Inf,7), -Inf); +%!assert (nthroot(-Inf,-7), 0); + +%% Test input validation +%!error (nthroot ()) +%!error (nthroot (1)) +%!error (nthroot (1,2,3)) +%!error (nthroot (1+j,2)) +%!error (nthroot (1,[1 2])) +%!error (nthroot (1,0)) +%!error (nthroot (-1,2)) +
--- a/scripts/specfun/perms.m +++ b/scripts/specfun/perms.m @@ -63,3 +63,11 @@ endfor endif endfunction + +%!error perms (); +%!error perms (1, 2); + +%!assert (perms ([1,2,3]), [1,2,3;2,1,3;1,3,2;2,3,1;3,1,2;3,2,1]); +%!assert (perms (1:3), perms ([1,2,3])); + +%!assert (perms (int8([1,2,3])), int8([1,2,3;2,1,3;1,3,2;2,3,1;3,1,2;3,2,1]));
--- a/scripts/specfun/primes.m +++ b/scripts/specfun/primes.m @@ -92,3 +92,11 @@ endif endfunction + +%!error primes (); +%!error primes (1, 2); + +%!assert (size (primes (350)), [1, 70]); +%!assert (size (primes (350)), [1, 70]); + +%!assert (primes (357)(end), 353);
--- a/scripts/special-matrix/module.mk +++ b/scripts/special-matrix/module.mk @@ -8,7 +8,6 @@ special-matrix/magic.m \ special-matrix/pascal.m \ special-matrix/rosser.m \ - special-matrix/sylvester_matrix.m \ special-matrix/toeplitz.m \ special-matrix/vander.m \ special-matrix/wilkinson.m
--- a/scripts/startup/__finish__.m +++ b/scripts/startup/__finish__.m @@ -36,3 +36,5 @@ endfunction +## No test needed for internal helper function. +%!assert (1)
--- a/scripts/statistics/base/center.m +++ b/scripts/statistics/base/center.m @@ -23,7 +23,7 @@ ## If @var{x} is a vector, subtract its mean. ## If @var{x} is a matrix, do the above for each column. ## If the optional argument @var{dim} is given, operate along this dimension. -## @seealso{studentize} +## @seealso{zscore} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -35,7 +35,7 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("center: X must be a numeric vector or matrix"); endif @@ -47,10 +47,7 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -58,25 +55,28 @@ endif endif - n = size (x, dim); + n = sz(dim); if (n == 0) retval = x; else - retval = bsxfun (@minus, x, sum (x, dim) / n); + retval = bsxfun (@minus, x, mean (x, dim)); endif endfunction %!assert(center ([1,2,3]), [-1,0,1]) +%!assert(center (single([1,2,3])), single([-1,0,1])) %!assert(center (int8 ([1,2,3])), [-1,0,1]) +%!assert(center (logical ([1, 0, 0, 1])), [0.5, -0.5, -0.5, 0.5]) %!assert(center (ones (3,2,0,2)), zeros (3,2,0,2)) +%!assert(center (ones (3,2,0,2, 'single')), zeros (3,2,0,2, 'single')) %!assert(center (magic (3)), [3,-4,1;-2,0,2;-1,4,-3]) +%!assert(center ([1 2 3; 6 5 4], 2), [-1 0 1; 1 0 -1]) %% Test input validation %!error center () %!error center (1, 2, 3) -%!error center ([true true]) %!error center (1, ones(2,2)) %!error center (1, 1.5) %!error center (1, 0)
new file mode 100644 --- /dev/null +++ b/scripts/statistics/base/corr.m @@ -0,0 +1,112 @@ +## Copyright (C) 1996-2011 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 +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} corr (@var{x}) +## @deftypefnx {Function File} {} corr (@var{x}, @var{y}) +## Compute matrix of correlation coefficients. +## +## If each row of @var{x} and @var{y} is an observation and each column is +## a variable, then the @w{(@var{i}, @var{j})-th} entry of +## @code{corr (@var{x}, @var{y})} is the correlation between the +## @var{i}-th variable in @var{x} and the @var{j}-th variable in @var{y}. +## @tex +## $$ +## {\rm corr}(x,y) = {{\rm cov}(x,y) \over {\rm std}(x) {\rm std}(y)} +## $$ +## @end tex +## @ifnottex +## +## @example +## corr(x,y) = cov(x,y)/(std(x)*std(y)) +## @end example +## +## @end ifnottex +## If called with one argument, compute @code{corr (@var{x}, @var{x})}, +## the correlation between the columns of @var{x}. +## @seealso{cov} +## @end deftypefn + +## Author: Kurt Hornik <hornik@wu-wien.ac.at> +## Created: March 1993 +## Adapted-By: jwe + +function retval = corr (x, y = []) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + ## Input validation is done by cov.m. Don't repeat tests here + + ## Special case, scalar is always 100% correlated with itself + if (isscalar (x)) + if (isa (x, 'single')) + retval = single (1); + else + retval = 1; + endif + return; + endif + + ## No check for division by zero error, which happens only when + ## there is a constant vector and should be rare. + if (nargin == 2) + c = cov (x, y); + s = std (x)' * std (y); + retval = c ./ s; + else + c = cov (x); + s = sqrt (diag (c)); + retval = c ./ (s * s'); + endif + +endfunction + + +%!test +%! x = rand (10); +%! cc1 = corr (x); +%! cc2 = corr (x, x); +%! assert (size (cc1) == [10, 10] && size (cc2) == [10, 10]); +%! assert (cc1, cc2, sqrt (eps)); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (corr (x,y), -1, 5*eps) +%! assert (corr (x,flipud (y)), 1, 5*eps) +%! assert (corr ([x, y]), [1 -1; -1 1], 5*eps) + +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (corr (x,y), single (-1), 5*eps) +%! assert (corr (x,flipud (y)), single (1), 5*eps) +%! assert (corr ([x, y]), single ([1 -1; -1 1]), 5*eps) + +%!assert (corr (5), 1); +%!assert (corr (single(5)), single(1)); + +%% Test input validation +%!error corr (); +%!error corr (1, 2, 3); +%!error corr ([1; 2], ["A", "B"]); +%!error corr (ones (2,2,2)); +%!error corr (ones (2,2), ones (2,2,2)); +
--- a/scripts/statistics/base/cov.m +++ b/scripts/statistics/base/cov.m @@ -55,7 +55,7 @@ ## @item 1: ## normalize with @math{N}, this provides the second moment around the mean ## @end table -## @seealso{corrcoef, cor} +## @seealso{corr} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -67,7 +67,8 @@ print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) error ("cov: X and Y must be numeric matrices or vectors"); endif @@ -75,7 +76,7 @@ error ("cov: X and Y must be 2-D matrices or vectors"); endif - if (nargin == 2 && isscalar(y)) + if (nargin == 2 && isscalar (y)) opt = y; endif @@ -83,22 +84,27 @@ error ("cov: normalization OPT must be 0 or 1"); endif + ## Special case, scalar has zero covariance if (isscalar (x)) - c = 0; + if (isa (x, 'single')) + c = single (0); + else + c = 0; + endif return; endif - if (rows (x) == 1) - x = x'; + if (isrow (x)) + x = x.'; endif n = rows (x); - if (nargin == 1 || isscalar(y)) + if (nargin == 1 || isscalar (y)) x = center (x, 1); c = conj (x' * x / (n - 1 + opt)); else - if (rows (y) == 1) - y = y'; + if (isrow (y)) + y = y.'; endif if (rows (y) != n) error ("cov: X and Y must have the same number of observations"); @@ -110,17 +116,36 @@ endfunction + %!test %! x = rand (10); %! cx1 = cov (x); %! cx2 = cov (x, x); -%! assert(size (cx1) == [10, 10] && size (cx2) == [10, 10] && norm(cx1-cx2) < 1e1*eps); +%! assert(size (cx1) == [10, 10] && size (cx2) == [10, 10]); +%! assert(cx1, cx2, 1e1*eps); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (cov (x,y), -1, 5*eps) +%! assert (cov (x,flipud (y)), 1, 5*eps) +%! assert (cov ([x, y]), [1 -1; -1 1], 5*eps) + +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (cov (x,y), single (-1), 5*eps) +%! assert (cov (x,flipud (y)), single (1), 5*eps) +%! assert (cov ([x, y]), single ([1 -1; -1 1]), 5*eps) %!test %! x = [1:5]; %! c = cov (x); -%! assert(isscalar (c)); -%! assert(c, 2.5); +%! assert (isscalar (c)); +%! assert (c, 2.5); + +%!assert(cov (5), 0); +%!assert(cov (single(5)), single(0)); %!test %! x = [1:5]; @@ -129,13 +154,10 @@ %! c = cov (x, 1); %! assert(c, 2); -%!assert(cov (5), 0); - %% Test input validation %!error cov (); %!error cov (1, 2, 3, 4); -%!error cov ([true, true]); -%!error cov ([1, 2], [true, true]); +%!error cov ([1; 2], ["A", "B"]); %!error cov (ones (2,2,2)); %!error cov (ones (2,2), ones (2,2,2)); %!error cov (1, 3);
--- a/scripts/statistics/base/gls.m +++ b/scripts/statistics/base/gls.m @@ -82,10 +82,21 @@ if (rx != ry) error ("gls: number of rows of X and Y must be equal"); endif - if (!issquare(o) || ro != ry*cy) + if (!issquare (o) || ro != ry*cy) error ("gls: matrix O must be square matrix with rows = rows (Y) * cols (Y)"); endif + if (isinteger (x)) + x = double (x); + endif + if (isinteger (y)) + y = double (y); + endif + if (isinteger (o)) + o = double (o); + endif + + ## Start of algorithm o = o^(-1/2); z = kron (eye (cy), x); z = o * z; @@ -116,7 +127,7 @@ %! y = 3*x + 2; %! x = [x, ones(5,1)]; %! o = diag (ones (5,1)); -%! assert (gls (y,x,o), [3; 2], 50*eps) +%! assert (gls (y,x,o), [3; 2], 50*eps); %% Test input validation %!error gls ()
--- a/scripts/statistics/base/histc.m +++ b/scripts/statistics/base/histc.m @@ -61,7 +61,7 @@ error ("histc: EDGES must be real-valued, not complex"); else ## Make sure 'edges' is sorted - edges = edges (:); + edges = edges(:); if (!issorted (edges) || edges(1) > edges(end)) warning ("histc: edge values not sorted on input"); edges = sort (edges); @@ -72,10 +72,7 @@ sz = size (x); if (nargin < 3) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -103,25 +100,25 @@ ## Prepare indices idx1 = cell (1, dim-1); for k = 1:length (idx1) - idx1 {k} = 1:sz(k); + idx1{k} = 1:sz(k); endfor idx2 = cell (length (sz) - dim); for k = 1:length (idx2) - idx2 {k} = 1:sz(k+dim); + idx2{k} = 1:sz(k+dim); endfor ## Compute the histograms for k = 1:num_edges-1 b = (edges (k) <= x & x < edges (k+1)); - n (idx1 {:}, k, idx2 {:}) = sum (b, dim); + n(idx1{:}, k, idx2{:}) = sum (b, dim); if (nargout > 1) - idx (b) = k; + idx(b) = k; endif endfor b = (x == edges (end)); - n (idx1 {:}, num_edges, idx2 {:}) = sum (b, dim); + n(idx1{:}, num_edges, idx2{:}) = sum (b, dim); if (nargout > 1) - idx (b) = num_edges; + idx(b) = num_edges; endif else @@ -160,6 +157,7 @@ endfunction + %!test %! x = linspace (0, 10, 1001); %! n = histc (x, 0:10);
--- a/scripts/statistics/base/iqr.m +++ b/scripts/statistics/base/iqr.m @@ -39,7 +39,7 @@ print_usage (); endif - if (!(ismatrix (x) && isnumeric (x)) || isscalar(x)) + if (! (isnumeric (x) || islogical (x))) error ("iqr: X must be a numeric vector or matrix"); endif @@ -48,10 +48,7 @@ nel = numel (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -60,27 +57,33 @@ endif ## This code is a bit heavy, but is needed until empirical_inv - ## takes other than vector arguments. - c = sz(dim); + ## can take a matrix, rather than just a vector argument. + n = sz(dim); sz(dim) = 1; - y = zeros (sz); + if (isa (x, 'single')) + y = zeros (sz, 'single'); + else + y = zeros (sz); + endif stride = prod (sz(1:dim-1)); - for i = 1 : nel / c; + for i = 1 : nel / n; offset = i; offset2 = 0; while (offset > stride) offset -= stride; offset2++; endwhile - offset += offset2 * stride * c; - rng = [0 : c-1] * stride + offset; + offset += offset2 * stride * n; + rng = [0 : n-1] * stride + offset; - y (i) = empirical_inv (3/4, x(rng)) - empirical_inv (1/4, x(rng)); + y(i) = diff (empirical_inv ([1/4, 3/4], x(rng))); endfor endfunction + %!assert (iqr (1:101), 50); +%!assert (iqr (single(1:101)), single(50)); %%!test %%! x = [1:100]; @@ -90,5 +93,6 @@ %!error iqr (); %!error iqr (1, 2, 3); %!error iqr (1); -%!error iqr ([true, true]); +%!error iqr (['A'; 'B']); %!error iqr (1:10, 3); +
--- a/scripts/statistics/base/kendall.m +++ b/scripts/statistics/base/kendall.m @@ -74,7 +74,8 @@ print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) error ("kendall: X and Y must be numeric matrices or vectors"); endif @@ -82,14 +83,14 @@ error ("kendall: X and Y must be 2-D matrices or vectors"); endif - if (rows (x) == 1) - x = x'; + if (isrow (x)) + x = x.'; endif [n, c] = size (x); if (nargin == 2) - if (rows (y) == 1) - y = y'; + if (isrow (y)) + y = y.'; endif if (rows (y) != n) error ("kendall: X and Y must have the same number of observations"); @@ -98,22 +99,36 @@ endif endif + if (isa (x, 'single') || isa (y, 'single')) + cls = 'single'; + else + cls = 'double'; + endif r = ranks (x); - m = sign (kron (r, ones (n, 1)) - kron (ones (n, 1), r)); - tau = corrcoef (m); + m = sign (kron (r, ones (n, 1, cls)) - kron (ones (n, 1, cls), r)); + tau = corr (m); if (nargin == 2) - tau = tau (1 : c, (c + 1) : columns (x)); + tau = tau(1 : c, (c + 1) : columns (x)); endif endfunction +%!test +%! x = [1:2:10]; +%! y = [100:10:149]; +%! assert (kendall (x,y), 1, 5*eps); +%! assert (kendall (x,fliplr (y)), -1, 5*eps); + +%!assert (kendall (logical(1)), 1); +%!assert (kendall (single(1)), single(1)); + %% Test input validation %!error kendall (); %!error kendall (1, 2, 3); -%!error kendall ([true, true]); -%!error kendall (ones(1,2), [true, true]); +%!error kendall (['A'; 'B']); +%!error kendall (ones(2,1), ['A'; 'B']); %!error kendall (ones (2,2,2)); %!error kendall (ones (2,2), ones (2,2,2)); %!error kendall (ones (2,2), ones (3,2));
--- a/scripts/statistics/base/kurtosis.m +++ b/scripts/statistics/base/kurtosis.m @@ -54,7 +54,7 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("kurtosis: X must be a numeric vector or matrix"); endif @@ -62,10 +62,7 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -73,16 +70,14 @@ endif endif - c = sz(dim); + n = sz(dim); sz(dim) = 1; - idx = ones (1, nd); - idx(dim) = c; - x = x - repmat (mean (x, dim), idx); + x = center (x, dim); # center also promotes integer to double for next line retval = zeros (sz, class (x)); s = std (x, [], dim); + idx = find (s > 0); x = sum (x.^4, dim); - ind = find (s > 0); - retval(ind) = x(ind) ./ (c * s(ind) .^ 4) - 3; + retval(idx) = x(idx) ./ (n * s(idx) .^ 4) - 3; endfunction @@ -90,12 +85,14 @@ %!test %! x = [-1; 0; 0; 0; 1]; %! y = [x, 2*x]; -%! assert(all (abs (kurtosis (y) - [-1.4, -1.4]) < sqrt (eps))); +%! assert (kurtosis (y), [-1.4, -1.4], sqrt (eps)); + +%!assert (kurtosis (single(1)), single(0)); %% Test input validation %!error kurtosis () %!error kurtosis (1, 2, 3) -%!error kurtosis (true(1,2)) +%!error kurtosis (['A'; 'B']) %!error kurtosis (1, ones(2,2)) %!error kurtosis (1, 1.5) %!error kurtosis (1, 0)
--- a/scripts/statistics/base/logit.m +++ b/scripts/statistics/base/logit.m @@ -47,6 +47,7 @@ endfunction + %!test %! p = [0.01:0.01:0.99]; %! assert(logit (p), log (p ./ (1-p)), 25*eps)
--- a/scripts/statistics/base/mahalanobis.m +++ b/scripts/statistics/base/mahalanobis.m @@ -34,7 +34,8 @@ print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) error ("mahalanobis: X and Y must be numeric matrices or vectors"); endif @@ -49,11 +50,16 @@ error ("mahalanobis: X and Y must have the same number of columns"); endif + if (isinteger (x)) + x = double (x); + endif + xm = mean (x); ym = mean (y); - x = x - ones (xr, 1) * xm; - y = y - ones (yr, 1) * ym; + ## Center data by subtracting means + x = bsxfun (@minus, x, xm); + y = bsxfun (@minus, y, ym); w = (x' * x + y' * y) / (xr + yr - 2); @@ -63,11 +69,12 @@ endfunction + %% Test input validation %!error mahalanobis (); %!error mahalanobis (1, 2, 3); -%!error mahalanobis ([true], [true]); -%!error mahalanobis ([1, 2], [true, true]); +%!error mahalanobis ('A', 'B'); +%!error mahalanobis ([1, 2], ['A', 'B']); %!error mahalanobis (ones (2,2,2)); %!error mahalanobis (ones (2,2), ones (2,2,2)); %!error mahalanobis (ones (2,2), ones (2,3));
--- a/scripts/statistics/base/mean.m +++ b/scripts/statistics/base/mean.m @@ -69,15 +69,15 @@ error ("mean: X must be a numeric vector or matrix"); endif - need_dim = 0; + need_dim = false; if (nargin == 1) opt = "a"; - need_dim = 1; + need_dim = true; elseif (nargin == 2) if (ischar (opt1)) opt = opt1; - need_dim = 1; + need_dim = true; else dim = opt1; opt = "a"; @@ -100,22 +100,15 @@ sz = size (x); if (need_dim) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("mean: DIM must be an integer and a valid dimension"); endif endif - if (!(isscalar (dim) && dim == fix (dim)) - || !(1 <= dim && dim <= nd)) - error ("mean: DIM must be an integer and a valid dimension"); - endif - - if (dim > nd) - n = 1; - else - n = sz(dim); - endif + n = sz(dim); if (strcmp (opt, "a")) y = sum (x, dim) / n; @@ -129,6 +122,7 @@ endfunction + %!test %! x = -10:10; %! y = x'; @@ -137,9 +131,12 @@ %! assert(mean (y) == 0); %! assert(mean (z) == [0, 10]); +%!assert(mean (magic(3), 1), [5, 5, 5]); +%!assert(mean (magic(3), 2), [5; 5; 5]); %!assert(mean ([2 8], 'g'), 4); %!assert(mean ([4 4 2], 'h'), 3); %!assert(mean (logical ([1 0 1 1])), 0.75); +%!assert(mean (single ([1 0 1 1])), single (0.75)); %% Test input validation %!error mean ();
--- a/scripts/statistics/base/meansq.m +++ b/scripts/statistics/base/meansq.m @@ -52,7 +52,7 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("mean: X must be a numeric vector or matrix"); endif @@ -60,29 +60,28 @@ sz = size (x); if (nargin < 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("mean: DIM must be an integer and a valid dimension"); endif endif - if (!(isscalar (dim) && dim == fix (dim)) - || !(1 <= dim && dim <= nd)) - error ("mean: DIM must be an integer and a valid dimension"); - endif - - y = sumsq (x, dim) / size (x, dim); + y = sumsq (x, dim) / sz(dim); endfunction -%!assert(meansq (1:5), 11) -%!assert(meansq (magic (4)), [94.5, 92.5, 92.5, 94.5]) +%!assert(meansq (1:5), 11); +%!assert(meansq (single(1:5)), single(11)); +%!assert(meansq (magic (4)), [94.5, 92.5, 92.5, 94.5]); +%!assert(meansq (magic (4), 2), [109.5; 77.5; 77.5; 109.5]); %% Test input validation %!error meansq () %!error meansq (1, 2, 3) -%!error kurtosis ([true true]) +%!error meansq (['A'; 'B']); %!error meansq (1, ones(2,2)) %!error meansq (1, 1.5) %!error meansq (1, 0)
--- a/scripts/statistics/base/median.m +++ b/scripts/statistics/base/median.m @@ -55,18 +55,19 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("median: X must be a numeric vector or matrix"); endif + if (isempty (x)) + error ("median: X cannot be an empty matrix"); + endif + nd = ndims (x); sz = size (x); - if (nargin != 2) + if (nargin < 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -74,22 +75,19 @@ endif endif - if (numel (x) > 0) - n = size (x, dim); - k = floor ((n+1) / 2); - if (mod (n, 2) == 1) - retval = nth_element (x, k, dim); - else - retval = mean (nth_element (x, k:k+1, dim), dim); - endif - ## Inject NaNs where needed, to be consistent with Matlab. - retval(any (isnan (x), dim)) = NaN; + n = sz(dim); + k = floor ((n+1) / 2); + if (mod (n, 2) == 1) + retval = nth_element (x, k, dim); else - error ("median: invalid matrix argument"); + retval = mean (nth_element (x, k:k+1, dim), dim); endif + ## Inject NaNs where needed, to be consistent with Matlab. + retval(any (isnan (x), dim)) = NaN; endfunction + %!test %! x = [1, 2, 3, 4, 5, 6]; %! x2 = x'; @@ -101,13 +99,14 @@ %! assert(median ([x2, 2*x2]) == [3.5, 7]); %! assert(median ([y2, 3*y2]) == [4, 12]); +%!assert(median (single([1,2,3])), single(2)); %!assert(median ([1,2,NaN;4,5,6;NaN,8,9]), [NaN, 5, NaN]); %% Test input validation %!error median (); %!error median (1, 2, 3); %!error median ({1:5}); -%!error median (true(1,5)); +%!error median (['A'; 'B']); %!error median (1, ones(2,2)); %!error median (1, 1.5); %!error median (1, 0);
--- a/scripts/statistics/base/mode.m +++ b/scripts/statistics/base/mode.m @@ -39,20 +39,17 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("mode: X must be a numeric vector or matrix"); endif nd = ndims (x); sz = size (x); - if (nargin != 2) + if (nargin < 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else - if (!(isscalar (dim) && dim == round (dim)) + if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) error ("mode: DIM must be an integer and a valid dimension"); endif @@ -78,11 +75,11 @@ t = cat (dim, true (sz2), diff (xs, 1, dim) != 0); if (dim != 1) - t2 (permute (t != 0, perm)) = diff ([find(permute (t, perm))(:); prod(sz)+1]); + t2(permute (t != 0, perm)) = diff ([find(permute (t, perm))(:); prod(sz)+1]); f = max (ipermute (t2, perm), [], dim); xs = permute (xs, perm); else - t2 (t) = diff ([find(t)(:); prod(sz)+1]); + t2(t) = diff ([find(t)(:); prod(sz)+1]); f = max (t2, [], dim); endif @@ -90,14 +87,15 @@ if (issparse (x)) m = sparse (sz2(1), sz2(2)); else - m = zeros (sz2); + m = zeros (sz2, class (x)); endif for i = 1 : prod (sz2) - c{i} = xs (t2 (:, i) == f(i), i); - m (i) = c{i}(1); + c{i} = xs(t2(:, i) == f(i), i); + m(i) = c{i}(1); endfor endfunction + %!test %! [m, f, c] = mode (toeplitz (1:5)); %! assert (m, [1,2,2,2,1]); @@ -114,15 +112,19 @@ %! [m2, f2, c2] = mode (full (a)); %! assert (m, sparse (m2)); %! assert (f, sparse (f2)); -%! assert (c, cellfun (@(x) sparse (0), c2, 'uniformoutput', false)); +%! c_exp(1:length(a)) = { sparse (0) }; +%! assert (c ,c_exp); +%! assert (c2,c_exp ); -%!assert(mode([2,3,1,2,3,4],1),[2,3,1,2,3,4]) -%!assert(mode([2,3,1,2,3,4],2),2) -%!assert(mode([2,3,1,2,3,4]),2) +%!assert(mode ([2,3,1,2,3,4],1),[2,3,1,2,3,4]); +%!assert(mode ([2,3,1,2,3,4],2),2); +%!assert(mode ([2,3,1,2,3,4]),2); +%!assert(mode (single([2,3,1,2,3,4])), single(2)); +%!assert(mode (int8([2,3,1,2,3,4])), int8(2)); -%!assert(mode([2;3;1;2;3;4],1),2) -%!assert(mode([2;3;1;2;3;4],2),[2;3;1;2;3;4]) -%!assert(mode([2;3;1;2;3;4]),2) +%!assert(mode ([2;3;1;2;3;4],1),2); +%!assert(mode ([2;3;1;2;3;4],2),[2;3;1;2;3;4]); +%!assert(mode ([2;3;1;2;3;4]),2); %!shared x %! x(:,:,1) = toeplitz (1:3); @@ -157,7 +159,7 @@ %!error mode () %!error mode (1, 2, 3) %!error mode ({1 2 3}) -%!error mode (true(1,3)) +%!error mode (['A'; 'B']) %!error mode (1, ones(2,2)) %!error mode (1, 1.5) %!error mode (1, 0)
--- a/scripts/statistics/base/module.mk +++ b/scripts/statistics/base/module.mk @@ -3,10 +3,8 @@ statistics_base_FCN_FILES = \ statistics/base/center.m \ statistics/base/cloglog.m \ - statistics/base/cor.m \ - statistics/base/corrcoef.m \ + statistics/base/corr.m \ statistics/base/cov.m \ - statistics/base/cut.m \ statistics/base/gls.m \ statistics/base/histc.m \ statistics/base/iqr.m \ @@ -33,9 +31,9 @@ statistics/base/spearman.m \ statistics/base/statistics.m \ statistics/base/std.m \ - statistics/base/studentize.m \ statistics/base/table.m \ - statistics/base/var.m + statistics/base/var.m \ + statistics/base/zscore.m FCN_FILES += $(statistics_base_FCN_FILES)
--- a/scripts/statistics/base/moment.m +++ b/scripts/statistics/base/moment.m @@ -110,27 +110,27 @@ function m = moment (x, p, opt1, opt2) - if ((nargin < 2) || (nargin > 4)) + if (nargin < 2 || nargin > 4) print_usage (); endif - if (!isnumeric(x) || isempty(x) ) + if (!(isnumeric (x) || islogical (x)) || isempty (x)) error ("moment: X must be a non-empty numeric matrix or vector"); endif - if (!(isnumeric(p) && isscalar(p))) + if (! (isnumeric (p) && isscalar (p))) error ("moment: P must be a numeric scalar"); endif - need_dim = 0; + need_dim = false; if (nargin == 2) type = ""; - need_dim = 1; + need_dim = true; elseif (nargin == 3) if (ischar (opt1)) type = opt1; - need_dim = 1; + need_dim = true; else dim = opt1; type = ""; @@ -151,10 +151,7 @@ sz = size (x); if (need_dim) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -164,10 +161,8 @@ n = sz(dim); - if any (type == "c") - rng = ones (1, length (sz)); - rng(dim) = sz(dim); - x = x - repmat (sum (x, dim), rng) / n; + if (any (type == "c")) + x = center (x, dim); endif if any (type == "a") x = abs (x); @@ -178,11 +173,21 @@ endfunction +%!test +%! x = rand (10); +%! assert (moment (x,1), mean (x), 1e1*eps); +%! assert (moment (x,2), meansq (x), 1e1*eps); +%! assert (moment (x,1,2), mean (x,2), 1e1*eps); +%! assert (moment (x,1,'c'), mean (center (x)), 1e1*eps); +%! assert (moment (x,1,'a'), mean (abs (x)), 1e1*eps); + +%!assert (moment (single([1 2 3]),1), single(2)); + %% Test input validation %!error moment () %!error moment (1) %!error moment (1, 2, 3, 4, 5) -%!error moment ([true true], 2) +%!error moment (['A'; 'B'], 2) %!error moment (ones(2,0,3), 2) %!error moment (1, true) %!error moment (1, ones(2,2))
--- a/scripts/statistics/base/ols.m +++ b/scripts/statistics/base/ols.m @@ -100,13 +100,21 @@ error ("ols: number of rows of X and Y must be equal"); endif - z = x' * x; - rnk = rank (z); + if (isinteger (x)) + x = double (x); + endif + if (isinteger (y)) + y = double (y); + endif - if (rnk == nc) - beta = inv (z) * x' * y; + ## Start of algorithm + z = x' * x; + [u, p] = chol (z); + + if (p) + beta = pinv (x) * y; else - beta = pinv (x) * y; + beta = u \ (u' \ (x' * y)); endif if (isargout (2) || isargout (3)) @@ -118,6 +126,7 @@ endfunction + %!test %! x = [1:5]'; %! y = 3*x + 2;
--- a/scripts/statistics/base/ppplot.m +++ b/scripts/statistics/base/ppplot.m @@ -77,6 +77,7 @@ endfunction + %% Test input validation %!error ppplot (); %!error ppplot (ones(2,2));
--- a/scripts/statistics/base/prctile.m +++ b/scripts/statistics/base/prctile.m @@ -40,52 +40,48 @@ ## Author: Ben Abbott <bpabbott@mac.com> ## Description: Matlab style prctile function. -function q = prctile (x, p, dim) +function q = prctile (x, p = [], dim) if (nargin < 1 || nargin > 3) print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("prctile: X must be a numeric vector or matrix"); endif - if (!isnumeric(p)) - error ("prctile: P must be a numeric vector"); + + if (isempty (p)) + p = [0, 25, 50, 75, 100]; endif - if (nargin == 1) - p = [0, 25, 50, 75, 100]; + if (! (isnumeric (p) && isvector (p))) + error ("prctile: P must be a numeric vector"); endif nd = ndims (x); if (nargin == 2) if (nd == 2) - ## If a matrix or vector, use the 1st dimension. + ## If a matrix or vector, always use 1st dimension. dim = 1; else ## If an N-d array, find the first non-singleton dimension. - dim = find (size(v) > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); endif else - if (!(isscalar (dim) && dim == fix (dim)) || - !(1 <= dim && dim <= nd)) + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) error ("prctile: DIM must be an integer and a valid dimension"); endif endif ## Convert from percent to decimal. - p = p / 100; + p /= 100; - ## The 5th method is compatible with Matlab. - method = 5; - - q = quantile (x, p, dim, method); + q = quantile (x, p, dim); endfunction + %!test %! pct = 50; %! q = prctile (1:4, pct, 1); @@ -171,8 +167,9 @@ %% Test input validation %!error prctile () %!error prctile (1, 2, 3, 4) -%!error prctile ([true, false], 10) +%!error prctile (['A'; 'B'], 10) %!error prctile (1:10, [true, false]) +%!error prctile (1:10, ones (2,2)) %!error prctile (1, 1, 1.5) %!error prctile (1, 1, 0) %!error prctile (1, 1, 3)
--- a/scripts/statistics/base/probit.m +++ b/scripts/statistics/base/probit.m @@ -27,10 +27,18 @@ function y = probit (p) - if (nargin == 1) - y = stdnormal_inv (p); - else + + if (nargin != 1) print_usage (); endif + y = stdnormal_inv (p); + endfunction + +%!assert(probit([-1, 0, 0.5, 1, 2]), [NaN, -Inf, 0, Inf, NaN]); + +%% Test input validation +%!error probit () +%!error probit (1, 2) +
--- a/scripts/statistics/base/quantile.m +++ b/scripts/statistics/base/quantile.m @@ -90,31 +90,40 @@ ## ## Examples: ## -## @example +## @c Set example in small font to prevent overfull line +## @smallexample ## @group -## x = randi (1000, [10, 1]); # Create random empirical data in range 1-1000 -## q = quantile (x, [0, 1]); # Return minimum, maximum of empirical distribution -## q = quantile (x, [0.25 0.5 0.75]); # Return quartiles of empirical distribution +## x = randi (1000, [10, 1]); # Create empirical data in range 1-1000 +## q = quantile (x, [0, 1]); # Return minimum, maximum of distribution +## q = quantile (x, [0.25 0.5 0.75]); # Return quartiles of distribution ## @end group -## @end example +## @end smallexample ## @seealso{prctile} ## @end deftypefn ## Author: Ben Abbott <bpabbott@mac.com> ## Description: Matlab style quantile function of a discrete/continuous distribution -function q = quantile (x, p, dim = 1, method = 5) +function q = quantile (x, p = [], dim = 1, method = 5) if (nargin < 1 || nargin > 4) print_usage (); endif - if (nargin < 2) + if (! (isnumeric (x) || islogical (x))) + error ("quantile: X must be a numeric vector or matrix"); + endif + + if (isempty (p)) p = [0.00 0.25, 0.50, 0.75, 1.00]; endif - if (!(isscalar (dim) && dim == fix (dim)) || - !(1 <= dim && dim <= ndims (x))) + if (! (isnumeric (p) && isvector (p))) + error ("quantile: P must be a numeric vector"); + endif + + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= ndims (x))) error ("quantile: DIM must be an integer and a valid dimension"); endif @@ -143,6 +152,7 @@ endfunction + %!test %! p = 0.5; %! x = sort (rand (11)); @@ -282,9 +292,14 @@ %% Test input validation %!error quantile () %!error quantile (1, 2, 3, 4, 5) +%!error quantile (['A'; 'B'], 10) +%!error quantile (1:10, [true, false]) +%!error quantile (1:10, ones (2,2)) %!error quantile (1, 1, 1.5) %!error quantile (1, 1, 0) %!error quantile (1, 1, 3) +%!error quantile ((1:5)', 0.5, 1, 0) +%!error quantile ((1:5)', 0.5, 1, 10) ## For the cumulative probability values in @var{p}, compute the ## quantiles, @var{q} (the inverse of the cdf), for the sample, @var{x}. @@ -304,37 +319,35 @@ print_usage (); endif - if (!isnumeric (x)) - error ("quantile: X must be a numeric vector or matrix"); + if (isinteger (x) || islogical (x)) + x = double (x); endif - ## Save length and set shape of quantiles. - n = numel (p); + ## set shape of quantiles to column vector. p = p(:); ## Save length and set shape of samples. ## FIXME: does sort guarantee that NaN's come at the end? x = sort (x); m = sum (! isnan (x)); - mx = size (x, 1); - nx = size (x, 2); + [xr, xc] = size (x); ## Initialize output values. - inv = Inf*(-(p < 0) + (p > 1)); - inv = repmat (inv, 1, nx); + inv = Inf (class (x)) * (-(p < 0) + (p > 1)); + inv = repmat (inv, 1, xc); ## Do the work. - if (any(k = find((p >= 0) & (p <= 1)))) + if (any (k = find ((p >= 0) & (p <= 1)))) n = length (k); - p = p (k); - ## Special case. - if (mx == 1) + p = p(k); + ## Special case of 1 row. + if (xr == 1) inv(k,:) = repmat (x, n, 1); - return + return; endif ## The column-distribution indices. - pcd = kron (ones (n, 1), mx*(0:nx-1)); + pcd = kron (ones (n, 1), xr*(0:xc-1)); mm = kron (ones (n, 1), m); switch (method) case {1, 2, 3} @@ -375,7 +388,7 @@ p = kron (p, m-1) + 1; case 8 - ## Median unbiased . + ## Median unbiased. p = kron (p, m+1/3) + 1/3; case 9 @@ -387,7 +400,7 @@ endswitch ## Duplicate single values. - imm1 = mm == 1; + imm1 = (mm == 1); x(2,imm1) = x(1,imm1); ## Interval indices.
--- a/scripts/statistics/base/range.m +++ b/scripts/statistics/base/range.m @@ -37,20 +37,24 @@ function y = range (x, dim) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + if (nargin == 1) y = max (x) - min (x); - elseif (nargin == 2) + else y = max (x, [], dim) - min (x, [], dim); - else - print_usage (); endif endfunction -%!assert(range (1:10), 9) -%!assert(range (magic (3)), [5, 8, 5]) -%!assert(range (magic (3), 2), [7; 4; 7]) -%!assert(range (2), 0) + +%!assert(range (1:10), 9); +%!assert(range (single(1:10)), single(9)); +%!assert(range (magic (3)), [5, 8, 5]); +%!assert(range (magic (3), 2), [7; 4; 7]); +%!assert(range (2), 0); %% Test input validation %!error range ()
--- a/scripts/statistics/base/ranks.m +++ b/scripts/statistics/base/ranks.m @@ -37,7 +37,7 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("ranks: X must be a numeric vector or matrix"); endif @@ -45,10 +45,7 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -89,18 +86,18 @@ endfunction -%!assert(ranks (1:2:10), 1:5) -%!assert(ranks (10:-2:1), 5:-1:1) -%!assert(ranks ([2, 1, 2, 4]), [2.5, 1, 2.5, 4]) -%!assert(ranks (ones(1, 5)), 3*ones(1, 5)) -%!assert(ranks (1e6*ones(1, 5)), 3*ones(1, 5)) -%!assert(ranks (rand (1, 5), 1), ones(1, 5)) +%!assert(ranks (1:2:10), 1:5); +%!assert(ranks (10:-2:1), 5:-1:1); +%!assert(ranks ([2, 1, 2, 4]), [2.5, 1, 2.5, 4]); +%!assert(ranks (ones(1, 5)), 3*ones(1, 5)); +%!assert(ranks (1e6*ones(1, 5)), 3*ones(1, 5)); +%!assert(ranks (rand (1, 5), 1), ones(1, 5)); %% Test input validation %!error ranks () %!error ranks (1, 2, 3) %!error ranks ({1, 2}) -%!error ranks (true(2,1)) +%!error ranks (['A'; 'B']) %!error ranks (1, 1.5) %!error ranks (1, 0) %!error ranks (1, 3)
--- a/scripts/statistics/base/run_count.m +++ b/scripts/statistics/base/run_count.m @@ -36,7 +36,7 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("run_count: X must be a numeric vector or matrix"); endif @@ -48,10 +48,7 @@ sz = size (x); if (nargin != 3) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) @@ -59,6 +56,7 @@ endif endif + ## Algorithm works on rows. Permute array if necessary, ipermute back at end if (dim != 1) perm = [1 : nd]; perm(1) = dim; @@ -76,7 +74,7 @@ infvec = Inf ([1, sz(2 : end)]); ind = find (diff ([infvec; x; -infvec]) < 0); - tmp(ind(2:end) - 1) = diff(ind); + tmp(ind(2:end) - 1) = diff (ind); tmp = tmp(idx{:}); sz(1) = n; @@ -86,7 +84,7 @@ retval(idx{:}) = sum (tmp == k); endfor idx{1} = n; - retval (idx{:}) = sum (tmp >= n); + retval(idx{:}) = sum (tmp >= n); if (dim != 1) retval = ipermute (retval, perm); @@ -105,7 +103,7 @@ %!error run_count (1) %!error run_count (1, 2, 3, 4) %!error run_count ({1, 2}, 3) -%!error run_count (true(3), 3) +%!error run_count (['A'; 'A'; 'B'], 3) %!error run_count (1:5, ones(2,2)) %!error run_count (1:5, 1.5) %!error run_count (1:5, -2)
--- a/scripts/statistics/base/runlength.m +++ b/scripts/statistics/base/runlength.m @@ -30,11 +30,12 @@ ## @end deftypefn function [count, value] = runlength (x) + if (nargin != 1) print_usage (); endif - if (!isnumeric (x) || !isvector (x)) + if (!(isnumeric (x) || islogical (x)) || !isvector (x)) error ("runlength: X must be a numeric vector"); endif @@ -47,8 +48,10 @@ if (nargout == 2) value = x(idx); endif + endfunction + %!assert (runlength([2 2 0 4 4 4 0 1 1 1 1]), [2 1 3 1 4]); %!assert (runlength([2 2 0 4 4 4 0 1 1 1 1]'), [2 1 3 1 4]); %!test @@ -59,5 +62,5 @@ %% Test input validation %!error runlength () %!error runlength (1, 2) -%!error runlength (true(1,2)) +%!error runlength (['A'; 'B']) %!error runlength (ones(2,2))
--- a/scripts/statistics/base/skewness.m +++ b/scripts/statistics/base/skewness.m @@ -51,7 +51,7 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("skewness: X must be a numeric vector or matrix"); endif @@ -59,30 +59,26 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else - if (!(isscalar (dim) && dim == round (dim)) + if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) error ("skewness: DIM must be an integer and a valid dimension"); endif endif - c = sz(dim); - idx = ones (1, nd); - idx(dim) = c; - x = x - repmat (mean (x, dim), idx); + n = sz(dim); sz(dim) = 1; + x = center (x, dim); # center also promotes integer to double for next line retval = zeros (sz, class (x)); s = std (x, [], dim); - ind = find (s > 0); + idx = find (s > 0); x = sum (x .^ 3, dim); - retval(ind) = x(ind) ./ (c * s(ind) .^ 3); + retval(idx) = x(idx) ./ (n * s(idx) .^ 3); endfunction + %!assert(skewness ([-1,0,1]), 0); %!assert(skewness ([-2,0,1]) < 0); %!assert(skewness ([-1,0,2]) > 0); @@ -92,10 +88,12 @@ %! y = [x, 2*x]; %! assert(all (abs (skewness (y) - [0.75, 0.75]) < sqrt (eps))); +%!assert (skewness (single(1)), single(0)); + %% Test input validation %!error skewness () %!error skewness (1, 2, 3) -%!error skewness ([true true]) +%!error skewness (['A'; 'B']) %!error skewness (1, ones(2,2)) %!error skewness (1, 1.5) %!error skewness (1, 0)
--- a/scripts/statistics/base/spearman.m +++ b/scripts/statistics/base/spearman.m @@ -39,11 +39,12 @@ function rho = spearman (x, y = []) - if ((nargin < 1) || (nargin > 2)) + if (nargin < 1 || nargin > 2) print_usage (); endif - if (! (isnumeric (x) && isnumeric (y))) + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) error ("spearman: X and Y must be numeric matrices or vectors"); endif @@ -51,30 +52,43 @@ error ("spearman: X and Y must be 2-D matrices or vectors"); endif - if (rows (x) == 1) - x = x'; + if (isrow (x)) + x = x.'; endif - n = rows (x); if (nargin == 1) - rho = corrcoef (ranks (x)); + rho = corr (ranks (x)); else - if (rows (y) == 1) - y = y'; + if (isrow (y)) + y = y.'; endif - if (rows (y) != n) + if (rows (x) != rows (y)) error ("spearman: X and Y must have the same number of observations"); endif - rho = corrcoef (ranks (x), ranks (y)); + rho = corr (ranks (x), ranks (y)); + endif + + ## Restore class cleared by ranks + if (isa (x, 'single') || isa (y, 'single')) + rho = single (rho); endif endfunction + +%!test +%! x = 1:10; +%! y = exp (x); +%! assert (spearman (x,y), 1, 5*eps); +%! assert (spearman (x,-y), -1, 5*eps); + +%!assert(spearman ([1 2 3], [-1 1 -2]), -0.5, 5*eps) + %% Test input validation %!error spearman (); %!error spearman (1, 2, 3); -%!error spearman ([true, true]); -%!error spearman (ones(1,2), [true, true]); +%!error spearman (['A'; 'B']); +%!error spearman (ones(1,2), {1, 2}); %!error spearman (ones (2,2,2)); %!error spearman (ones (2,2), ones (2,2,2)); %!error spearman (ones (2,2), ones (3,2));
--- a/scripts/statistics/base/statistics.m +++ b/scripts/statistics/base/statistics.m @@ -38,7 +38,7 @@ print_usage (); endif - if (!isnumeric(x)) + if (! (isnumeric (x) || islogical (x))) error ("statistics: X must be a numeric vector or matrix"); endif @@ -46,12 +46,9 @@ sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else - if (!(isscalar (dim) && dim == round (dim)) + if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) error ("statistics: DIM must be an integer and a valid dimension"); endif @@ -68,16 +65,22 @@ endfunction + %!test -%! x = rand(7,5); +%! x = rand (7,5); %! s = statistics (x); -%! m = median (x); -%! assert (m, s(3,:), eps); +%! assert (min (x), s(1,:), eps); +%! assert (median (x), s(3,:), eps); +%! assert (max (x), s(5,:), eps); +%! assert (mean (x), s(6,:), eps); +%! assert (std (x), s(7,:), eps); +%! assert (skewness (x), s(8,:), eps); +%! assert (kurtosis (x), s(9,:), eps); %% Test input validation %!error statistics () %!error statistics (1, 2, 3) -%!error statistics ([true true]) +%!error statistics (['A'; 'B']) %!error statistics (1, ones(2,2)) %!error statistics (1, 1.5) %!error statistics (1, 0)
--- a/scripts/statistics/base/std.m +++ b/scripts/statistics/base/std.m @@ -67,7 +67,7 @@ print_usage (); endif - if (! (isnumeric (x))) + if (! (isnumeric (x) || islogical (x))) error ("std: X must be a numeric vector or matrix"); endif @@ -78,22 +78,27 @@ error ("std: normalization OPT must be 0 or 1"); endif + nd = ndims (x); sz = size (x); if (nargin < 3) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("std: DIM must be an integer and a valid dimension"); endif endif - n = size (x, dim); - if (n == 1) - retval = zeros (sz); - elseif (numel (x) > 0) + n = sz(dim); + if (n == 1 || isempty (x)) + if (isa (x, 'single')) + retval = zeros (sz, 'single'); + else + retval = zeros (sz); + endif + else retval = sqrt (sumsq (center (x, dim), dim) / (n - 1 + opt)); - else - error ("std: X must not be empty"); endif endfunction @@ -102,14 +107,21 @@ %!test %! x = ones (10, 2); %! y = [1, 3]; -%! assert(std (x) == [0, 0] && abs (std (y) - sqrt (2)) < sqrt (eps)); -%! assert (std (x, 0, 3), zeros (10, 2)) -%! assert (std (ones (3, 1, 2), 0, 2), zeros (3, 1, 2)) +%! assert(std (x) == [0, 0]); +%! assert(std (y), sqrt (2), sqrt (eps)); +%! assert(std (x, 0, 2), zeros (10, 1)); + +%!assert(std (ones (3, 1, 2), 0, 2), zeros (3, 1, 2)); +%!assert(std ([1 2], 0), sqrt(2)/2, 5*eps); +%!assert(std ([1 2], 1), 0.5, 5*eps); +%!assert(std(1), 0); +%!assert(std(single(1)), single(0)); +%!assert(std([]), []); +%!assert(std(ones (1,3,0,2)), ones (1,3,0,2)); %% Test input validation %!error std (); %!error std (1, 2, 3, 4); -%!error std (true(1,2)) +%!error std (['A'; 'B']) %!error std (1, -1); -%!error std ([], 1);
--- a/scripts/statistics/base/table.m +++ b/scripts/statistics/base/table.m @@ -60,6 +60,7 @@ endfunction + %% Test input validation %!error table () %!error table (1, 2, 3)
--- a/scripts/statistics/base/var.m +++ b/scripts/statistics/base/var.m @@ -64,7 +64,7 @@ print_usage (); endif - if (!isnumeric (x)) + if (! (isnumeric (x) || islogical (x))) error ("var: X must be a numeric vector or matrix"); endif @@ -75,16 +75,25 @@ error ("var: normalization OPT must be 0 or 1"); endif + nd = ndims (x); + sz = size (x); if (nargin < 3) - dim = find (size (x) > 1, 1); - if (isempty (dim)) - dim = 1; + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("var: DIM must be an integer and a valid dimension"); endif endif - n = size (x, dim); + n = sz(dim); if (n == 1) - retval = zeros (size (x), class (x)); + if (isa (x, 'single')) + retval = zeros (sz, 'single'); + else + retval = zeros (sz); + endif elseif (numel (x) > 0) retval = sumsq (center (x, dim), dim) / (n - 1 + opt); else @@ -93,15 +102,17 @@ endfunction -%!assert (var (13), 0) -%!assert (var ([1,2,3]), 1) -%!assert (var ([1,2,3], 1), 2/3, eps) -%!assert (var ([1,2,3], [], 1), [0,0,0]) + +%!assert(var (13), 0); +%!assert(var (single(13)), single(0)); +%!assert(var ([1,2,3]), 1); +%!assert(var ([1,2,3], 1), 2/3, eps); +%!assert(var ([1,2,3], [], 1), [0,0,0]); %% Test input validation %!error var () %!error var (1,2,3,4) -%!error var (true(1,2)) +%!error var (['A'; 'B']) %!error var (1, -1); %!error var ([],1)
copy from scripts/statistics/base/studentize.m copy to scripts/statistics/base/zscore.m --- a/scripts/statistics/base/studentize.m +++ b/scripts/statistics/base/zscore.m @@ -17,8 +17,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} studentize (@var{x}) -## @deftypefnx {Function File} {} studentize (@var{x}, @var{dim}) +## @deftypefn {Function File} {} zscore (@var{x}) +## @deftypefnx {Function File} {} zscore (@var{x}, @var{dim}) ## If @var{x} is a vector, subtract its mean and divide by its standard ## deviation. ## @@ -31,58 +31,54 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Subtract mean and divide by standard deviation -function t = studentize (x, dim) +function z = zscore (x, dim) if (nargin != 1 && nargin != 2) print_usage (); endif - if (! isnumeric(x)) - error ("studentize: X must be a numeric vector or matrix"); - endif - - if (isinteger (x)) - x = double (x); + if (! (isnumeric (x) || islogical (x))) + error ("zscore: X must be a numeric vector or matrix"); endif nd = ndims (x); sz = size (x); if (nargin != 2) ## Find the first non-singleton dimension. - dim = find (sz > 1, 1); - if (isempty (dim)) - dim = 1; - endif + (dim = find (sz > 1, 1)) || (dim = 1); else if (!(isscalar (dim) && dim == fix (dim)) || !(1 <= dim && dim <= nd)) - error ("studentize: DIM must be an integer and a valid dimension"); + error ("zscore: DIM must be an integer and a valid dimension"); endif endif - c = sz(dim); - if (c == 0) - t = x; + n = sz(dim); + if (n == 0) + z = x; else - idx = ones (1, nd); - idx(dim) = c; - t = x - repmat (mean (x, dim), idx); - t = t ./ repmat (max (cat (dim, std(t, [], dim), ! any (t, dim)), [], dim), idx); + x = center (x, dim); # center also promotes integer to double for next line + z = zeros (sz, class (x)); + s = std (x, [], dim); + s(s==0) = 1; + z = bsxfun (@rdivide, x, s); endif endfunction -%!assert(studentize ([1,2,3]), [-1,0,1]) -%!assert(studentize (int8 ([1,2,3])), [-1,0,1]) -#%!assert(studentize (ones (3,2,0,2)), zeros (3,2,0,2)) -%!assert(studentize ([2,0,-2;0,2,0;-2,-2,2]), [1,0,-1;0,1,0;-1,-1,1]) + +%!assert(zscore ([1,2,3]), [-1,0,1]) +%!assert(zscore (single([1,2,3])), single([-1,0,1])) +%!assert(zscore (int8([1,2,3])), [-1,0,1]) +%!assert(zscore (ones (3,2,2,2)), zeros (3,2,2,2)) +%!assert(zscore ([2,0,-2;0,2,0;-2,-2,2]), [1,0,-1;0,1,0;-1,-1,1]) %% Test input validation -%!error studentize () -%!error studentize (1, 2, 3) -%!error studentize ([true true]) -%!error studentize (1, ones(2,2)) -%!error studentize (1, 1.5) -%!error studentize (1, 0) -%!error studentize (1, 3) +%!error zscore () +%!error zscore (1, 2, 3) +%!error zscore (['A'; 'B']) +%!error zscore (1, ones(2,2)) +%!error zscore (1, 1.5) +%!error zscore (1, 0) +%!error zscore (1, 3)
--- a/scripts/statistics/distributions/betacdf.m +++ b/scripts/statistics/distributions/betacdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,9 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} betacdf (@var{x}, @var{a}, @var{b}) -## For each element of @var{x}, returns the CDF at @var{x} of the beta -## distribution with parameters @var{a} and @var{b}, i.e., -## PROB (beta (@var{a}, @var{b}) @leq{} @var{x}). +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the Beta distribution with parameters @var{a} and +## @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -32,33 +33,61 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("betacdf: X, A and B must be of common size or scalar"); + error ("betacdf: X, A, and B must be of common size or scalars"); endif endif - sz = size(x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betacdf: X, A, and B must not be complex"); + endif - k = find (!(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - cdf (k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x >= 1) & (a > 0) & (b > 0)); - if (any (k)) - cdf (k) = 1; - endif + k = isnan (x) | !(a > 0) | !(b > 0); + cdf(k) = NaN; + + k = (x >= 1) & (a > 0) & (b > 0); + cdf(k) = 1; - k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - cdf (k) = betainc (x(k), a, b); - else - cdf (k) = betainc (x(k), a(k), b(k)); - endif + k = (x > 0) & (x < 1) & (a > 0) & (b > 0); + if (isscalar (a) && isscalar (b)) + cdf(k) = betainc (x(k), a, b); + else + cdf(k) = betainc (x(k), a(k), b(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 0 0.75 1 1]; +%!assert(betacdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(betacdf (x, 1, 2*ones(1,5)), y); +%!assert(betacdf (x, ones(1,5), 2), y); +%!assert(betacdf (x, [0 1 NaN 1 1], 2), [NaN 0 NaN 1 1]); +%!assert(betacdf (x, 1, 2*[0 1 NaN 1 1]), [NaN 0 NaN 1 1]); +%!assert(betacdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(betacdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(betacdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(betacdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(betacdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error betacdf () +%!error betacdf (1) +%!error betacdf (1,2) +%!error betacdf (1,2,3,4) +%!error betacdf (ones(3),ones(2),ones(2)) +%!error betacdf (ones(2),ones(3),ones(2)) +%!error betacdf (ones(2),ones(2),ones(3)) +
--- a/scripts/statistics/distributions/betainv.m +++ b/scripts/statistics/distributions/betainv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} betainv (@var{x}, @var{a}, @var{b}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the Beta distribution with parameters @var{a} ## and @var{b}. ## @end deftypefn @@ -32,36 +33,39 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("betainv: X, A and B must be of common size or scalars"); + error ("betainv: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); - - k = find ((x < 0) | (x > 1) | !(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - inv (k) = NaN; + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betainv: X, A, and B must not be complex"); endif - k = find ((x == 1) & (a > 0) & (b > 0)); - if (any (k)) - inv (k) = 1; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif + k = (x < 0) | (x > 1) | !(a > 0) | !(b > 0) | isnan (x); + inv(k) = NaN; + + k = (x == 1) & (a > 0) & (b > 0); + inv(k) = 1; + k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0)); if (any (k)) - if (!isscalar(a) || !isscalar(b)) - a = a (k); - b = b (k); + if (!isscalar (a) || !isscalar (b)) + a = a(k); + b = b(k); y = a ./ (a + b); else y = a / (a + b) * ones (size (k)); endif - x = x (k); + x = x(k); if (isa (y, "single")) myeps = eps ("single"); @@ -97,7 +101,36 @@ y_old = y_new; endfor - inv (k) = y_new; + inv(k) = y_new; endif endfunction + + +%!shared x +%! x = [-1 0 0.75 1 2]; +%!assert(betainv (x, ones(1,5), 2*ones(1,5)), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, 1, 2*ones(1,5)), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, ones(1,5), 2), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, [1 0 NaN 1 1], 2), [NaN NaN NaN 1 NaN]); +%!assert(betainv (x, 1, 2*[1 0 NaN 1 1]), [NaN NaN NaN 1 NaN]); +%!assert(betainv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 0 NaN 1 NaN]); + +%% Test class of input preserved +%!assert(betainv ([x, NaN], 1, 2), [NaN 0 0.5 1 NaN NaN]); +%!assert(betainv (single([x, NaN]), 1, 2), single([NaN 0 0.5 1 NaN NaN])); +%!assert(betainv ([x, NaN], single(1), 2), single([NaN 0 0.5 1 NaN NaN])); +%!assert(betainv ([x, NaN], 1, single(2)), single([NaN 0 0.5 1 NaN NaN])); + +%% Test input validation +%!error betainv () +%!error betainv (1) +%!error betainv (1,2) +%!error betainv (1,2,3,4) +%!error betainv (ones(3),ones(2),ones(2)) +%!error betainv (ones(2),ones(3),ones(2)) +%!error betainv (ones(2),ones(2),ones(3)) +%!error betainv (i, 2, 2) +%!error betainv (2, i, 2) +%!error betainv (2, 2, i) +
--- a/scripts/statistics/distributions/betapdf.m +++ b/scripts/statistics/distributions/betapdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## Copyright (C) 2010 Christos Dimitrakakis ## @@ -19,8 +20,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} betapdf (@var{x}, @var{a}, @var{b}) -## For each element of @var{x}, returns the PDF at @var{x} of the beta -## distribution with parameters @var{a} and @var{b}. +## For each element of @var{x}, compute the probability density function (PDF) +## at @var{x} of the Beta distribution with parameters @var{a} and @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at>, CD <christos.dimitrakakis@gmail.com> @@ -32,70 +33,98 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("betapdf: X, A and B must be of common size or scalar"); + error ("betapdf: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - pdf = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betapdf: X, A, and B must not be complex"); + endif - k = find (!(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - pdf (k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")); + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0) & ((a != 1) | (b != 1))); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = exp ((a - 1) .* log (x(k)) - + (b - 1) .* log (1 - x(k)) - + lgamma(a + b) - lgamma(a) - lgamma(b)); - else - pdf(k) = exp ((a(k) - 1) .* log (x(k)) - + (b(k) - 1) .* log (1 - x(k)) - + lgamma(a(k) + b(k)) - lgamma(a(k)) - lgamma(b(k))); - endif + k = !(a > 0) | !(b > 0) | isnan (x); + pdf(k) = NaN; + + k = (x > 0) & (x < 1) & (a > 0) & (b > 0) & ((a != 1) | (b != 1)); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp ((a - 1) * log (x(k)) + + (b - 1) * log (1 - x(k)) + + lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp ((a(k) - 1) .* log (x(k)) + + (b(k) - 1) .* log (1 - x(k)) + + lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); endif ## Most important special cases when the density is finite. - k = find ((x == 0) & (a == 1) & (b > 0) & (b != 1)); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = exp(lgamma(a + b) - lgamma(a) - lgamma(b)); - else - pdf(k) = exp(lgamma(a(k) + b(k)) - lgamma(a(k)) - lgamma(b(k))); - endif + k = (x == 0) & (a == 1) & (b > 0) & (b != 1); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp (lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); endif - k = find ((x == 1) & (b == 1) & (a > 0) & (a != 1)); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = exp(lgamma(a + b) - lgamma(a) - lgamma(b)); - else - pdf(k) = exp(lgamma(a(k) + b(k)) - lgamma(a(k)) - lgamma(b(k))); - endif + k = (x == 1) & (b == 1) & (a > 0) & (a != 1); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp (lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); endif - k = find ((x >= 0) & (x <= 1) & (a == 1) & (b == 1)); - if (any (k)) - pdf(k) = 1; - endif + k = (x >= 0) & (x <= 1) & (a == 1) & (b == 1); + pdf(k) = 1; ## Other special case when the density at the boundary is infinite. - k = find ((x == 0) & (a < 1)); - if (any (k)) - pdf(k) = Inf; - endif + k = (x == 0) & (a < 1); + pdf(k) = Inf; - k = find ((x == 1) & (b < 1)); - if (any (k)) - pdf(k) = Inf; - endif + k = (x == 1) & (b < 1); + pdf(k) = Inf; endfunction -%% Test large values for betapdf + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 2 1 0 0]; +%!assert(betapdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(betapdf (x, 1, 2*ones(1,5)), y); +%!assert(betapdf (x, ones(1,5), 2), y); +%!assert(betapdf (x, [0 NaN 1 1 1], 2), [NaN NaN y(3:5)]); +%!assert(betapdf (x, 1, 2*[0 NaN 1 1 1]), [NaN NaN y(3:5)]); +%!assert(betapdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(betapdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(betapdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(betapdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Beta (1/2,1/2) == arcsine distribution +%!test +%! x = rand (10,1); +%! y = 1./(pi * sqrt (x.*(1-x))); +%! assert(betapdf (x, 1/2, 1/2), y, 50*eps); + +%% Test large input values to betapdf %!assert (betapdf(0.5, 1000, 1000), 35.678, 1e-3) + +%% Test input validation +%!error betapdf () +%!error betapdf (1) +%!error betapdf (1,2) +%!error betapdf (1,2,3,4) +%!error betapdf (ones(3),ones(2),ones(2)) +%!error betapdf (ones(2),ones(3),ones(2)) +%!error betapdf (ones(2),ones(2),ones(3)) +%!error betapdf (i, 2, 2) +%!error betapdf (2, i, 2) +%!error betapdf (2, 2, i) +
--- a/scripts/statistics/distributions/betarnd.m +++ b/scripts/statistics/distributions/betarnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,83 +18,120 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} betarnd (@var{a}, @var{b}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, @var{sz}) -## Return an @var{r} by @var{c} or @code{size (@var{sz})} matrix of -## random samples from the Beta distribution with parameters @var{a} and -## @var{b}. Both @var{a} and @var{b} must be scalar or of size @var{r} -## by @var{c}. +## @deftypefn {Function File} {} betarnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the Beta distribution with parameters +## @var{a} and @var{b}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{a} and @var{b}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Beta distribution -function rnd = betarnd (a, b, r, c) +function rnd = betarnd (a, b, varargin) - if (nargin > 1) - if (!isscalar(a) || !isscalar(b)) - [retval, a, b] = common_size (a, b); - if (retval > 0) - error ("betarnd: A and B must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("betarnd: A and B must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("betarnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("betarnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (a) || iscomplex (b)) + error ("betarnd: A and B must not be complex"); + endif - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("betarnd: A and B must be scalar or of size [R,C]"); - endif + if (nargin == 2) + sz = size (a); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("betarnd: R must be a positive integer or vector"); + error ("betarnd: dimension vector must be row vector of non-negative integers"); endif - - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("betarnd: A and B must be scalar or of size SZ"); + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("betarnd: dimensions must be non-negative integers"); endif - elseif (nargin == 2) - sz = size(a); - else - print_usage (); + sz = [varargin{:}]; endif - if (isscalar(a) && isscalar(b)) - if (find (!(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf))) - rnd = NaN (sz); + if (!isscalar (a) && !isequal (size (a), sz)) + error ("betarnd: A and B must be scalar or of size SZ"); + endif + + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((a > 0) && (a < Inf) && (b > 0) && (b < Inf)) + r = randg (a, sz); + rnd = r ./ (r + randg (b, sz)); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif else - r1 = randg(a,sz); - rnd = r1 ./ (r1 + randg(b,sz)); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); + rnd = NaN (sz, cls); - k = find (!(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf)); - if (any (k)) - rnd(k) = NaN (size (k)); - endif - - k = find ((a > 0) & (a < Inf) & (b > 0) & (b < Inf)); - if (any (k)) - r1 = randg(a(k),size(k)); - rnd(k) = r1 ./ (r1 + randg(b(k),size(k))); - endif + k = (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + r = randg (a(k)); + rnd(k) = r ./ (r + randg (b(k))); endif endfunction + + +%!assert(size (betarnd (1,2)), [1, 1]); +%!assert(size (betarnd (ones(2,1), 2)), [2, 1]); +%!assert(size (betarnd (ones(2,2), 2)), [2, 2]); +%!assert(size (betarnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (betarnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (betarnd (1, 2, 3)), [3, 3]); +%!assert(size (betarnd (1, 2, [4 1])), [4, 1]); +%!assert(size (betarnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (betarnd (1, 2)), "double"); +%!assert(class (betarnd (single(1), 2)), "single"); +%!assert(class (betarnd (single([1 1]), 2)), "single"); +%!assert(class (betarnd (1, single(2))), "single"); +%!assert(class (betarnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error betarnd () +%!error betarnd (1) +%!error betarnd (ones(3),ones(2)) +%!error betarnd (ones(2),ones(3)) +%!error betarnd (i, 2) +%!error betarnd (2, i) +%!error betarnd (1,2, -1) +%!error betarnd (1,2, ones(2)) +%!error binornd (1,2, [2 -1 2]) +%!error betarnd (1,2, 1, ones(2)) +%!error betarnd (1,2, 1, -1) +%!error betarnd (ones(2,2), 2, 3) +%!error betarnd (ones(2,2), 2, [3, 2]) +%!error betarnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/binocdf.m +++ b/scripts/statistics/distributions/binocdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} binocdf (@var{x}, @var{n}, @var{p}) -## For each element of @var{x}, compute the CDF at @var{x} of the -## binomial distribution with parameters @var{n} and @var{p}. +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the binomial distribution with parameters @var{n} and +## @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -34,34 +36,62 @@ if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("binocdf: X, N and P must be of common size or scalar"); + error ("binocdf: X, N, and P must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binocdf: X, N, and P must not be complex"); + endif - k = find (isnan (x) | !(n >= 0) | (n != round (n)) - | !(p >= 0) | !(p <= 1)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x >= n) & (n >= 0) & (n == round (n)) - & (p >= 0) & (p <= 1)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(n >= 0) | (n != fix (n)) | !(p >= 0) | !(p <= 1); + cdf(k) = NaN; + + k = (x >= n) & (n >= 0) & (n == fix (n) & (p >= 0) & (p <= 1)); + cdf(k) = 1; - k = find ((x >= 0) & (x < n) & (n == round (n)) - & (p >= 0) & (p <= 1)); - if (any (k)) - tmp = floor (x(k)); - if (isscalar (n) && isscalar (p)) - cdf(k) = 1 - betainc (p, tmp + 1, n - tmp); - else - cdf(k) = 1 - betainc (p(k), tmp + 1, n(k) - tmp); - endif + k = (x >= 0) & (x < n) & (n == fix (n)) & (p >= 0) & (p <= 1); + tmp = floor (x(k)); + if (isscalar (n) && isscalar (p)) + cdf(k) = 1 - betainc (p, tmp + 1, n - tmp); + else + cdf(k) = 1 - betainc (p(k), tmp + 1, n(k) - tmp); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/4 3/4 1 1]; +%!assert(binocdf (x, 2*ones(1,5), 0.5*ones(1,5)), y); +%!assert(binocdf (x, 2, 0.5*ones(1,5)), y); +%!assert(binocdf (x, 2*ones(1,5), 0.5), y); +%!assert(binocdf (x, 2*[0 -1 NaN 1.1 1], 0.5), [0 NaN NaN NaN 1]); +%!assert(binocdf (x, 2, 0.5*[0 -1 NaN 3 1]), [0 NaN NaN NaN 1]); +%!assert(binocdf ([x(1:2) NaN x(4:5)], 2, 0.5), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(binocdf ([x, NaN], 2, 0.5), [y, NaN]); +%!assert(binocdf (single([x, NaN]), 2, 0.5), single([y, NaN])); +%!assert(binocdf ([x, NaN], single(2), 0.5), single([y, NaN])); +%!assert(binocdf ([x, NaN], 2, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error binocdf () +%!error binocdf (1) +%!error binocdf (1,2) +%!error binocdf (1,2,3,4) +%!error binocdf (ones(3),ones(2),ones(2)) +%!error binocdf (ones(2),ones(3),ones(2)) +%!error binocdf (ones(2),ones(2),ones(3)) +%!error binocdf (i, 2, 2) +%!error binocdf (2, i, 2) +%!error binocdf (2, 2, i) +
--- a/scripts/statistics/distributions/binoinv.m +++ b/scripts/statistics/distributions/binoinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} binoinv (@var{x}, @var{n}, @var{p}) -## For each element of @var{x}, compute the quantile at @var{x} of the -## binomial distribution with parameters @var{n} and @var{p}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the binomial distribution with parameters +## @var{n} and @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -34,24 +36,29 @@ if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("binoinv: X, N and P must be of common size or scalars"); + error ("binoinv: X, N, and P must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binoinv: X, N, and P must not be complex"); + endif - k = find (!(x >= 0) | !(x <= 1) | !(n >= 0) | (n != round (n)) - | !(p >= 0) | !(p <= 1)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif - k = find ((x >= 0) & (x <= 1) & (n >= 0) & (n == round (n)) - & (p >= 0) & (p <= 1)); + k = (!(x >= 0) | !(x <= 1) | !(n >= 0) | (n != fix (n)) | + !(p >= 0) | !(p <= 1)); + inv(k) = NaN; + + k = find ((x >= 0) & (x <= 1) & (n >= 0) & (n == fix (n) + & (p >= 0) & (p <= 1))); if (any (k)) if (isscalar (n) && isscalar (p)) - cdf = binopdf (0, n, p) * ones (size(k)); + cdf = binopdf (0, n, p) * ones (size (k)); while (any (inv(k) < n)) m = find (cdf < x(k)); if (any (m)) @@ -76,3 +83,32 @@ endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(binoinv (x, 2*ones(1,5), 0.5*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2, 0.5*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2*ones(1,5), 0.5), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2*[0 -1 NaN 1.1 1], 0.5), [NaN NaN NaN NaN NaN]); +%!assert(binoinv (x, 2, 0.5*[0 -1 NaN 3 1]), [NaN NaN NaN NaN NaN]); +%!assert(binoinv ([x(1:2) NaN x(4:5)], 2, 0.5), [NaN 0 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(binoinv ([x, NaN], 2, 0.5), [NaN 0 1 2 NaN NaN]); +%!assert(binoinv (single([x, NaN]), 2, 0.5), single([NaN 0 1 2 NaN NaN])); +%!assert(binoinv ([x, NaN], single(2), 0.5), single([NaN 0 1 2 NaN NaN])); +%!assert(binoinv ([x, NaN], 2, single(0.5)), single([NaN 0 1 2 NaN NaN])); + +%% Test input validation +%!error binoinv () +%!error binoinv (1) +%!error binoinv (1,2) +%!error binoinv (1,2,3,4) +%!error binoinv (ones(3),ones(2),ones(2)) +%!error binoinv (ones(2),ones(3),ones(2)) +%!error binoinv (ones(2),ones(2),ones(3)) +%!error binoinv (i, 2, 2) +%!error binoinv (2, i, 2) +%!error binoinv (2, 2, i) +
--- a/scripts/statistics/distributions/binopdf.m +++ b/scripts/statistics/distributions/binopdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,26 +36,65 @@ if (! isscalar (n) || ! isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("binopdf: X, N and P must be of common size or scalar"); + error ("binopdf: X, N, and P must be of common size or scalars"); endif endif - k = ((x >= 0) & (x <= n) - & (x == round (x)) & (n == round (n)) - & (p >= 0) & (p <= 1)); + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binopdf: X, N, and P must not be complex"); + endif - pdf = zeros (size (x)); + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = (x == fix (x)) & (n == fix (n)) & (n >= 0) & (p >= 0) & (p <= 1); + pdf(! k) = NaN; - if (any (k(:))) - x = x(k); - if (! isscalar (n)) - n = n(k); - endif - if (! isscalar (p)) - p = p(k); - endif - z = gammaln(n+1) - gammaln(x+1) - gammaln(n-x+1) + x.*log(p) + (n-x).*log(1-p); - pdf(k) = exp (z); + + k &= ((x >= 0) & (x <= n)); + if (isscalar (n) && isscalar (p)) + pdf(k) = exp (gammaln (n+1) - gammaln (x(k)+1) - gammaln (n-x(k)+1) + + x(k)*log (p) + (n-x(k))*log (1-p)); + else + pdf(k) = exp (gammaln (n(k)+1) - gammaln (x(k)+1) - gammaln (n(k)-x(k)+1) + + x(k).*log (p(k)) + (n(k)-x(k)).*log (1-p(k))); endif endfunction + + +%!shared x,y,tol +%! if (ismac ()) +%! tol = eps (); +%! else +%! tol = 0; +%! endif +%! x = [-1 0 1 2 3]; +%! y = [0 1/4 1/2 1/4 0]; +%!assert(binopdf (x, 2*ones(1,5), 0.5*ones(1,5)), y, tol); +%!assert(binopdf (x, 2, 0.5*ones(1,5)), y, tol); +%!assert(binopdf (x, 2*ones(1,5), 0.5), y, tol); +%!assert(binopdf (x, 2*[0 -1 NaN 1.1 1], 0.5), [0 NaN NaN NaN 0]); +%!assert(binopdf (x, 2, 0.5*[0 -1 NaN 3 1]), [0 NaN NaN NaN 0]); +%!assert(binopdf ([x, NaN], 2, 0.5), [y, NaN], tol); + +%% Test class of input preserved +%!assert(binopdf (single([x, NaN]), 2, 0.5), single([y, NaN])); +%!assert(binopdf ([x, NaN], single(2), 0.5), single([y, NaN])); +%!assert(binopdf ([x, NaN], 2, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error binopdf () +%!error binopdf (1) +%!error binopdf (1,2) +%!error binopdf (1,2,3,4) +%!error binopdf (ones(3),ones(2),ones(2)) +%!error binopdf (ones(2),ones(3),ones(2)) +%!error binopdf (ones(2),ones(2),ones(3)) +%!error binopdf (i, 2, 2) +%!error binopdf (2, i, 2) +%!error binopdf (2, 2, i) +
--- a/scripts/statistics/distributions/binornd.m +++ b/scripts/statistics/distributions/binornd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,96 +18,136 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} binornd (@var{n}, @var{p}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the binomial distribution with parameters @var{n} -## and @var{p}. Both @var{n} and @var{p} must be scalar or of size -## @var{r} by @var{c}. +## @deftypefn {Function File} {} binornd (@var{n}, @var{p}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the binonmial distribution with +## parameters @var{n} and @var{p}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{n} and @var{p}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{n} and @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the binomial distribution -function rnd = binornd (n, p, r, c) +function rnd = binornd (n, p, varargin) - if (nargin > 1) - if (!isscalar(n) || !isscalar(p)) - [retval, n, p] = common_size (n, p); - if (retval > 0) - error ("binornd: N and P must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, n, p] = common_size (n, p); + if (retval > 0) + error ("binornd: N and P must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("binornd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("binornd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (n) || iscomplex (p)) + error ("binornd: N and P must not be complex"); + endif - if (any (size (n) != 1) - && (length (size (n)) != length (sz) || any (size (n) != sz))) - error ("binornd: N and must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (n); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("binornd: R must be a positive integer or vector"); + error ("binornd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("binornd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (n) != 1) - && (length (size (n)) != length (sz) || any (size (n) != sz))) - error ("binornd: N and must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(n); + if (!isscalar (n) && !isequal (size (n), sz)) + error ("binornd: N and P must be scalar or of size SZ"); + endif + + if (isa (n, "single") || isa (p, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (n) && isscalar (p)) - if (find (!(n >= 0) | !(n < Inf) | !(n == round (n)) | - !(p >= 0) | !(p <= 1))) - rnd = NaN (sz); - elseif (n == 0) - rnd = zeros (sz); - else + if ((n > 0) && (n < Inf) && (n == fix (n)) && (p >= 0) && (p <= 1)) nel = prod (sz); tmp = rand (n, nel); - rnd = sum(tmp < ones (n, nel) * p, 1); - rnd = reshape(rnd, sz); + rnd = sum (tmp < p, 1); + rnd = reshape (rnd, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + elseif ((n == 0) && (p >= 0) && (p <= 1)) + rnd = zeros (sz, cls); + else + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); + rnd = zeros (sz, cls); - k = find (!(n >= 0) | !(n < Inf) | !(n == round (n)) | - !(p >= 0) | !(p <= 1)); - if (any (k)) - rnd(k) = NaN; - endif + k = !(n >= 0) | !(n < Inf) | !(n == fix (n)) | !(p >= 0) | !(p <= 1); + rnd(k) = NaN; - k = find ((n > 0) & (n < Inf) & (n == round (n)) & (p >= 0) & (p <= 1)); - if (any (k)) + k = (n > 0) & (n < Inf) & (n == fix (n)) & (p >= 0) & (p <= 1); + if (any (k(:))) N = max (n(k)); - L = length (k); + L = sum (k(:)); tmp = rand (N, L); - ind = (1 : N)' * ones (1, L); - rnd(k) = sum ((tmp < ones (N, 1) * p(k)(:)') & - (ind <= ones (N, 1) * n(k)(:)'),1); + ind = repmat ((1 : N)', 1, L); + rnd(k) = sum ((tmp < repmat (p(k)(:)', N, 1)) & + (ind <= repmat (n(k)(:)', N, 1)), 1); endif endif endfunction -%!assert (binornd(0, 0, 1), 0) -%!assert (binornd([0, 0], [0, 0], 1, 2), [0, 0]) + +%!assert (binornd (0, 0, 1), 0) +%!assert (binornd ([0, 0], [0, 0], 1, 2), [0, 0]) + +%!assert(size (binornd (2, 1/2)), [1, 1]); +%!assert(size (binornd (2*ones(2,1), 1/2)), [2, 1]); +%!assert(size (binornd (2*ones(2,2), 1/2)), [2, 2]); +%!assert(size (binornd (2, 1/2*ones(2,1))), [2, 1]); +%!assert(size (binornd (2, 1/2*ones(2,2))), [2, 2]); +%!assert(size (binornd (2, 1/2, 3)), [3, 3]); +%!assert(size (binornd (2, 1/2, [4 1])), [4, 1]); +%!assert(size (binornd (2, 1/2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (binornd (2, 0.5)), "double"); +%!assert(class (binornd (single(2), 0.5)), "single"); +%!assert(class (binornd (single([2 2]), 0.5)), "single"); +%!assert(class (binornd (2, single(0.5))), "single"); +%!assert(class (binornd (2, single([0.5 0.5]))), "single"); + +%% Test input validation +%!error binornd () +%!error binornd (1) +%!error binornd (ones(3),ones(2)) +%!error binornd (ones(2),ones(3)) +%!error binornd (i, 2) +%!error binornd (2, i) +%!error binornd (1,2, -1) +%!error binornd (1,2, ones(2)) +%!error binornd (1,2, [2 -1 2]) +%!error binornd (1,2, 1, ones(2)) +%!error binornd (1,2, 1, -1) +%!error binornd (ones(2,2), 2, 3) +%!error binornd (ones(2,2), 2, [3, 2]) +%!error binornd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/cauchy_cdf.m +++ b/scripts/statistics/distributions/cauchy_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cauchy_cdf (@var{x}, @var{location}, @var{scale}) +## @deftypefn {Function File} {} cauchy_cdf (@var{x}) +## @deftypefnx {Function File} {} cauchy_cdf (@var{x}, @var{location}, @var{scale}) ## For each element of @var{x}, compute the cumulative distribution ## function (CDF) at @var{x} of the Cauchy distribution with location ## parameter @var{location} and scale parameter @var{scale}. Default @@ -27,35 +29,63 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: CDF of the Cauchy distribution -function cdf = cauchy_cdf (x, location, scale) +function cdf = cauchy_cdf (x, location = 0, scale = 1) - if (! (nargin == 1 || nargin == 3)) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - location = 0; - scale = 1; - endif - if (!isscalar (location) || !isscalar (scale)) [retval, x, location, scale] = common_size (x, location, scale); if (retval > 0) - error ("cauchy_cdf: X, LOCATION and SCALE must be of common size or scalar"); + error ("cauchy_cdf: X, LOCATION, and SCALE must be of common size or scalars"); endif endif - sz = size (x); - cdf = NaN (sz); + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_cdf: X, LOCATION, and SCALE must not be complex"); + endif - k = find (ones (sz) & (location > -Inf) & (location < Inf) - & (scale > 0) & (scale < Inf)); - if (any (k)) - if (isscalar (location) && isscalar (scale)) - cdf(k) = 0.5 + atan ((x(k) - location) ./ scale) / pi; - else - cdf(k) = 0.5 + atan ((x(k) - location(k)) ./ scale(k)) / pi; - endif + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")); + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); + endif + + k = !isinf (location) & (scale > 0) & (scale < Inf); + if (isscalar (location) && isscalar (scale)) + cdf = 0.5 + atan ((x - location) / scale) / pi; + else + cdf(k) = 0.5 + atan ((x(k) - location(k)) ./ scale(k)) / pi; endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = 1/pi * atan ((x-1) / 2) + 1/2; +%!assert(cauchy_cdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(cauchy_cdf (x, 1, 2*ones(1,5)), y); +%!assert(cauchy_cdf (x, ones(1,5), 2), y); +%!assert(cauchy_cdf (x, [-Inf 1 NaN 1 Inf], 2), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_cdf (x, 1, 2*[0 1 NaN 1 Inf]), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_cdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(cauchy_cdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(cauchy_cdf (single([x, NaN]), 1, 2), single([y, NaN]), eps("single")); +%!assert(cauchy_cdf ([x, NaN], single(1), 2), single([y, NaN]), eps("single")); +%!assert(cauchy_cdf ([x, NaN], 1, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error cauchy_cdf () +%!error cauchy_cdf (1,2) +%!error cauchy_cdf (1,2,3,4) +%!error cauchy_cdf (ones(3),ones(2),ones(2)) +%!error cauchy_cdf (ones(2),ones(3),ones(2)) +%!error cauchy_cdf (ones(2),ones(2),ones(3)) +%!error cauchy_cdf (i, 2, 2) +%!error cauchy_cdf (2, i, 2) +%!error cauchy_cdf (2, 2, i) +
--- a/scripts/statistics/distributions/cauchy_inv.m +++ b/scripts/statistics/distributions/cauchy_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cauchy_inv (@var{x}, @var{location}, @var{scale}) +## @deftypefn {Function File} {} cauchy_inv (@var{x}) +## @deftypefnx {Function File} {} cauchy_inv (@var{x}, @var{location}, @var{scale}) ## For each element of @var{x}, compute the quantile (the inverse of the ## CDF) at @var{x} of the Cauchy distribution with location parameter ## @var{location} and scale parameter @var{scale}. Default values are @@ -27,47 +29,70 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the Cauchy distribution -function inv = cauchy_inv (x, location, scale) +function inv = cauchy_inv (x, location = 0, scale = 1) - if (! (nargin == 1 || nargin == 3)) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - location = 0; - scale = 1; - endif - if (!isscalar (location) || !isscalar (scale)) [retval, x, location, scale] = common_size (x, location, scale); if (retval > 0) - error ("cauchy_inv: X, LOCATION and SCALE must be of common size or scalar"); + error ("cauchy_inv: X, LOCATION, and SCALE must be of common size or scalars"); endif endif - sz = size (x); - inv = NaN (sz); + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_inv: X, LOCATION, and SCALE must not be complex"); + endif - ok = ((location > -Inf) & (location < Inf) & - (scale > 0) & (scale < Inf)); - - k = find ((x == 0) & ok); - if (any (k)) - inv(k) = -Inf; + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & ok); - if (any (k)) - if (isscalar (location) && isscalar (scale)) - inv(k) = location - scale .* cot (pi * x(k)); - else - inv(k) = location(k) - scale(k) .* cot (pi * x(k)); - endif - endif + ok = !isinf (location) & (scale > 0) & (scale < Inf); + + k = (x == 0) & ok; + inv(k) = -Inf; - k = find ((x == 1) & ok); - if (any (k)) - inv(k) = Inf; + k = (x == 1) & ok; + inv(k) = Inf; + + k = (x > 0) & (x < 1) & ok; + if (isscalar (location) && isscalar (scale)) + inv(k) = location - scale * cot (pi * x(k)); + else + inv(k) = location(k) - scale(k) .* cot (pi * x(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(cauchy_inv (x, ones(1,5), 2*ones(1,5)), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, 1, 2*ones(1,5)), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, ones(1,5), 2), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, [1 -Inf NaN Inf 1], 2), [NaN NaN NaN NaN NaN]); +%!assert(cauchy_inv (x, 1, 2*[1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(cauchy_inv ([x(1:2) NaN x(4:5)], 1, 2), [NaN -Inf NaN Inf NaN]); + +%% Test class of input preserved +%!assert(cauchy_inv ([x, NaN], 1, 2), [NaN -Inf 1 Inf NaN NaN], eps); +%!assert(cauchy_inv (single([x, NaN]), 1, 2), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); +%!assert(cauchy_inv ([x, NaN], single(1), 2), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); +%!assert(cauchy_inv ([x, NaN], 1, single(2)), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error cauchy_inv () +%!error cauchy_inv (1,2) +%!error cauchy_inv (1,2,3,4) +%!error cauchy_inv (ones(3),ones(2),ones(2)) +%!error cauchy_inv (ones(2),ones(3),ones(2)) +%!error cauchy_inv (ones(2),ones(2),ones(3)) +%!error cauchy_inv (i, 2, 2) +%!error cauchy_inv (2, i, 2) +%!error cauchy_inv (2, 2, i) +
--- a/scripts/statistics/distributions/cauchy_pdf.m +++ b/scripts/statistics/distributions/cauchy_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cauchy_pdf (@var{x}, @var{location}, @var{scale}) +## @deftypefn {Function File} {} cauchy_pdf (@var{x}) +## @deftypefnx {Function File} {} cauchy_pdf (@var{x}, @var{location}, @var{scale}) ## For each element of @var{x}, compute the probability density function ## (PDF) at @var{x} of the Cauchy distribution with location parameter ## @var{location} and scale parameter @var{scale} > 0. Default values are @@ -27,37 +29,69 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: PDF of the Cauchy distribution -function pdf = cauchy_pdf (x, location, scale) +function pdf = cauchy_pdf (x, location = 0, scale = 1) - if (! (nargin == 1 || nargin == 3)) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - location = 0; - scale = 1; - endif - if (!isscalar (location) || !isscalar (scale)) [retval, x, location, scale] = common_size (x, location, scale); if (retval > 0) - error ("cauchy_pdf: X, LOCATION and SCALE must be of common size or scalar"); + error ("cauchy_pdf: X, LOCATION, and SCALE must be of common size or scalars"); endif endif - sz = size (x); - pdf = NaN (sz); + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_pdf: X, LOCATION, and SCALE must not be complex"); + endif - k = find ((x > -Inf) & (x < Inf) & (location > -Inf) & - (location < Inf) & (scale > 0) & (scale < Inf)); - if (any (k)) - if (isscalar (location) && isscalar (scale)) - pdf(k) = ((1 ./ (1 + ((x(k) - location) ./ scale) .^ 2)) - / pi ./ scale); - else - pdf(k) = ((1 ./ (1 + ((x(k) - location(k)) ./ scale(k)) .^ 2)) - / pi ./ scale(k)); - endif + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); + endif + + k = !isinf (location) & (scale > 0) & (scale < Inf); + if (isscalar (location) && isscalar (scale)) + pdf = ((1 ./ (1 + ((x - location) / scale) .^ 2)) + / pi / scale); + else + pdf(k) = ((1 ./ (1 + ((x(k) - location(k)) ./ scale(k)) .^ 2)) + / pi ./ scale(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = 1/pi * ( 2 ./ ((x-1).^2 + 2^2) ); +%!assert(cauchy_pdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(cauchy_pdf (x, 1, 2*ones(1,5)), y); +%!assert(cauchy_pdf (x, ones(1,5), 2), y); +%!assert(cauchy_pdf (x, [-Inf 1 NaN 1 Inf], 2), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_pdf (x, 1, 2*[0 1 NaN 1 Inf]), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_pdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(cauchy_pdf (single([x, NaN]), 1, 2), single([y, NaN]), eps("single")); +%!assert(cauchy_pdf ([x, NaN], single(1), 2), single([y, NaN]), eps("single")); +%!assert(cauchy_pdf ([x, NaN], 1, single(2)), single([y, NaN]), eps("single")); + +%% Cauchy (0,1) == Student's T distribution with 1 DOF +%!test +%! x = rand (10, 1); +%! assert(cauchy_pdf (x, 0, 1), tpdf (x, 1), eps); + +%% Test input validation +%!error cauchy_pdf () +%!error cauchy_pdf (1,2) +%!error cauchy_pdf (1,2,3,4) +%!error cauchy_pdf (ones(3),ones(2),ones(2)) +%!error cauchy_pdf (ones(2),ones(3),ones(2)) +%!error cauchy_pdf (ones(2),ones(2),ones(3)) +%!error cauchy_pdf (i, 2, 2) +%!error cauchy_pdf (2, i, 2) +%!error cauchy_pdf (2, 2, i) +
--- a/scripts/statistics/distributions/cauchy_rnd.m +++ b/scripts/statistics/distributions/cauchy_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,78 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the Cauchy distribution with parameters @var{location} -## and @var{scale} which must both be scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} cauchy_rnd (@var{location}, @var{scale}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{r}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, [@var{sz}]) +## Return a matrix of random samples from the Cauchy distribution with +## parameters @var{location} and @var{scale}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{location} and @var{scale}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{location} and @var{scale}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Cauchy distribution -function rnd = cauchy_rnd (location, scale, r, c) +function rnd = cauchy_rnd (location, scale, varargin) - if (nargin > 1) - if (!isscalar (location) || !isscalar (scale)) - [retval, location, scale] = common_size (location, scale); - if (retval > 0) - error ("cauchy_rnd: LOCATION and SCALE must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (location) || !isscalar (scale)) + [retval, location, scale] = common_size (location, scale); + if (retval > 0) + error ("cauchy_rnd: LOCATION and SCALE must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("cauchy_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("cauchy_rnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (location) || iscomplex (scale)) + error ("cauchy_rnd: LOCATION and SCALE must not be complex"); + endif - if (any (size (location) != 1) - && (length (size (location)) != length (sz) - || any (size (location) != sz))) - error ("cauchy_rnd: LOCATION and SCALE must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (location); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("cauchy_rnd: R must be a positive integer or vector"); + error ("cauchy_rnd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("cauchy_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (location) != 1) - && (length (size (location)) != length (sz) - || any (size (location) != sz))) - error ("cauchy_rnd: LOCATION and SCALE must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(location); + if (!isscalar (location) && !isequal (size (location), sz)) + error ("cauchy_rnd: LOCATION and SCALE must be scalar or of size SZ"); + endif + + if (isa (location, "single") || isa (scale, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (location) && isscalar (scale)) - if (find (!(location > -Inf) | !(location < Inf) - | !(scale > 0) | !(scale < Inf))) - rnd = NaN (sz); + if (!isinf (location) && (scale > 0) && (scale < Inf)) + rnd = location - cot (pi * rand (sz)) * scale; else - rnd = location - cot (pi * rand (sz)) .* scale; + rnd = NaN (sz, cls); endif else - rnd = NaN (sz); - k = find ((location > -Inf) & (location < Inf) - & (scale > 0) & (scale < Inf)); - if (any (k)) - rnd(k) = location(k)(:) - cot (pi * rand (size (k))) .* scale(k)(:); - endif + rnd = NaN (sz, cls); + + k = !isinf (location) & (scale > 0) & (scale < Inf); + rnd(k) = location(k)(:) - cot (pi * rand (sum (k(:)), 1)) .* scale(k)(:); endif endfunction + + +%!assert(size (cauchy_rnd (1,2)), [1, 1]); +%!assert(size (cauchy_rnd (ones(2,1), 2)), [2, 1]); +%!assert(size (cauchy_rnd (ones(2,2), 2)), [2, 2]); +%!assert(size (cauchy_rnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (cauchy_rnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (cauchy_rnd (1, 2, 3)), [3, 3]); +%!assert(size (cauchy_rnd (1, 2, [4 1])), [4, 1]); +%!assert(size (cauchy_rnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (cauchy_rnd (1, 2)), "double"); +%!assert(class (cauchy_rnd (single(1), 2)), "single"); +%!assert(class (cauchy_rnd (single([1 1]), 2)), "single"); +%!assert(class (cauchy_rnd (1, single(2))), "single"); +%!assert(class (cauchy_rnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error cauchy_rnd () +%!error cauchy_rnd (1) +%!error cauchy_rnd (ones(3),ones(2)) +%!error cauchy_rnd (ones(2),ones(3)) +%!error cauchy_rnd (i, 2) +%!error cauchy_rnd (2, i) +%!error cauchy_rnd (1,2, -1) +%!error cauchy_rnd (1,2, ones(2)) +%!error cauchy_rnd (1,2, [2 -1 2]) +%!error cauchy_rnd (1,2, 1, ones(2)) +%!error cauchy_rnd (1,2, 1, -1) +%!error cauchy_rnd (ones(2,2), 2, 3) +%!error cauchy_rnd (ones(2,2), 2, [3, 2]) +%!error cauchy_rnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/chi2cdf.m +++ b/scripts/statistics/distributions/chi2cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} chi2cdf (@var{x}, @var{n}) ## For each element of @var{x}, compute the cumulative distribution -## function (CDF) at @var{x} of the chisquare distribution with @var{n} +## function (CDF) at @var{x} of the chi-square distribution with @var{n} ## degrees of freedom. ## @end deftypefn @@ -35,10 +36,38 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("chi2cdf: X and N must be of common size or scalar"); + error ("chi2cdf: X and N must be of common size or scalars"); endif endif - cdf = gamcdf (x, n / 2, 2); + if (iscomplex (x) || iscomplex (n)) + error ("chi2cdf: X and N must not be complex"); + endif + + cdf = gamcdf (x, n/2, 2); endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0, 1 - exp(-x(2:end)/2)]; +%!assert(chi2cdf (x, 2*ones(1,5)), y, eps); +%!assert(chi2cdf (x, 2), y, eps); +%!assert(chi2cdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)], eps); +%!assert(chi2cdf ([x(1:2) NaN x(4:5)], 2), [y(1:2) NaN y(4:5)], eps); + +%% Test class of input preserved +%!assert(chi2cdf ([x, NaN], 2), [y, NaN], eps); +%!assert(chi2cdf (single([x, NaN]), 2), single([y, NaN]), eps("single")); +%!assert(chi2cdf ([x, NaN], single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error chi2cdf () +%!error chi2cdf (1) +%!error chi2cdf (1,2,3) +%!error chi2cdf (ones(3),ones(2)) +%!error chi2cdf (ones(2),ones(3)) +%!error chi2cdf (i, 2) +%!error chi2cdf (2, i) +
--- a/scripts/statistics/distributions/chi2inv.m +++ b/scripts/statistics/distributions/chi2inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} chi2inv (@var{x}, @var{n}) ## For each element of @var{x}, compute the quantile (the inverse of the -## CDF) at @var{x} of the chisquare distribution with @var{n} degrees of +## CDF) at @var{x} of the chi-square distribution with @var{n} degrees of ## freedom. ## @end deftypefn @@ -35,10 +36,37 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("chi2inv: X and N must be of common size or scalar"); + error ("chi2inv: X and N must be of common size or scalars"); endif endif - inv = gaminv (x, n / 2, 2); + if (iscomplex (x) || iscomplex (n)) + error ("chi2inv: X and N must not be complex"); + endif + + inv = gaminv (x, n/2, 2); endfunction + + +%!shared x +%! x = [-1 0 0.3934693402873666 1 2]; +%!assert(chi2inv (x, 2*ones(1,5)), [NaN 0 1 Inf NaN], 5*eps); +%!assert(chi2inv (x, 2), [NaN 0 1 Inf NaN], 5*eps); +%!assert(chi2inv (x, 2*[0 1 NaN 1 1]), [NaN 0 NaN Inf NaN], 5*eps); +%!assert(chi2inv ([x(1:2) NaN x(4:5)], 2), [NaN 0 NaN Inf NaN], 5*eps); + +%% Test class of input preserved +%!assert(chi2inv ([x, NaN], 2), [NaN 0 1 Inf NaN NaN], 5*eps); +%!assert(chi2inv (single([x, NaN]), 2), single([NaN 0 1 Inf NaN NaN]), 5*eps("single")); +%!assert(chi2inv ([x, NaN], single(2)), single([NaN 0 1 Inf NaN NaN]), 5*eps("single")); + +%% Test input validation +%!error chi2inv () +%!error chi2inv (1) +%!error chi2inv (1,2,3) +%!error chi2inv (ones(3),ones(2)) +%!error chi2inv (ones(2),ones(3)) +%!error chi2inv (i, 2) +%!error chi2inv (2, i) +
--- a/scripts/statistics/distributions/chi2pdf.m +++ b/scripts/statistics/distributions/chi2pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} chi2pdf (@var{x}, @var{n}) ## For each element of @var{x}, compute the probability density function -## (PDF) at @var{x} of the chisquare distribution with @var{n} degrees +## (PDF) at @var{x} of the chi-square distribution with @var{n} degrees ## of freedom. ## @end deftypefn @@ -35,10 +36,37 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("chi2pdf: X and N must be of common size or scalar"); + error ("chi2pdf: X and N must be of common size or scalars"); endif endif - pdf = gampdf (x, n / 2, 2); + if (iscomplex (x) || iscomplex (n)) + error ("chi2pdf: X and N must not be complex"); + endif + + pdf = gampdf (x, n/2, 2); endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1/2 * exp(-x(2:5)/2)]; +%!assert(chi2pdf (x, 2*ones(1,5)), y); +%!assert(chi2pdf (x, 2), y); +%!assert(chi2pdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(chi2pdf ([x, NaN], 2), [y, NaN]); + +%% Test class of input preserved +%!assert(chi2pdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(chi2pdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error chi2pdf () +%!error chi2pdf (1) +%!error chi2pdf (1,2,3) +%!error chi2pdf (ones(3),ones(2)) +%!error chi2pdf (ones(2),ones(3)) +%!error chi2pdf (i, 2) +%!error chi2pdf (2, i) +
--- a/scripts/statistics/distributions/chi2rnd.m +++ b/scripts/statistics/distributions/chi2rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,75 +18,103 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} chi2rnd (@var{n}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} chi2rnd (@var{n}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the chisquare distribution with @var{n} degrees -## of freedom. @var{n} must be a scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} chi2rnd (@var{n}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the chi-square distribution with +## @var{n} degrees of freedom. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the size of @var{n}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the chi-square distribution -function rnd = chi2rnd (n, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("chi2rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("chi2rnd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = chi2rnd (n, varargin) - if (any (size (n) != 1) - && (length (size (n)) != length (sz) || any (size (n) != sz))) - error ("chi2rnd: N must be scalar or of size [R, C]"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("chi2rnd: R must be a positive integer or vector"); - endif - - if (any (size (n) != 1) - && (length (size (n)) != length (sz) || any (size (n) != sz))) - error ("chi2rnd: N must be scalar or of size SZ"); - endif - elseif (nargin == 1) - sz = size(n); - else + if (nargin < 1) print_usage (); endif - if (isscalar (n)) - if (find (!(n > 0) | !(n < Inf))) - rnd = NaN (sz); - else - rnd = 2 * randg(n/2, sz); - endif - else - [retval, n, dummy] = common_size (n, ones (sz)); - if (retval > 0) - error ("chi2rnd: a and b must be of common size or scalar"); + if (nargin == 1) + sz = size (n); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("chi2rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("chi2rnd: dimensions must be non-negative integers"); endif + sz = [varargin{:}]; + endif - rnd = zeros (sz); - k = find (!(n > 0) | !(n < Inf)); - if (any (k)) - rnd(k) = NaN; + if (!isscalar (n) && !isequal (size (n), sz)) + error ("chi2rnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("chi2rnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n)) + if ((n > 0) && (n < Inf)) + rnd = 2 * randg (n/2, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); endif + else + rnd = NaN (sz, cls); - k = find ((n > 0) & (n < Inf)); - if (any (k)) - rnd(k) = 2 * randg(n(k)/2, size(k)); - endif + k = (n > 0) | (n < Inf); + rnd(k) = 2 * randg (n(k)/2); endif endfunction + + +%!assert(size (chi2rnd (2)), [1, 1]); +%!assert(size (chi2rnd (ones(2,1))), [2, 1]); +%!assert(size (chi2rnd (ones(2,2))), [2, 2]); +%!assert(size (chi2rnd (1, 3)), [3, 3]); +%!assert(size (chi2rnd (1, [4 1])), [4, 1]); +%!assert(size (chi2rnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (chi2rnd (2)), "double"); +%!assert(class (chi2rnd (single(2))), "single"); +%!assert(class (chi2rnd (single([2 2]))), "single"); + +%% Test input validation +%!error chi2rnd () +%!error chi2rnd (ones(3),ones(2)) +%!error chi2rnd (ones(2),ones(3)) +%!error chi2rnd (i) +%!error chi2rnd (1, -1) +%!error chi2rnd (1, ones(2)) +%!error chi2rnd (1, [2 -1 2]) +%!error chi2rnd (ones(2,2), 3) +%!error chi2rnd (ones(2,2), [3, 2]) +%!error chi2rnd (ones(2,2), 2, 3) +
--- a/scripts/statistics/distributions/discrete_cdf.m +++ b/scripts/statistics/distributions/discrete_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2010-2011 David Bateman ## ## This file is part of Octave. @@ -29,28 +30,52 @@ print_usage (); endif - sz = size (x); - if (! isvector (v)) error ("discrete_cdf: V must be a vector"); + elseif (any (isnan (v))) + error ("discrete_cdf: V must not have any NaN elements"); elseif (! isvector (p) || (length (p) != length (v))) error ("discrete_cdf: P must be a vector with length (V) elements"); elseif (! (all (p >= 0) && any (p))) - error ("discrete_cdf: P must be a nonzero, nonnegative vector"); + error ("discrete_cdf: P must be a nonzero, non-negative vector"); + endif + + p = p(:) / sum (p); # Reshape and normalize probability vector + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")); + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); endif - n = numel (x); - m = length (v); - x = reshape (x, n, 1); - v = reshape (v, 1, m); - p = reshape (p / sum (p), m, 1); - - cdf = NaN (sz); - k = find (!isnan (x)); - if (any (k)) - n = length (k); - [vs, vi] = sort (v); - cdf(k) = [0 ; cumsum(p(vi))](lookup (vs, x(k)) + 1); - endif + k = !isnan (x); + [vs, vi] = sort (v); + cdf(k) = [0 ; cumsum(p(vi))](lookup (vs, x(k)) + 1); endfunction + + +%!shared x,v,p,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [0 0.1 0.6 1 1]; +%!assert(discrete_cdf ([x, NaN], v, p), [y, NaN], eps); + +%% Test class of input preserved +%!assert(discrete_cdf (single([x, NaN]), v, p), single([y, NaN]), 2*eps("single")); +%!assert(discrete_cdf ([x, NaN], single(v), p), single([y, NaN]), 2*eps("single")); +%!assert(discrete_cdf ([x, NaN], v, single(p)), single([y, NaN]), 2*eps("single")); + +%% Test input validation +%!error discrete_cdf () +%!error discrete_cdf (1) +%!error discrete_cdf (1,2) +%!error discrete_cdf (1,2,3,4) +%!error discrete_cdf (1, ones(2), ones(2,1)) +%!error discrete_cdf (1, [1 ; NaN], ones(2,1)) +%!error discrete_cdf (1, ones(2,1), ones(1,1)) +%!error discrete_cdf (1, ones(2,1), [1 -1]) +%!error discrete_cdf (1, ones(2,1), [1 NaN]) +%!error discrete_cdf (1, ones(2,1), [0 0]) +
--- a/scripts/statistics/distributions/discrete_inv.m +++ b/scripts/statistics/distributions/discrete_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} discrete_inv (@var{x}, @var{v}, @var{p}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the univariate distribution which assumes the ## values in @var{v} with probabilities @var{p}. ## @end deftypefn @@ -32,35 +33,63 @@ print_usage (); endif - sz = size (x); - if (! isvector (v)) error ("discrete_inv: V must be a vector"); elseif (! isvector (p) || (length (p) != length (v))) error ("discrete_inv: P must be a vector with length (V) elements"); + elseif (any (isnan (p))) + error ("discrete_rnd: P must not have any NaN elements"); elseif (! (all (p >= 0) && any (p))) - error ("discrete_inv: P must be a nonzero, nonnegative vector"); + error ("discrete_inv: P must be a nonzero, non-negative vector"); + endif + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")); + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - n = numel (x); - x = reshape (x, 1, n); - m = length (v); - [v, idx] = sort (v); - p = reshape (cumsum (p (idx) / sum (p)), m, 1); - - inv = NaN (sz); - if (any (k = find (x == 0))) - inv(k) = -Inf; - endif - if (any (k = find (x == 1))) - inv(k) = v(m) * ones (size (k)); + ## FIXME: This isn't elegant. But cumsum and lookup together produce + ## different results when called with a single or a double. + if (isa (p, "single")); + p = double (p); endif - if (any (k = find ((x > 0) & (x < 1)))) - n = length (k); - inv (k) = v(length (p) - lookup (sort (p,"descend"), x(k)) + 1); - endif + [v, idx] = sort (v); + p = cumsum (p(idx)(:)) / sum (p); # Reshape and normalize probability vector + + k = (x == 0); + inv(k) = v(1); + + k = (x == 1); + inv(k) = v(end); + + k = (x > 0) & (x < 1); + inv(k) = v(length (p) - lookup (sort (p, "descend"), x(k)) + 1); endfunction +%!shared x,v,p,y +%! x = [-1 0 0.1 0.5 1 2]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [NaN v(1) v(1) v(end/2) v(end) NaN]; +%!assert(discrete_inv ([x, NaN], v, p), [y, NaN], eps); + +%% Test class of input preserved +%!assert(discrete_inv (single([x, NaN]), v, p), single([y, NaN]), eps("single")); +%!assert(discrete_inv ([x, NaN], single(v), p), single([y, NaN]), eps("single")); +%!assert(discrete_inv ([x, NaN], v, single(p)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error discrete_inv () +%!error discrete_inv (1) +%!error discrete_inv (1,2) +%!error discrete_inv (1,2,3,4) +%!error discrete_inv (1, ones(2), ones(2,1)) +%!error discrete_inv (1, ones(2,1), ones(1,1)) +%!error discrete_inv (1, ones(2,1), [1 NaN]) +%!error discrete_inv (1, ones(2,1), [1 -1]) +%!error discrete_inv (1, ones(2,1), [0 0]) +
--- a/scripts/statistics/distributions/discrete_pdf.m +++ b/scripts/statistics/distributions/discrete_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -24,7 +25,7 @@ ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> -## Description: pDF of a discrete distribution +## Description: PDF of a discrete distribution function pdf = discrete_pdf (x, v, p) @@ -32,28 +33,53 @@ print_usage (); endif - sz = size (x); - if (! isvector (v)) error ("discrete_pdf: V must be a vector"); + elseif (any (isnan (v))) + error ("discrete_pdf: V must not have any NaN elements"); elseif (! isvector (p) || (length (p) != length (v))) error ("discrete_pdf: P must be a vector with length (V) elements"); elseif (! (all (p >= 0) && any (p))) - error ("discrete_pdf: P must be a nonzero, nonnegative vector"); + error ("discrete_pdf: P must be a nonzero, non-negative vector"); + endif + + ## Reshape and normalize probability vector. Values not in table get 0 prob. + p = [0 ; p(:)/sum(p)]; + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); endif - n = numel (x); - m = length (v); - x = reshape (x, n, 1); - v = reshape (v, 1, m); - p = reshape (p / sum (p), m, 1); - - pdf = NaN (sz); - k = find (!isnan (x)); - if (any (k)) - n = length (k); - [vs, vi] = sort (v); - pdf (k) = p (vi(lookup (vs, x(k), 'm'))); - endif + k = !isnan (x); + [vs, vi] = sort (v(:)); + pdf(k) = p([0 ; vi](lookup (vs, x(k), 'm') + 1) + 1); endfunction + + +%!shared x,v,p,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [0 0.1 0.1 0.1 0]; +%!assert(discrete_pdf ([x, NaN], v, p), [y, NaN], 5*eps); + +%% Test class of input preserved +%!assert(discrete_pdf (single([x, NaN]), v, p), single([y, NaN]), 5*eps("single")); +%!assert(discrete_pdf ([x, NaN], single(v), p), single([y, NaN]), 5*eps("single")); +%!assert(discrete_pdf ([x, NaN], v, single(p)), single([y, NaN]), 5*eps("single")); + +%% Test input validation +%!error discrete_pdf () +%!error discrete_pdf (1) +%!error discrete_pdf (1,2) +%!error discrete_pdf (1,2,3,4) +%!error discrete_pdf (1, ones(2), ones(2,1)) +%!error discrete_pdf (1, [1 ; NaN], ones(2,1)) +%!error discrete_pdf (1, ones(2,1), ones(1,1)) +%!error discrete_pdf (1, ones(2,1), [1 -1]) +%!error discrete_pdf (1, ones(2,1), [1 NaN]) +%!error discrete_pdf (1, ones(2,1), [0 0]) +
--- a/scripts/statistics/distributions/discrete_rnd.m +++ b/scripts/statistics/distributions/discrete_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,51 +18,29 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} discrete_rnd (@var{n}, @var{v}, @var{p}) -## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{sz}) -## Generate a row vector containing a random sample of size @var{n} from -## the univariate distribution which assumes the values in @var{v} with -## probabilities @var{p}. @var{n} must be a scalar. +## @deftypefn {Function File} {} discrete_rnd (@var{v}, @var{p}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the univariate distribution which +## assumes the values in @var{v} with probabilities @var{p}. ## -## If @var{r} and @var{c} are given create a matrix with @var{r} rows and -## @var{c} columns. Or if @var{sz} is a vector, create a matrix of size -## @var{sz}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{v} and @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from a discrete distribution -function rnd = discrete_rnd (v, p, r, c) +function rnd = discrete_rnd (v, p, varargin) - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("discrete_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("discrete_rnd: C must be a positive integer"); - endif - sz = [r, c]; - elseif (nargin == 3) - ## A potential problem happens here if all args are scalar, as - ## we can't distiguish between the command syntax. Thankfully this - ## case doesn't make much sense. So we assume the first syntax - ## if the first arg is scalar - - if (isscalar (v)) - sz = [1, floor(v)]; - v = p; - p = r; - else - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("discrete_rnd: R must be a positive integer or vector"); - endif - endif - else + if (nargin < 2) print_usage (); endif @@ -69,9 +48,57 @@ error ("discrete_rnd: V must be a vector"); elseif (! isvector (p) || (length (p) != length (v))) error ("discrete_rnd: P must be a vector with length (V) elements"); + elseif (any (isnan (p))) + error ("discrete_rnd: P must not have any NaN elements"); elseif (! (all (p >= 0) && any (p))) - error ("discrete_rnd: P must be a nonzero, nonnegative vector"); + error ("discrete_rnd: P must be a nonzero, non-negative vector"); + endif + + if (nargin == 2) + sz = size (v); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("discrete_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("discrete_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; endif - rnd = v (lookup (cumsum (p (1 : end-1)) / sum(p), rand (sz)) + 1); + rnd = v(lookup (cumsum (p(1:end-1)) / sum (p), rand (sz)) + 1); + rnd = reshape (rnd, sz); + endfunction + + +%!assert(size (discrete_rnd (1:2, 1:2, 3)), [3, 3]); +%!assert(size (discrete_rnd (1:2, 1:2, [4 1])), [4, 1]); +%!assert(size (discrete_rnd (1:2, 1:2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (discrete_rnd (1:2, 1:2)), "double"); +%!assert(class (discrete_rnd (single(1:2), 1:2)), "single"); +## FIXME: Maybe this should work, maybe it shouldn't. +#%!assert(class (discrete_rnd (1:2, single(1:2))), "single"); + +%% Test input validation +%!error discrete_rnd () +%!error discrete_rnd (1) +%!error discrete_rnd (1:2,1:2, -1) +%!error discrete_rnd (1:2,1:2, ones(2)) +%!error discrete_rnd (1:2,1:2, [2 -1 2]) +%!error discrete_rnd (1:2,1:2, 1, ones(2)) +%!error discrete_rnd (1:2,1:2, 1, -1) +%% test v,p verification +%!error discrete_rnd (1, ones(2), ones(2,1)) +%!error discrete_rnd (1, ones(2,1), ones(1,1)) +%!error discrete_rnd (1, ones(2,1), [1 -1]) +%!error discrete_rnd (1, ones(2,1), [1 NaN]) +%!error discrete_rnd (1, ones(2,1), [0 0]) +
--- a/scripts/statistics/distributions/empirical_cdf.m +++ b/scripts/statistics/distributions/empirical_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -36,6 +37,26 @@ error ("empirical_cdf: DATA must be a vector"); endif - cdf = discrete_cdf (x, data, ones (size (data)) / length (data)); + cdf = discrete_cdf (x, data, ones (size (data))); endfunction + + +%!shared x,v,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! y = [0 0.1 0.6 1 1]; +%!assert(empirical_cdf (x, v), y, eps); +%!assert(empirical_cdf ([x(1) NaN x(3:5)], v), [0 NaN 0.6 1 1], eps); + +%% Test class of input preserved +%!assert(empirical_cdf ([x, NaN], v), [y, NaN], eps); +%!assert(empirical_cdf (single([x, NaN]), v), single([y, NaN]), eps); +%!assert(empirical_cdf ([x, NaN], single(v)), single([y, NaN]), eps); + +%% Test input validation +%!error empirical_cdf () +%!error empirical_cdf (1) +%!error empirical_cdf (1,2,3) +%!error empirical_cdf (1, ones(2)) +
--- a/scripts/statistics/distributions/empirical_inv.m +++ b/scripts/statistics/distributions/empirical_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -36,6 +37,25 @@ error ("empirical_inv: DATA must be a vector"); endif - inv = discrete_inv (x, data, ones (size (data)) / length (data)); + inv = discrete_inv (x, data, ones (size (data))); endfunction + + +%!shared x,v,y +%! x = [-1 0 0.1 0.5 1 2]; +%! v = 0.1:0.2:1.9; +%! y = [NaN v(1) v(1) v(end/2) v(end) NaN]; +%!assert(empirical_inv (x, v), y, eps); + +%% Test class of input preserved +%!assert(empirical_inv ([x, NaN], v), [y, NaN], eps); +%!assert(empirical_inv (single([x, NaN]), v), single([y, NaN]), eps); +%!assert(empirical_inv ([x, NaN], single(v)), single([y, NaN]), eps); + +%% Test input validation +%!error empirical_inv () +%!error empirical_inv (1) +%!error empirical_inv (1,2,3) +%!error empirical_inv (1, ones(2)) +
--- a/scripts/statistics/distributions/empirical_pdf.m +++ b/scripts/statistics/distributions/empirical_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -36,6 +37,24 @@ error ("empirical_pdf: DATA must be a vector"); endif - pdf = discrete_pdf (x, data, ones (size (data)) / length (data)); + pdf = discrete_pdf (x, data, ones (size (data))); endfunction + + +%!shared x,v,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! y = [0 0.1 0.1 0.1 0]; +%!assert(empirical_pdf (x, v), y); + +%% Test class of input preserved +%!assert(empirical_pdf (single(x), v), single (y)); +%!assert(empirical_pdf (x, single(v)), single (y)); + +%% Test input validation +%!error empirical_pdf () +%!error empirical_pdf (1) +%!error empirical_pdf (1,2,3) +%!error empirical_inv (1, ones(2)) +
--- a/scripts/statistics/distributions/empirical_rnd.m +++ b/scripts/statistics/distributions/empirical_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,29 +18,29 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} empirical_rnd (@var{n}, @var{data}) -## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{sz}) -## Generate a bootstrap sample of size @var{n} from the empirical -## distribution obtained from the univariate sample @var{data}. +## @deftypefn {Function File} {} empirical_rnd (@var{data}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{r}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, [@var{sz}]) +## Return a matrix of random samples from the empirical distribution obtained +## from the univariate sample @var{data}. ## -## If @var{r} and @var{c} are given create a matrix with @var{r} rows and -## @var{c} columns. Or if @var{sz} is a vector, create a matrix of size -## @var{sz}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is a random ordering +## of the sample @var{data}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Bootstrap samples from the empirical distribution -function rnd = empirical_rnd (data, r, c) +function rnd = empirical_rnd (data, varargin) - if (nargin == 2) - if (isscalar(data)) - c = data; - data = r; - r = 1; - endif - elseif (nargin != 3) + if (nargin < 1) print_usage (); endif @@ -47,6 +48,22 @@ error ("empirical_rnd: DATA must be a vector"); endif - rnd = discrete_rnd (data, ones (size (data)) / length (data), r, c); + rnd = discrete_rnd (data, ones (size (data)), varargin{:}); endfunction + + +%!assert(size (empirical_rnd (ones (3, 1))), [3, 1]); +%!assert(size (empirical_rnd (1:2, [4 1])), [4, 1]); +%!assert(size (empirical_rnd (1:2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (empirical_rnd (1:2, 1)), "double"); +%!assert(class (empirical_rnd (single(1:2), 1)), "single"); + +%% Test input validation +%!error empirical_rnd () +%!error empirical_rnd (ones(2), 1) +%% test data verification +%!error empirical_rnd (ones(2), 1, 1) +
--- a/scripts/statistics/distributions/expcdf.m +++ b/scripts/statistics/distributions/expcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -22,7 +23,7 @@ ## function (CDF) at @var{x} of the exponential distribution with ## mean @var{lambda}. ## -## The arguments can be of common size or scalar. +## The arguments can be of common size or scalars. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -34,40 +35,57 @@ print_usage (); endif - if (!isscalar (x) && !isscalar(lambda)) + if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("expcdf: X and LAMBDA must be of common size or scalar"); + error ("expcdf: X and LAMBDA must be of common size or scalars"); endif endif - if (isscalar (x)) - sz = size (lambda); - else - sz = size (x); + if (iscomplex (x) || iscomplex (lambda)) + error ("expcdf: X and LAMBDA must not be complex"); endif - cdf = zeros (sz); - - k = find (isnan (x) | !(lambda > 0)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (lambda, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (lambda > 0)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(lambda > 0); + cdf(k) = NaN; + + k = (x == Inf) & (lambda > 0); + cdf(k) = 1; - k = find ((x > 0) & (x < Inf) & (lambda > 0)); - if (any (k)) - if isscalar (lambda) - cdf (k) = 1 - exp (- x(k) ./ lambda); - elseif isscalar (x) - cdf (k) = 1 - exp (- x ./ lambda(k)); - else - cdf (k) = 1 - exp (- x(k) ./ lambda(k)); - endif + k = (x > 0) & (x < Inf) & (lambda > 0); + if isscalar (lambda) + cdf(k) = 1 - exp (- x(k) / lambda); + else + cdf(k) = 1 - exp (- x(k) ./ lambda(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1 - exp(-x(2:end)/2)]; +%!assert(expcdf (x, 2*ones(1,5)), y); +%!assert(expcdf (x, 2), y); +%!assert(expcdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); + +%% Test class of input preserved +%!assert(expcdf ([x, NaN], 2), [y, NaN]); +%!assert(expcdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(expcdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error expcdf () +%!error expcdf (1) +%!error expcdf (1,2,3) +%!error expcdf (ones(3),ones(2)) +%!error expcdf (ones(2),ones(3)) +%!error expcdf (i, 2) +%!error expcdf (2, i) +
--- a/scripts/statistics/distributions/expinv.m +++ b/scripts/statistics/distributions/expinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,8 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} expinv (@var{x}, @var{lambda}) ## For each element of @var{x}, compute the quantile (the inverse of the -## CDF) at @var{x} of the exponential distribution with mean -## @var{lambda}. +## CDF) at @var{x} of the exponential distribution with mean @var{lambda}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -32,41 +32,64 @@ print_usage (); endif - if (!isscalar (x) && !isscalar(lambda)) + if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("expinv: X and LAMBDA must be of common size or scalar"); + error ("expinv: X and LAMBDA must be of common size or scalars"); endif endif - if (isscalar (x)) - sz = size (lambda); - else - sz = size (x); + if (iscomplex (x) || iscomplex (lambda)) + error ("expinv: X and LAMBDA must not be complex"); endif - inv = zeros (sz); + if (!isscalar (x)) + sz = size (x); + else + sz = size (lambda); + endif - k = find (!(lambda > 0) | (x < 0) | (x > 1) | isnan (x)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (lambda)) + error ("expinv: X and LAMBDA must not be complex"); endif - k = find ((x == 1) & (lambda > 0)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (lambda, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & (lambda > 0)); - if (any (k)) - if isscalar (lambda) - inv(k) = - lambda .* log (1 - x(k)); - elseif isscalar (x) - inv(k) = - lambda(k) .* log (1 - x); - else - inv(k) = - lambda(k) .* log (1 - x(k)); - endif + k = (x == 1) & (lambda > 0); + inv(k) = Inf; + + k = (x >= 0) & (x < 1) & (lambda > 0); + if isscalar (lambda) + inv(k) = - lambda * log (1 - x(k)); + else + inv(k) = - lambda(k) .* log (1 - x(k)); endif endfunction + +%!shared x +%! x = [-1 0 0.3934693402873666 1 2]; +%!assert(expinv (x, 2*ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(expinv (x, 2), [NaN 0 1 Inf NaN], eps); +%!assert(expinv (x, 2*[1 0 NaN 1 1]), [NaN NaN NaN Inf NaN], eps); +%!assert(expinv ([x(1:2) NaN x(4:5)], 2), [NaN 0 NaN Inf NaN], eps); + +%% Test class of input preserved +%!assert(expinv ([x, NaN], 2), [NaN 0 1 Inf NaN NaN], eps); +%!assert(expinv (single([x, NaN]), 2), single([NaN 0 1 Inf NaN NaN]), eps); +%!assert(expinv ([x, NaN], single(2)), single([NaN 0 1 Inf NaN NaN]), eps); + +%% Test input validation +%!error expinv () +%!error expinv (1) +%!error expinv (1,2,3) +%!error expinv (ones(3),ones(2)) +%!error expinv (ones(2),ones(3)) +%!error expinv (i, 2) +%!error expinv (2, i) +
--- a/scripts/statistics/distributions/exppdf.m +++ b/scripts/statistics/distributions/exppdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} exppdf (@var{x}, @var{lambda}) ## For each element of @var{x}, compute the probability density function -## (PDF) of the exponential distribution with mean @var{lambda}. +## (PDF) at @var{x} of the exponential distribution with mean @var{lambda}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,34 +32,53 @@ print_usage (); endif - if (!isscalar (x) && !isscalar(lambda)) + if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("exppdf: X and LAMBDA must be of common size or scalar"); + error ("exppdf: X and LAMBDA must be of common size or scalars"); endif endif - if (isscalar (x)) - sz = size (lambda); - else - sz = size (x); - endif - pdf = zeros (sz); - - k = find (!(lambda > 0) | isnan (x)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (lambda)) + error ("exppdf: X and LAMBDA must not be complex"); endif - k = find ((x >= 0) & (x < Inf) & (lambda > 0)); - if (any (k)) - if isscalar (lambda) - pdf(k) = exp (- x(k) ./ lambda) ./ lambda; - elseif isscalar (x) - pdf(k) = exp (- x ./ lambda(k)) ./ lambda(k); - else - pdf(k) = exp (- x(k) ./ lambda(k)) ./ lambda(k); - endif + if (isa (x, "single") || isa (lambda, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(lambda > 0); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (lambda > 0); + if isscalar (lambda) + pdf(k) = exp (- x(k) / lambda) / lambda; + else + pdf(k) = exp (- x(k) ./ lambda(k)) ./ lambda(k); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = gampdf (x, 1, 2); +%!assert(exppdf (x, 2*ones(1,5)), y); +%!assert(exppdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(exppdf ([x, NaN], 2), [y, NaN]); + +%% Test class of input preserved +%!assert(exppdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(exppdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error exppdf () +%!error exppdf (1) +%!error exppdf (1,2,3) +%!error exppdf (ones(3),ones(2)) +%!error exppdf (ones(2),ones(3)) +%!error exppdf (i, 2) +%!error exppdf (2, i) +
--- a/scripts/statistics/distributions/exprnd.m +++ b/scripts/statistics/distributions/exprnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,71 +18,100 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} exprnd (@var{lambda}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} exprnd (@var{lambda}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the -## exponential distribution with mean @var{lambda}, which must be a -## scalar or of size @var{r} by @var{c}. Or if @var{sz} is a vector, -## create a matrix of size @var{sz}. +## @deftypefn {Function File} {} exprnd (@var{lambda}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, @var{r}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, [@var{sz}]) +## Return a matrix of random samples from the exponential distribution with +## mean @var{lambda}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the size of @var{lambda}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{lambda}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the exponential distribution -function rnd = exprnd (lambda, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("exprnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("exprnd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = exprnd (lambda, varargin) - if (any (size (lambda) != 1) - && (length (size (lambda)) != length (sz) || any (size (lambda) != sz))) - error ("exprnd: LAMBDA must be scalar or of size [R, C]"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("exprnd: R must be a positive integer or vector"); - endif - - if (any (size (lambda) != 1) - && ((length (size (lambda)) != length (sz)) || any (size (lambda) != sz))) - error ("exprnd: LAMBDA must be scalar or of size SZ"); - endif - elseif (nargin == 1) - sz = size (lambda); - else + if (nargin < 1) print_usage (); endif + if (nargin == 1) + sz = size (lambda); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("exprnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("exprnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (lambda) && !isequal (size (lambda), sz)) + error ("exprnd: LAMBDA must be scalar or of size SZ"); + endif + + if (iscomplex (lambda)) + error ("exprnd: LAMBDA must not be complex"); + endif + + if (isa (lambda, "single")) + cls = "single"; + else + cls = "double"; + endif if (isscalar (lambda)) if ((lambda > 0) && (lambda < Inf)) - rnd = rande(sz) * lambda; + rnd = rande (sz) * lambda; else - rnd = NaN (sz); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); - k = find (!(lambda > 0) | !(lambda < Inf)); - if (any (k)) - rnd(k) = NaN; - endif - k = find ((lambda > 0) & (lambda < Inf)); - if (any (k)) - rnd(k) = rande(size(k)) .* lambda(k); - endif + rnd = NaN (sz, cls); + + k = (lambda > 0) & (lambda < Inf); + rnd(k) = rande (sum (k(:)), 1) .* lambda(k)(:); endif endfunction + + +%!assert(size (exprnd (2)), [1, 1]); +%!assert(size (exprnd (ones(2,1))), [2, 1]); +%!assert(size (exprnd (ones(2,2))), [2, 2]); +%!assert(size (exprnd (1, 3)), [3, 3]); +%!assert(size (exprnd (1, [4 1])), [4, 1]); +%!assert(size (exprnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (exprnd (1)), "double"); +%!assert(class (exprnd (single(1))), "single"); +%!assert(class (exprnd (single([1 1]))), "single"); + +%% Test input validation +%!error exprnd () +%!error exprnd (1, -1) +%!error exprnd (1, ones(2)) +%!error exprnd (i) +%!error exprnd (1, [2 -1 2]) +%!error exprnd (1, 2, -1) +%!error exprnd (1, 2, ones(2)) +%!error exprnd (ones(2,2), 3) +%!error exprnd (ones(2,2), [3, 2]) +%!error exprnd (ones(2,2), 2, 3) +
--- a/scripts/statistics/distributions/fcdf.m +++ b/scripts/statistics/distributions/fcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,9 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} fcdf (@var{x}, @var{m}, @var{n}) -## For each element of @var{x}, compute the CDF at @var{x} of the F -## distribution with @var{m} and @var{n} degrees of freedom, i.e., -## PROB (F (@var{m}, @var{n}) @leq{} @var{x}). +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the F distribution with @var{m} and @var{n} degrees of +## freedom. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -35,31 +36,61 @@ if (!isscalar (m) || !isscalar (n)) [retval, x, m, n] = common_size (x, m, n); if (retval > 0) - error ("fcdf: X, M and N must be of common size or scalar"); + error ("fcdf: X, M, and N must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("fcdf: X, M, and N must not be complex"); + endif - k = find (!(m > 0) | !(n > 0) | isnan (x)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (m > 0) & (n > 0)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(m > 0) | !(m < Inf) | !(n > 0) | !(n < Inf); + cdf(k) = NaN; + + k = (x == Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + cdf(k) = 1; - k = find ((x > 0) & (x < Inf) & (m > 0) & (n > 0)); - if (any (k)) - if (isscalar (m) && isscalar (n)) - cdf(k) = 1 - betainc (1 ./ (1 + m .* x(k) ./ n), n / 2, m / 2); - else - cdf(k) = 1 - betainc (1 ./ (1 + m(k) .* x(k) ./ n(k)), n(k) / 2, - m(k) / 2); - endif + k = (x > 0) & (x < Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + cdf(k) = 1 - betainc (1 ./ (1 + m * x(k) / n), n/2, m/2); + else + cdf(k) = 1 - betainc (1 ./ (1 + m(k) .* x(k) ./ n(k)), n(k)/2, m(k)/2); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2 Inf]; +%! y = [0 0 1/3 1/2 2/3 1]; +%!assert(fcdf (x, 2*ones(1,6), 2*ones(1,6)), y, eps); +%!assert(fcdf (x, 2, 2*ones(1,6)), y, eps); +%!assert(fcdf (x, 2*ones(1,6), 2), y, eps); +%!assert(fcdf (x, [0 NaN Inf 2 2 2], 2), [NaN NaN NaN y(4:6)], eps); +%!assert(fcdf (x, 2, [0 NaN Inf 2 2 2]), [NaN NaN NaN y(4:6)], eps); +%!assert(fcdf ([x(1:2) NaN x(4:6)], 2, 2), [y(1:2) NaN y(4:6)], eps); + +%% Test class of input preserved +%!assert(fcdf ([x, NaN], 2, 2), [y, NaN], eps); +%!assert(fcdf (single([x, NaN]), 2, 2), single([y, NaN]), eps("single")); +%!assert(fcdf ([x, NaN], single(2), 2), single([y, NaN]), eps("single")); +%!assert(fcdf ([x, NaN], 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error fcdf () +%!error fcdf (1) +%!error fcdf (1,2) +%!error fcdf (1,2,3,4) +%!error fcdf (ones(3),ones(2),ones(2)) +%!error fcdf (ones(2),ones(3),ones(2)) +%!error fcdf (ones(2),ones(2),ones(3)) +%!error fcdf (i, 2, 2) +%!error fcdf (2, i, 2) +%!error fcdf (2, 2, i) +
--- a/scripts/statistics/distributions/finv.m +++ b/scripts/statistics/distributions/finv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,9 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} finv (@var{x}, @var{m}, @var{n}) -## For each component of @var{x}, compute the quantile (the inverse of -## the CDF) at @var{x} of the F distribution with parameters @var{m} and -## @var{n}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the F distribution with @var{m} and @var{n} +## degrees of freedom. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -35,31 +36,58 @@ if (!isscalar (m) || !isscalar (n)) [retval, x, m, n] = common_size (x, m, n); if (retval > 0) - error ("finv: X, M and N must be of common size or scalar"); + error ("finv: X, M, and N must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("finv: X, M, and N must not be complex"); + endif - k = find ((x < 0) | (x > 1) | isnan (x) | !(m > 0) | !(n > 0)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x == 1) & (m > 0) & (n > 0)); - if (any (k)) - inv(k) = Inf; - endif + k = (x == 1) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + inv(k) = Inf; - k = find ((x > 0) & (x < 1) & (m > 0) & (n > 0)); - if (any (k)) - if (isscalar (m) && isscalar (n)) - inv(k) = ((1 ./ betainv (1 - x(k), n / 2, m / 2) - 1) .* n ./ m); - else - inv(k) = ((1 ./ betainv (1 - x(k), n(k) / 2, m(k) / 2) - 1) - .* n(k) ./ m(k)); - endif + k = (x >= 0) & (x < 1) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + inv(k) = ((1 ./ betainv (1 - x(k), n/2, m/2) - 1) * n / m); + else + inv(k) = ((1 ./ betainv (1 - x(k), n(k)/2, m(k)/2) - 1) + .* n(k) ./ m(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(finv (x, 2*ones(1,5), 2*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(finv (x, 2, 2*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(finv (x, 2*ones(1,5), 2), [NaN 0 1 Inf NaN]); +%!assert(finv (x, [2 -Inf NaN Inf 2], 2), [NaN NaN NaN NaN NaN]); +%!assert(finv (x, 2, [2 -Inf NaN Inf 2]), [NaN NaN NaN NaN NaN]); +%!assert(finv ([x(1:2) NaN x(4:5)], 2, 2), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(finv ([x, NaN], 2, 2), [NaN 0 1 Inf NaN NaN]); +%!assert(finv (single([x, NaN]), 2, 2), single([NaN 0 1 Inf NaN NaN])); +%!assert(finv ([x, NaN], single(2), 2), single([NaN 0 1 Inf NaN NaN])); +%!assert(finv ([x, NaN], 2, single(2)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error finv () +%!error finv (1) +%!error finv (1,2) +%!error finv (1,2,3,4) +%!error finv (ones(3),ones(2),ones(2)) +%!error finv (ones(2),ones(3),ones(2)) +%!error finv (ones(2),ones(2),ones(3)) +%!error finv (i, 2, 2) +%!error finv (2, i, 2) +%!error finv (2, 2, i) +
--- a/scripts/statistics/distributions/fpdf.m +++ b/scripts/statistics/distributions/fpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,31 +36,70 @@ if (!isscalar (m) || !isscalar (n)) [retval, x, m, n] = common_size (x, m, n); if (retval > 0) - error ("fpdf: X, M and N must be of common size or scalar"); + error ("fpdf: X, M, and N must be of common size or scalars"); endif endif - sz = size (x); - pdf = zeros (sz); + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("fpdf: X, M, and N must not be complex"); + endif - k = find (isnan (x) | !(m > 0) | !(n > 0)); - if (any (k)) - pdf(k) = NaN; + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find ((x > 0) & (x < Inf) & (m > 0) & (n > 0)); - if (any (k)) - if (isscalar (m) && isscalar (n)) - tmp = m / n * x(k); - pdf(k) = (exp ((m / 2 - 1) .* log (tmp) - - ((m + n) / 2) .* log (1 + tmp)) - .* (m / n) ./ beta (m / 2, n / 2)); - else - tmp = m(k) .* x(k) ./ n(k); - pdf(k) = (exp ((m(k) / 2 - 1) .* log (tmp) - - ((m(k) + n(k)) / 2) .* log (1 + tmp)) - .* (m(k) ./ n(k)) ./ beta (m(k) / 2, n(k) / 2)); - endif + k = isnan (x) | !(m > 0) | !(m < Inf) | !(n > 0) | !(n < Inf); + pdf(k) = NaN; + + k = (x > 0) & (x < Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + tmp = m / n * x(k); + pdf(k) = (exp ((m/2 - 1) * log (tmp) + - ((m + n) / 2) * log (1 + tmp)) + * (m / n) ./ beta (m/2, n/2)); + else + tmp = m(k) .* x(k) ./ n(k); + pdf(k) = (exp ((m(k)/2 - 1) .* log (tmp) + - ((m(k) + n(k)) / 2) .* log (1 + tmp)) + .* (m(k) ./ n(k)) ./ beta (m(k)/2, n(k)/2)); endif endfunction + + +%% F (x, 1, m) == T distribution (sqrt (x), m) / sqrt (x) +%!test +%! x = rand (10,1); +%! x = x(x > 0.1 & x < 0.9); +%! y = tpdf (sqrt (x), 2) ./ sqrt (x); +%! assert(fpdf (x, 1, 2), y, 5*eps); + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 0 4/9 1/4 1/9]; +%!assert(fpdf (x, 2*ones(1,5), 2*ones(1,5)), y, eps); +%!assert(fpdf (x, 2, 2*ones(1,5)), y, eps); +%!assert(fpdf (x, 2*ones(1,5), 2), y, eps); +%!assert(fpdf (x, [0 NaN Inf 2 2], 2), [NaN NaN NaN y(4:5)], eps); +%!assert(fpdf (x, 2, [0 NaN Inf 2 2]), [NaN NaN NaN y(4:5)], eps); +%!assert(fpdf ([x, NaN], 2, 2), [y, NaN], eps); + +%% Test class of input preserved +%!assert(fpdf (single([x, NaN]), 2, 2), single([y, NaN]), eps("single")); +%!assert(fpdf ([x, NaN], single(2), 2), single([y, NaN]), eps("single")); +%!assert(fpdf ([x, NaN], 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error fpdf () +%!error fpdf (1) +%!error fpdf (1,2) +%!error fpdf (1,2,3,4) +%!error fpdf (ones(3),ones(2),ones(2)) +%!error fpdf (ones(2),ones(3),ones(2)) +%!error fpdf (ones(2),ones(2),ones(3)) +%!error fpdf (i, 2, 2) +%!error fpdf (2, i, 2) +%!error fpdf (2, 2, i) +
--- a/scripts/statistics/distributions/frnd.m +++ b/scripts/statistics/distributions/frnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,103 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} frnd (@var{m}, @var{n}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the F -## distribution with @var{m} and @var{n} degrees of freedom. Both -## @var{m} and @var{n} must be scalar or of size @var{r} by @var{c}. -## If @var{sz} is a vector the random samples are in a matrix of -## size @var{sz}. +## @deftypefn {Function File} {} frnd (@var{m}, @var{n}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, @var{r}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, [@var{sz}]) +## Return a matrix of random samples from the F distribution with +## @var{m} and @var{n} degrees of freedom. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{m} and @var{n}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{m} and @var{n}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the F distribution -function rnd = frnd (m, n, r, c) +function rnd = frnd (m, n, varargin) - if (nargin > 1) - if (!isscalar(m) || !isscalar(n)) - [retval, m, n] = common_size (m, n); - if (retval > 0) - error ("frnd: M and N must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (m) || !isscalar (n)) + [retval, m, n] = common_size (m, n); + if (retval > 0) + error ("frnd: M and N must be of common size or scalars"); endif endif - - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("frnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("frnd: C must be a positive integer"); - endif - sz = [r, c]; - - if (any (size (m) != 1) - && ((length (size (m)) != length (sz)) || any (size (m) != sz))) - error ("frnd: M and N must be scalar or of size [R,C]"); - endif - elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("frnd: R must be a positive integer or vector"); - endif - - if (any (size (m) != 1) - && ((length (size (m)) != length (sz)) || any (size (m) != sz))) - error ("frnd: M and N must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(m); - else - print_usage (); + if (iscomplex (m) || iscomplex (n)) + error ("frnd: M and N must not be complex"); endif + if (nargin == 2) + sz = size (m); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("frnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("frnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (m) && !isequal (size (m), sz)) + error ("frnd: M and N must be scalar or of size SZ"); + endif + + if (isa (m, "single") || isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif if (isscalar (m) && isscalar (n)) - if (isinf (m) || isinf (n)) - if (isinf (m)) - rnd = ones (sz); - else - rnd = 2 ./ m .* randg(m / 2, sz); - endif - if (! isinf (n)) - rnd = 0.5 .* n .* rnd ./ randg (n / 2, sz); - endif - elseif ((m > 0) && (m < Inf) && (n > 0) && (n < Inf)) - rnd = n ./ m .* randg (m / 2, sz) ./ randg (n / 2, sz); + if ((m > 0) && (m < Inf) && (n > 0) && (n < Inf)) + rnd = n/m * randg (m/2, sz) ./ randg (n/2, sz); else - rnd = NaN (sz); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); - - k = find (isinf(m) | isinf(n)); - if (any (k)) - rnd (k) = 1; - k2 = find (!isinf(m) & isinf(n)); - rnd (k2) = 2 ./ m(k2) .* randg (m(k2) ./ 2, size(k2)); - k2 = find (isinf(m) & !isinf(n)); - rnd (k2) = 0.5 .* n(k2) .* rnd(k2) ./ randg (n(k2) ./ 2, size(k2)); - endif + rnd = NaN (sz, cls); - k = find (!(m > 0) | !(n > 0)); - if (any (k)) - rnd(k) = NaN; - endif - - k = find ((m > 0) & (m < Inf) & - (n > 0) & (n < Inf)); - if (any (k)) - rnd(k) = n(k) ./ m(k) .* randg(m(k)./2,size(k)) ./ randg(n(k)./2,size(k)); - endif + k = (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + rnd(k) = n(k) ./ m(k) .* randg (m(k)/2) ./ randg (n(k)/2); endif endfunction + + +%!assert(size (frnd (1,2)), [1, 1]); +%!assert(size (frnd (ones(2,1), 2)), [2, 1]); +%!assert(size (frnd (ones(2,2), 2)), [2, 2]); +%!assert(size (frnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (frnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (frnd (1, 2, 3)), [3, 3]); +%!assert(size (frnd (1, 2, [4 1])), [4, 1]); +%!assert(size (frnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (frnd (1, 2)), "double"); +%!assert(class (frnd (single(1), 2)), "single"); +%!assert(class (frnd (single([1 1]), 2)), "single"); +%!assert(class (frnd (1, single(2))), "single"); +%!assert(class (frnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error frnd () +%!error frnd (1) +%!error frnd (ones(3),ones(2)) +%!error frnd (ones(2),ones(3)) +%!error frnd (i, 2) +%!error frnd (2, i) +%!error frnd (1,2, -1) +%!error frnd (1,2, ones(2)) +%!error frnd (1, 2, [2 -1 2]) +%!error frnd (1,2, 1, ones(2)) +%!error frnd (1,2, 1, -1) +%!error frnd (ones(2,2), 2, 3) +%!error frnd (ones(2,2), 2, [3, 2]) +%!error frnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/gamcdf.m +++ b/scripts/statistics/distributions/gamcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -21,7 +22,6 @@ ## For each element of @var{x}, compute the cumulative distribution ## function (CDF) at @var{x} of the Gamma distribution with parameters ## @var{a} and @var{b}. -## @seealso{gamma, gammaln, gammainc, gampdf, gaminv, gamrnd} ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> @@ -33,28 +33,59 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("gamcdf: X, A and B must be of common size or scalars"); + error ("gamcdf: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); - - k = find (!(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - cdf (k) = NaN; + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gamcdf: X, A, and B must not be complex"); endif - k = find ((x > 0) & (a > 0) & (b > 0)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - cdf (k) = gammainc (x(k) ./ b, a); - else - cdf (k) = gammainc (x(k) ./ b(k), a(k)); - endif + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf); + cdf(k) = NaN; + + k = (x > 0) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + if (isscalar (a) && isscalar (b)) + cdf(k) = gammainc (x(k) / b, a); + else + cdf(k) = gammainc (x(k) ./ b(k), a(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2 Inf]; +%! y = [0, gammainc(x(2:end), 1)]; +%!assert(gamcdf (x, ones(1,6), ones(1,6)), y); +%!assert(gamcdf (x, 1, ones(1,6)), y); +%!assert(gamcdf (x, ones(1,6), 1), y); +%!assert(gamcdf (x, [0 -Inf NaN Inf 1 1], 1), [NaN NaN NaN NaN y(5:6)]); +%!assert(gamcdf (x, 1, [0 -Inf NaN Inf 1 1]), [NaN NaN NaN NaN y(5:6)]); +%!assert(gamcdf ([x(1:2) NaN x(4:6)], 1, 1), [y(1:2) NaN y(4:6)]); + +%% Test class of input preserved +%!assert(gamcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(gamcdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); + +%% Test input validation +%!error gamcdf () +%!error gamcdf (1) +%!error gamcdf (1,2) +%!error gamcdf (1,2,3,4) +%!error gamcdf (ones(3),ones(2),ones(2)) +%!error gamcdf (ones(2),ones(3),ones(2)) +%!error gamcdf (ones(2),ones(2),ones(3)) +%!error gamcdf (i, 2, 2) +%!error gamcdf (2, i, 2) +%!error gamcdf (2, 2, i) +
--- a/scripts/statistics/distributions/gaminv.m +++ b/scripts/statistics/distributions/gaminv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,10 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} gaminv (@var{x}, @var{a}, @var{b}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the Gamma distribution with parameters @var{a} ## and @var{b}. -## @seealso{gamma, gammaln, gammainc, gampdf, gamcdf, gamrnd} ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -33,36 +33,40 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("gaminv: X, A and B must be of common size or scalars"); + error ("gaminv: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gaminv: X, A, and B must not be complex"); + endif - k = find ((x < 0) | (x > 1) | isnan (x) | !(a > 0) | !(b > 0)); - if (any (k)) - inv (k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif - k = find ((x == 1) & (a > 0) & (b > 0)); - if (any (k)) - inv (k) = Inf; - endif + k = ((x < 0) | (x > 1) | isnan (x) + | !(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf)); + inv(k) = NaN; - k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0)); + k = (x == 1) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + inv(k) = Inf; + + k = find ((x > 0) & (x < 1) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf)); if (any (k)) - if (!isscalar(a) || !isscalar(b)) - a = a (k); - b = b (k); + if (!isscalar (a) || !isscalar (b)) + a = a(k); + b = b(k); y = a .* b; else y = a * b * ones (size (k)); endif - x = x (k); + x = x(k); if (isa (x, "single")) myeps = eps ("single"); @@ -90,7 +94,36 @@ y_old = y_new; endfor - inv (k) = y_new; + inv(k) = y_new; endif endfunction + + +%!shared x +%! x = [-1 0 0.63212055882855778 1 2]; +%!assert(gaminv (x, ones(1,5), ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, 1, ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, ones(1,5), 1), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, [1 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(gaminv (x, 1, [1 -Inf NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(gaminv ([x(1:2) NaN x(4:5)], 1, 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(gaminv ([x, NaN], 1, 1), [NaN 0 1 Inf NaN NaN], eps); +%!assert(gaminv (single([x, NaN]), 1, 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(gaminv ([x, NaN], single(1), 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(gaminv ([x, NaN], 1, single(1)), single([NaN 0 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error gaminv () +%!error gaminv (1) +%!error gaminv (1,2) +%!error gaminv (1,2,3,4) +%!error gaminv (ones(3),ones(2),ones(2)) +%!error gaminv (ones(2),ones(3),ones(2)) +%!error gaminv (ones(2),ones(2),ones(3)) +%!error gaminv (i, 2, 2) +%!error gaminv (2, i, 2) +%!error gaminv (2, 2, i) +
--- a/scripts/statistics/distributions/gampdf.m +++ b/scripts/statistics/distributions/gampdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -21,7 +22,6 @@ ## For each element of @var{x}, return the probability density function ## (PDF) at @var{x} of the Gamma distribution with parameters @var{a} ## and @var{b}. -## @seealso{gamma, gammaln, gammainc, gamcdf, gaminv, gamrnd} ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> @@ -33,41 +33,71 @@ print_usage (); endif - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("gampdf: X, A and B must be of common size or scalars"); + error ("gampdf: X, A, and B must be of common size or scalars"); endif endif - sz = size(x); - pdf = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gampdf: X, A, and B must not be complex"); + endif - k = find (!(a > 0) | !(b > 0) | isnan (x)); - if (any (k)) - pdf (k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find ((x >= 0) & (a > 0) & (a <= 1) & (b > 0)); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = (x(k) .^ (a - 1)) ... - .* exp(- x(k) ./ b) ./ gamma (a) ./ (b .^ a); - else - pdf(k) = (x(k) .^ (a(k) - 1)) ... - .* exp(- x(k) ./ b(k)) ./ gamma (a(k)) ./ (b(k) .^ a(k)); - endif + k = !(a > 0) | !(b > 0) | isnan (x); + pdf(k) = NaN; + + k = (x >= 0) & (a > 0) & (a <= 1) & (b > 0); + if (isscalar (a) && isscalar (b)) + pdf(k) = (x(k) .^ (a - 1)) ... + .* exp (- x(k) / b) / gamma (a) / (b ^ a); + else + pdf(k) = (x(k) .^ (a(k) - 1)) ... + .* exp (- x(k) ./ b(k)) ./ gamma (a(k)) ./ (b(k) .^ a(k)); endif - k = find ((x >= 0) & (a > 1) & (b > 0)); - if (any (k)) - if (isscalar(a) && isscalar(b)) - pdf(k) = exp (- a .* log (b) + (a-1) .* log (x(k)) - - x(k) ./ b - gammaln (a)); - else - pdf(k) = exp (- a(k) .* log (b(k)) + (a(k)-1) .* log (x(k)) - - x(k) ./ b(k) - gammaln (a(k))); - endif + k = (x >= 0) & (a > 1) & (b > 0); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (- a * log (b) + (a-1) * log (x(k)) + - x(k) / b - gammaln (a)); + else + pdf(k) = exp (- a(k) .* log (b(k)) + (a(k)-1) .* log (x(k)) + - x(k) ./ b(k) - gammaln (a(k))); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0 exp(-x(2:end))]; +%!assert(gampdf (x, ones(1,5), ones(1,5)), y); +%!assert(gampdf (x, 1, ones(1,5)), y); +%!assert(gampdf (x, ones(1,5), 1), y); +%!assert(gampdf (x, [0 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN y(5)]); +%!assert(gampdf (x, 1, [0 -Inf NaN Inf 1]), [NaN NaN NaN 0 y(5)]); +%!assert(gampdf ([x, NaN], 1, 1), [y, NaN]); + +%% Test class of input preserved +%!assert(gampdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(gampdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(gampdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error gampdf () +%!error gampdf (1) +%!error gampdf (1,2) +%!error gampdf (1,2,3,4) +%!error gampdf (ones(3),ones(2),ones(2)) +%!error gampdf (ones(2),ones(3),ones(2)) +%!error gampdf (ones(2),ones(2),ones(3)) +%!error gampdf (i, 2, 2) +%!error gampdf (2, i, 2) +%!error gampdf (2, 2, i) +
--- a/scripts/statistics/distributions/gamrnd.m +++ b/scripts/statistics/distributions/gamrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,81 +18,118 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} gamrnd (@var{a}, @var{b}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the Gamma distribution with parameters @var{a} -## and @var{b}. Both @var{a} and @var{b} must be scalar or of size -## @var{r} by @var{c}. +## @deftypefn {Function File} {} gamrnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the Gamma distribution with +## parameters @var{a} and @var{b}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{a} and @var{b}. -## @seealso{gamma, gammaln, gammainc, gampdf, gamcdf, gaminv} +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Gamma distribution -function rnd = gamrnd (a, b, r, c) +function rnd = gamrnd (a, b, varargin) - if (nargin > 1) - if (!isscalar(a) || !isscalar(b)) - [retval, a, b] = common_size (a, b); - if (retval > 0) - error ("gamrnd: A and B must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("gamrnd: A and B must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("gamrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("gamrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (a) || iscomplex (b)) + error ("gamrnd: A and B must not be complex"); + endif - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("gamrnd: A and B must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (a); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("gamrnd: R must be a positive integer or vector"); + error ("gamrnd: dimension vector must be row vector of non-negative integers"); endif - - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("gamrnd: A and B must be scalar or of size SZ"); + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("gamrnd: dimensions must be non-negative integers"); endif - elseif (nargin == 2) - sz = size(a); - else - print_usage (); + sz = [varargin{:}]; endif - rnd = zeros (sz); + if (!isscalar (a) && !isequal (size (a), sz)) + error ("gamrnd: A and B must be scalar or of size SZ"); + endif - if (isscalar (a) && isscalar(b)) - if (find (!(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf))) - rnd = NaN (sz); - else - rnd = b .* randg(a, sz); + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((a > 0) && (a < Inf) && (b > 0) && (b < Inf)) + rnd = b * randg (a, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); endif else - k = find (!(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf)); - if (any (k)) - rnd(k) = NaN; - endif - k = find ((a > 0) & (a < Inf) & (b > 0) & (b < Inf)); - if (any (k)) - rnd(k) = b(k) .* randg(a(k), size(k)); - endif + rnd = NaN (sz, cls); + + k = (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + rnd(k) = b(k) .* randg (a(k)); endif endfunction + + +%!assert(size (gamrnd (1,2)), [1, 1]); +%!assert(size (gamrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (gamrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (gamrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (gamrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (gamrnd (1, 2, 3)), [3, 3]); +%!assert(size (gamrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (gamrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (gamrnd (1, 2)), "double"); +%!assert(class (gamrnd (single(1), 2)), "single"); +%!assert(class (gamrnd (single([1 1]), 2)), "single"); +%!assert(class (gamrnd (1, single(2))), "single"); +%!assert(class (gamrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error gamrnd () +%!error gamrnd (1) +%!error gamrnd (ones(3),ones(2)) +%!error gamrnd (ones(2),ones(3)) +%!error gamrnd (i, 2) +%!error gamrnd (2, i) +%!error gamrnd (1,2, -1) +%!error gamrnd (1,2, ones(2)) +%!error gamrnd (1, 2, [2 -1 2]) +%!error gamrnd (1,2, 1, ones(2)) +%!error gamrnd (1,2, 1, -1) +%!error gamrnd (ones(2,2), 2, 3) +%!error gamrnd (ones(2,2), 2, [3, 2]) +%!error gamrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/geocdf.m +++ b/scripts/statistics/distributions/geocdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} geocdf (@var{x}, @var{p}) -## For each element of @var{x}, compute the CDF at @var{x} of the -## geometric distribution with parameter @var{p}. +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the geometric distribution with parameter @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,34 +32,58 @@ print_usage (); endif - if (!isscalar (x) && !isscalar (p)) + if (!isscalar (p)) [retval, x, p] = common_size (x, p); if (retval > 0) - error ("geocdf: X and P must be of common size or scalar"); + error ("geocdf: X and P must be of common size or scalars"); endif endif - cdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (p)) + error ("geocdf: X and P must not be complex"); + endif - k = find (isnan (x) | !(p >= 0) | !(p <= 1)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (p, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (p >= 0) & (p <= 1)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(p >= 0) | !(p <= 1); + cdf(k) = NaN; + + k = (x == Inf) & (p >= 0) & (p <= 1); + cdf(k) = 1; - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (p > 0) & (p <= 1)); - if (any (k)) - if (isscalar (x)) - cdf(k) = 1 - ((1 - p(k)) .^ (x + 1)); - elseif (isscalar (p)) - cdf(k) = 1 - ((1 - p) .^ (x(k) + 1)); - else - cdf(k) = 1 - ((1 - p(k)) .^ (x(k) + 1)); - endif + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (p > 0) & (p <= 1); + if (isscalar (p)) + cdf(k) = 1 - ((1 - p) .^ (x(k) + 1)); + else + cdf(k) = 1 - ((1 - p(k)) .^ (x(k) + 1)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 Inf]; +%! y = [0 0.5 0.75 1]; +%!assert(geocdf (x, 0.5*ones(1,4)), y); +%!assert(geocdf (x, 0.5), y); +%!assert(geocdf (x, 0.5*[-1 NaN 4 1]), [NaN NaN NaN y(4)]); +%!assert(geocdf ([x(1:2) NaN x(4)], 0.5), [y(1:2) NaN y(4)]); + +%% Test class of input preserved +%!assert(geocdf ([x, NaN], 0.5), [y, NaN]); +%!assert(geocdf (single([x, NaN]), 0.5), single([y, NaN])); +%!assert(geocdf ([x, NaN], single(0.5)), single([y, NaN])); + +%% Test input validation +%!error geocdf () +%!error geocdf (1) +%!error geocdf (1,2,3) +%!error geocdf (ones(3),ones(2)) +%!error geocdf (ones(2),ones(3)) +%!error geocdf (i, 2) +%!error geocdf (2, i) +
--- a/scripts/statistics/distributions/geoinv.m +++ b/scripts/statistics/distributions/geoinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} geoinv (@var{x}, @var{p}) -## For each element of @var{x}, compute the quantile at @var{x} of the -## geometric distribution with parameter @var{p}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the geometric distribution with parameter @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,34 +32,54 @@ print_usage (); endif - if (!isscalar (x) && !isscalar (p)) + if (!isscalar (p)) [retval, x, p] = common_size (x, p); if (retval > 0) - error ("geoinv: X and P must be of common size or scalar"); + error ("geoinv: X and P must be of common size or scalars"); endif endif - inv = zeros (size (x)); - - k = find (!(x >= 0) | !(x <= 1) | !(p >= 0) | !(p <= 1)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (p)) + error ("geoinv: X and P must not be complex"); endif - k = find ((x == 1) & (p >= 0) & (p <= 1)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (p, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & (p > 0) & (p <= 1)); - if (any (k)) - if (isscalar (x)) - inv(k) = max (ceil (log (1 - x) ./ log (1 - p(k))) - 1, 0); - elseif (isscalar (p)) - inv(k) = max (ceil (log (1 - x(k)) / log (1 - p)) - 1, 0); - else - inv(k) = max (ceil (log (1 - x(k)) ./ log (1 - p(k))) - 1, 0); - endif + k = (x == 1) & (p >= 0) & (p <= 1); + inv(k) = Inf; + + k = (x >= 0) & (x < 1) & (p > 0) & (p <= 1); + if (isscalar (p)) + inv(k) = max (ceil (log (1 - x(k)) / log (1 - p)) - 1, 0); + else + inv(k) = max (ceil (log (1 - x(k)) ./ log (1 - p(k))) - 1, 0); endif endfunction + + +%!shared x +%! x = [-1 0 0.75 1 2]; +%!assert(geoinv (x, 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(geoinv (x, 0.5), [NaN 0 1 Inf NaN]); +%!assert(geoinv (x, 0.5*[1 -1 NaN 4 1]), [NaN NaN NaN NaN NaN]); +%!assert(geoinv ([x(1:2) NaN x(4:5)], 0.5), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(geoinv ([x, NaN], 0.5), [NaN 0 1 Inf NaN NaN]); +%!assert(geoinv (single([x, NaN]), 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(geoinv ([x, NaN], single(0.5)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error geoinv () +%!error geoinv (1) +%!error geoinv (1,2,3) +%!error geoinv (ones(3),ones(2)) +%!error geoinv (ones(2),ones(3)) +%!error geoinv (i, 2) +%!error geoinv (2, i) +
--- a/scripts/statistics/distributions/geopdf.m +++ b/scripts/statistics/distributions/geopdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -31,35 +32,54 @@ print_usage (); endif - if (!isscalar (x) && !isscalar (p)) + if (!isscalar (p)) [retval, x, p] = common_size (x, p); if (retval > 0) - error ("geopdf: X and P must be of common size or scalar"); + error ("geopdf: X and P must be of common size or scalars"); endif endif - pdf = zeros (size (x)); - - k = find (isnan (x) | !(p >= 0) | !(p <= 1)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (p)) + error ("geopdf: X and P must not be complex"); endif - ## Just for the fun of it ... - k = find ((x == Inf) & (p == 0)); - if (any (k)) - pdf(k) = 1; + if (isa (x, "single") || isa (p, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (p > 0) & (p <= 1)); - if (any (k)) - if (isscalar (x)) - pdf(k) = p(k) .* ((1 - p(k)) .^ x); - elseif (isscalar (p)) - pdf(k) = p .* ((1 - p) .^ x(k)); - else - pdf(k) = p(k) .* ((1 - p(k)) .^ x(k)); - endif + k = isnan (x) | (x == Inf) | !(p >= 0) | !(p <= 1); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (p > 0) & (p <= 1); + if (isscalar (p)) + pdf(k) = p * ((1 - p) .^ x(k)); + else + pdf(k) = p(k) .* ((1 - p(k)) .^ x(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 Inf]; +%! y = [0, 1/2, 1/4, NaN]; +%!assert(geopdf (x, 0.5*ones(1,4)), y); +%!assert(geopdf (x, 0.5), y); +%!assert(geopdf (x, 0.5*[-1 NaN 4 1]), [NaN NaN NaN y(4)]); +%!assert(geopdf ([x, NaN], 0.5), [y, NaN]); + +%% Test class of input preserved +%!assert(geopdf (single([x, NaN]), 0.5), single([y, NaN]), 5*eps("single")); +%!assert(geopdf ([x, NaN], single(0.5)), single([y, NaN]), 5*eps("single")); + +%% Test input validation +%!error geopdf () +%!error geopdf (1) +%!error geopdf (1,2,3) +%!error geopdf (ones(3),ones(2)) +%!error geopdf (ones(2),ones(3)) +%!error geopdf (i, 2) +%!error geopdf (2, i) +
--- a/scripts/statistics/distributions/geornd.m +++ b/scripts/statistics/distributions/geornd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,77 +18,108 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} geornd (@var{p}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} geornd (@var{p}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the -## geometric distribution with parameter @var{p}, which must be a scalar -## or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} geornd (@var{p}) +## @deftypefnx {Function File} {} geornd (@var{p}, @var{r}) +## @deftypefnx {Function File} {} geornd (@var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} geornd (@var{p}, [@var{sz}]) +## Return a matrix of random samples from the geometric distribution with +## parameter @var{p}. ## -## If @var{r} and @var{c} are given create a matrix with @var{r} rows and -## @var{c} columns. Or if @var{sz} is a vector, create a matrix of size -## @var{sz}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the geometric distribution -function rnd = geornd (p, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("geornd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("geornd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = geornd (p, varargin) - if (any (size (p) != 1) - && ((length (size (p)) != length (sz)) || any (size (p) != sz))) - error ("geornd: P must be scalar or of size [R, C]"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("geornd: R must be a positive integer or vector"); - endif - - if (any (size (p) != 1) - && ((length (size (p)) != length (sz)) || any (size (p) != sz))) - error ("geornd: n must be scalar or of size SZ"); - endif - elseif (nargin == 1) - sz = size(p); - elseif (nargin != 1) + if (nargin < 1) print_usage (); endif + if (nargin == 1) + sz = size (p); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("geornd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("geornd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (p) && !isequal (size (p), sz)) + error ("geornd: P must be scalar or of size SZ"); + endif + + if (iscomplex (p)) + error ("geornd: P must not be complex"); + endif + + if (isa (p, "single")) + cls = "single"; + else + cls = "double"; + endif if (isscalar (p)) - if (p < 0 || p > 1) - rnd = NaN (sz); + if (p > 0 && p < 1); + rnd = floor (- rande (sz) ./ log (1 - p)); elseif (p == 0) - rnd = Inf (sz); - elseif (p > 0 && p < 1); - rnd = floor (- rande(sz) ./ log (1 - p)); - else - rnd = zeros (sz); + rnd = Inf (sz, cls); + elseif (p == 1) + rnd = zeros (sz, cls); + elseif (p < 0 || p > 1) + rnd = NaN (sz, cls); endif else - rnd = floor (- rande(sz) ./ log (1 - p)); + rnd = floor (- rande (sz) ./ log (1 - p)); - k = find (!(p >= 0) | !(p <= 1)); - if (any (k)) - rnd(k) = NaN (1, length (k)); - endif + k = !(p >= 0) | !(p <= 1); + rnd(k) = NaN; - k = find (p == 0); - if (any (k)) - rnd(k) = Inf (1, length (k)); - endif + k = (p == 0); + rnd(k) = Inf; endif endfunction + + +%!assert(size (geornd (0.5)), [1, 1]); +%!assert(size (geornd (0.5*ones(2,1))), [2, 1]); +%!assert(size (geornd (0.5*ones(2,2))), [2, 2]); +%!assert(size (geornd (0.5, 3)), [3, 3]); +%!assert(size (geornd (0.5, [4 1])), [4, 1]); +%!assert(size (geornd (0.5, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (geornd (0.5)), "double"); +%!assert(class (geornd (single(0.5))), "single"); +%!assert(class (geornd (single([0.5 0.5]))), "single"); +%!assert(class (geornd (single(0))), "single"); +%!assert(class (geornd (single(1))), "single"); + +%% Test input validation +%!error geornd () +%!error geornd (ones(3),ones(2)) +%!error geornd (ones(2),ones(3)) +%!error geornd (i) +%!error geornd (1, -1) +%!error geornd (1, ones(2)) +%!error geornd (1, [2 -1 2]) +%!error geornd (ones(2,2), 2, 3) +%!error geornd (ones(2,2), 3, 2) +
--- a/scripts/statistics/distributions/hygecdf.m +++ b/scripts/statistics/distributions/hygecdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1997-2011 Kurt Hornik ## ## This file is part of Octave. @@ -25,7 +26,7 @@ ## replacement from a population of total size @var{t} containing ## @var{m} marked items. ## -## The parameters @var{t}, @var{m}, and @var{n} must positive integers +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers ## with @var{m} and @var{n} not greater than @var{t}. ## @end deftypefn @@ -39,14 +40,70 @@ endif if (!isscalar (t) || !isscalar (m) || !isscalar (n)) - error ("hygecdf: T, M and N must all be positive integers"); + [retval, x, t, m, n] = common_size (x, t, m, n); + if (retval > 0) + error ("hygecdf: X, T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygecdf: X, T, M, and N must not be complex"); endif - if (t < 0 || m < 0 || n <= 0 || t != round (t) || m != round (m) - || n != round (n) || m > t || n > t) + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + cdf = NaN (size (x), "single"); + else cdf = NaN (size (x)); + endif + + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + cdf = discrete_cdf (x, 0 : n, hygepdf (0 : n, t, m, n)); + endif else - cdf = discrete_cdf (x, 0 : n, hygepdf (0 : n, t, m, n)); + for i = find (ok(:)') # Must be row vector arg to for loop + v = 0 : n(i); + cdf(i) = discrete_cdf (x(i), v, hygepdf (v, t(i), m(i), n(i))); + endfor endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/6 5/6 1 1]; +%!assert(hygecdf (x, 4*ones(1,5), 2, 2), y, eps); +%!assert(hygecdf (x, 4, 2*ones(1,5), 2), y, eps); +%!assert(hygecdf (x, 4, 2, 2*ones(1,5)), y, eps); +%!assert(hygecdf (x, 4*[1 -1 NaN 1.1 1], 2, 2), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 2*[1 -1 NaN 1.1 1], 2), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygecdf (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygecdf ([x(1:2) NaN x(4:5)], 4, 2, 2), [y(1:2) NaN y(4:5)], eps); + +%% Test class of input preserved +%!assert(hygecdf ([x, NaN], 4, 2, 2), [y, NaN], eps); +%!assert(hygecdf (single([x, NaN]), 4, 2, 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], single(4), 2, 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], 4, single(2), 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], 4, 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error hygecdf () +%!error hygecdf (1) +%!error hygecdf (1,2) +%!error hygecdf (1,2,3) +%!error hygecdf (1,2,3,4,5) +%!error hygecdf (ones(2), ones(3), 1, 1) +%!error hygecdf (1, ones(2), ones(3), 1) +%!error hygecdf (1, 1, ones(2), ones(3)) +%!error hygecdf (i, 2, 2, 2) +%!error hygecdf (2, i, 2, 2) +%!error hygecdf (2, 2, i, 2) +%!error hygecdf (2, 2, 2, i) +
--- a/scripts/statistics/distributions/hygeinv.m +++ b/scripts/statistics/distributions/hygeinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1997-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,11 +19,14 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} hygeinv (@var{x}, @var{t}, @var{m}, @var{n}) -## For each element of @var{x}, compute the quantile at @var{x} of the -## hypergeometric distribution with parameters @var{t}, @var{m}, and -## @var{n}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the hypergeometric distribution with parameters +## @var{t}, @var{m}, and @var{n}. This is the probability of obtaining @var{x} +## marked items when randomly drawing a sample of size @var{n} without +## replacement from a population of total size @var{t} containing @var{m} +## marked items. ## -## The parameters @var{t}, @var{m}, and @var{n} must positive integers +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers ## with @var{m} and @var{n} not greater than @var{t}. ## @end deftypefn @@ -36,14 +40,75 @@ endif if (!isscalar (t) || !isscalar (m) || !isscalar (n)) - error ("hygeinv: T, M and N must all be positive integers"); + [retval, x, t, m, n] = common_size (x, t, m, n); + if (retval > 0) + error ("hygeinv: X, T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygeinv: X, T, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - if (t < 0 || m < 0 || n <= 0 || t != round (t) || m != round (m) - || n != round (n) || m > t || n > t) - inv = NaN (size (x)); + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + inv = discrete_inv (x, 0 : n, hygepdf (0 : n, t, m, n)); + inv(x == 0) = 0; # Hack to return correct value for start of distribution + endif else - inv = discrete_inv (x, 0 : n, hygepdf (0 : n, t, m, n)); + for i = find (ok(:)') # Must be row vector arg to for loop + v = 0 : n(i); + if (x(i) == 0) + inv(i) = 0; # Hack to return correct value for start of distribution + else + inv(i) = discrete_inv (x(i), v, hygepdf (v, t(i), m(i), n(i))); + endif + endfor endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(hygeinv (x, 4*ones(1,5), 2*ones(1,5), 2*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4*ones(1,5), 2, 2), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4, 2*ones(1,5), 2), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4, 2, 2*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4*[1 -1 NaN 1.1 1], 2, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2*[1 -1 NaN 1.1 1], 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv ([x(1:2) NaN x(4:5)], 4, 2, 2), [NaN 0 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(hygeinv ([x, NaN], 4, 2, 2), [NaN 0 1 2 NaN NaN]); +%!assert(hygeinv (single([x, NaN]), 4, 2, 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], single(4), 2, 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], 4, single(2), 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], 4, 2, single(2)), single([NaN 0 1 2 NaN NaN])); + +%% Test input validation +%!error hygeinv () +%!error hygeinv (1) +%!error hygeinv (1,2) +%!error hygeinv (1,2,3) +%!error hygeinv (1,2,3,4,5) +%!error hygeinv (ones(2), ones(3), 1, 1) +%!error hygeinv (1, ones(2), ones(3), 1) +%!error hygeinv (1, 1, ones(2), ones(3)) +%!error hygeinv (i, 2, 2, 2) +%!error hygeinv (2, i, 2, 2) +%!error hygeinv (2, 2, i, 2) +%!error hygeinv (2, 2, 2, i) +
--- a/scripts/statistics/distributions/hygepdf.m +++ b/scripts/statistics/distributions/hygepdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1996-2011 Kurt Hornik ## ## This file is part of Octave. @@ -24,7 +25,8 @@ ## when randomly drawing a sample of size @var{n} without replacement ## from a population of total size @var{t} containing @var{m} marked items. ## -## The arguments must be of common size or scalar. +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers +## with @var{m} and @var{n} not greater than @var{t}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -39,34 +41,72 @@ if (!isscalar (t) || !isscalar (m) || !isscalar (n)) [retval, x, t, m, n] = common_size (x, t, m, n); if (retval > 0) - error ("hygepdf: X, T, M, and N must be of common size or scalar"); + error ("hygepdf: X, T, M, and N must be of common size or scalars"); endif endif - pdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygepdf: X, T, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif - ## everything in i1 gives NaN - i1 = ((t < 0) | (m < 0) | (n <= 0) | (t != round (t)) | - (m != round (m)) | (n != round (n)) | (m > t) | (n > t)); - ## everything in i2 gives 0 unless in i1 - i2 = ((x != round (x)) | (x < 0) | (x > m) | (n < x) | (n-x > t-m)); - k = find (i1); - if (any (k)) + ## everything in nel gives NaN + nel = (isnan (x) | (t < 0) | (m < 0) | (n <= 0) | (m > t) | (n > t) | + (t != fix (t)) | (m != fix (m)) | (n != fix (n))); + ## everything in zel gives 0 unless in nel + zel = ((x != fix (x)) | (x < 0) | (x > m) | (n < x) | (n-x > t-m)); + + pdf(nel) = NaN; + + k = !nel & !zel; + if (any (k(:))) if (isscalar (t) && isscalar (m) && isscalar (n)) - pdf = NaN (size (x)); + pdf(k) = (bincoeff (m, x(k)) .* bincoeff (t-m, n-x(k)) + / bincoeff (t, n)); else - pdf (k) = NaN; - endif - endif - k = find (!i1 & !i2); - if (any (k)) - if (isscalar (t) && isscalar (m) && isscalar (n)) - pdf (k) = (bincoeff (m, x(k)) .* bincoeff (t-m, n-x(k)) - / bincoeff (t, n)); - else - pdf (k) = (bincoeff (m(k), x(k)) .* bincoeff (t(k)-m(k), n(k)-x(k)) - ./ bincoeff (t(k), n(k))); + pdf(k) = (bincoeff (m(k), x(k)) .* bincoeff (t(k)-m(k), n(k)-x(k)) + ./ bincoeff (t(k), n(k))); endif endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/6 4/6 1/6 0]; +%!assert(hygepdf (x, 4*ones(1,5), 2, 2), y); +%!assert(hygepdf (x, 4, 2*ones(1,5), 2), y); +%!assert(hygepdf (x, 4, 2, 2*ones(1,5)), y); +%!assert(hygepdf (x, 4*[1 -1 NaN 1.1 1], 2, 2), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 2*[1 -1 NaN 1.1 1], 2), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygepdf (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygepdf ([x, NaN], 4, 2, 2), [y, NaN], eps); + +%% Test class of input preserved +%!assert(hygepdf (single([x, NaN]), 4, 2, 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], single(4), 2, 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], 4, single(2), 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], 4, 2, single(2)), single([y, NaN])); + +%% Test input validation +%!error hygepdf () +%!error hygepdf (1) +%!error hygepdf (1,2) +%!error hygepdf (1,2,3) +%!error hygepdf (1,2,3,4,5) +%!error hygepdf (1, ones(3),ones(2),ones(2)) +%!error hygepdf (1, ones(2),ones(3),ones(2)) +%!error hygepdf (1, ones(2),ones(2),ones(3)) +%!error hygepdf (i, 2, 2, 2) +%!error hygepdf (2, i, 2, 2) +%!error hygepdf (2, 2, i, 2) +%!error hygepdf (2, 2, 2, i) +
--- a/scripts/statistics/distributions/hygernd.m +++ b/scripts/statistics/distributions/hygernd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1997-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,81 +18,131 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{sz}) -## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}) -## Return an @var{r} by @var{c} matrix of random samples from the -## hypergeometric distribution with parameters @var{t}, @var{m}, -## and @var{n}. +## @deftypefn {Function File} {} hygernd (@var{t}, @var{m}, @var{n}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{r}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, [@var{sz}]) +## Return a matrix of random samples from the hypergeometric distribution +## with parameters @var{t}, @var{m}, and @var{n}. ## -## The parameters @var{t}, @var{m}, and @var{n} must positive integers +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers ## with @var{m} and @var{n} not greater than @var{t}. ## -## The parameter @var{sz} must be scalar or a vector of matrix -## dimensions. If @var{sz} is scalar, then a @var{sz} by @var{sz} -## matrix of random samples is generated. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{t}, @var{m}, and @var{n}. ## @end deftypefn -function rnd = hygernd (t, m, n, r, c) +function rnd = hygernd (t, m, n, varargin) - if (nargin == 5) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("hygernd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("hygernd: C must be a positive integer"); - endif - sz = [r, c]; - elseif (nargin == 4) - if (isvector (r) && all (r > 0) && all (r == round (r))) - if (isscalar (r)) - sz = [r, r]; - else - sz = r(:)'; - endif - else - error ("hygernd: R must be a vector of positive integers"); - endif - elseif (nargin != 3) + if (nargin < 3) print_usage (); endif if (! isscalar (t) || ! isscalar (m) || ! isscalar (n)) [retval, t, m, n] = common_size (t, m, n); if (retval > 0) - error ("hygernd: T, M and N must be of common size or scalar"); + error ("hygernd: T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygernd: T, M, and N must not be complex"); + endif + + if (nargin == 3) + sz = size (t); + elseif (nargin == 4) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("hygernd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 4) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("hygernd: dimensions must be non-negative integers"); endif - if (nargin > 3) - if (any (sz != size (t))) - error ("hygernd: T, M and N must have the same size as implied by R and C or must be scalar"); + sz = [varargin{:}]; + endif + + if (!isscalar (t) && !isequal (size (t), sz)) + error ("hygernd: T, M, and N must be scalar or of size SZ"); + endif + + if (isa (t, "single") || isa (m, "single") || isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + v = 0:n; + p = hygepdf (v, t, m, n); + rnd = v(lookup (cumsum (p(1:end-1)) / sum (p), rand (sz)) + 1); + rnd = reshape (rnd, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); endif else - sz = size (t); + rnd = NaN (sz, cls); endif - elseif (nargin == 3) - sz = 1; - endif - - ## NaN elements - ne = (! (t >= 0) | ! (m >= 0) | ! (n > 0) | ! (t == round (t)) | ! (m == round (m)) | ! (n == round (n)) | ! (m <= t) | ! (n <= t)); - - if (! isscalar (t)) - rnd = zeros (sz); - rnd(ne) = NaN; + else + rnd = NaN (sz, cls); rn = rand (sz); - for i = find (! ne) + for i = find (ok(:)') # Must be row vector arg to for loop v = 0 : n(i); p = hygepdf (v, t(i), m(i), n(i)); rnd(i) = v(lookup (cumsum (p(1 : end-1)) / sum (p), rn(i)) + 1); endfor - else - if (ne) - rnd = NaN (sz); - else - v = 0:n; - p = hygepdf (v, t, m, n); - rnd = v(lookup (cumsum (p(1:end-1)) / sum (p), rand (sz)) + 1); - endif endif endfunction + + +%!assert(size (hygernd (4,2,2)), [1, 1]); +%!assert(size (hygernd (4*ones(2,1), 2,2)), [2, 1]); +%!assert(size (hygernd (4*ones(2,2), 2,2)), [2, 2]); +%!assert(size (hygernd (4, 2*ones(2,1), 2)), [2, 1]); +%!assert(size (hygernd (4, 2*ones(2,2), 2)), [2, 2]); +%!assert(size (hygernd (4, 2, 2*ones(2,1))), [2, 1]); +%!assert(size (hygernd (4, 2, 2*ones(2,2))), [2, 2]); +%!assert(size (hygernd (4, 2, 2, 3)), [3, 3]); +%!assert(size (hygernd (4, 2, 2, [4 1])), [4, 1]); +%!assert(size (hygernd (4, 2, 2, 4, 1)), [4, 1]); + +%!assert(class (hygernd (4,2,2)), "double"); +%!assert(class (hygernd (single(4),2,2)), "single"); +%!assert(class (hygernd (single([4 4]),2,2)), "single"); +%!assert(class (hygernd (4,single(2),2)), "single"); +%!assert(class (hygernd (4,single([2 2]),2)), "single"); +%!assert(class (hygernd (4,2,single(2))), "single"); +%!assert(class (hygernd (4,2,single([2 2]))), "single"); + +%% Test input validation +%!error hygernd () +%!error hygernd (1) +%!error hygernd (1,2) +%!error hygernd (ones(3),ones(2),ones(2), 2) +%!error hygernd (ones(2),ones(3),ones(2), 2) +%!error hygernd (ones(2),ones(2),ones(3), 2) +%!error hygernd (i, 2, 2) +%!error hygernd (2, i, 2) +%!error hygernd (2, 2, i) +%!error hygernd (4,2,2, -1) +%!error hygernd (4,2,2, ones(2)) +%!error hygernd (4,2,2, [2 -1 2]) +%!error hygernd (4*ones(2),2,2, 3) +%!error hygernd (4*ones(2),2,2, [3, 2]) +%!error hygernd (4*ones(2),2,2, 3, 2) +
--- a/scripts/statistics/distributions/kolmogorov_smirnov_cdf.m +++ b/scripts/statistics/distributions/kolmogorov_smirnov_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,16 +19,17 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} kolmogorov_smirnov_cdf (@var{x}, @var{tol}) -## Return the CDF at @var{x} of the Kolmogorov-Smirnov distribution, +## Return the cumulative distribution function (CDF) at @var{x} of the +## Kolmogorov-Smirnov distribution, ## @tex -## $$ Q(x) = \sum_{k=-\infty}^\infty (-1)^k \exp(-2 k^2 x^2) $$ +## $$ Q(x) = \sum_{k=-\infty}^\infty (-1)^k \exp (-2 k^2 x^2) $$ ## @end tex ## @ifnottex ## ## @example ## @group ## Inf -## Q(x) = SUM (-1)^k exp(-2 k^2 x^2) +## Q(x) = SUM (-1)^k exp (-2 k^2 x^2) ## k = -Inf ## @end group ## @end example @@ -61,8 +63,7 @@ endif endif - n = numel (x); - if (n == 0) + if (numel (x) == 0) error ("kolmogorov_smirnov_cdf: X must not be empty"); endif @@ -70,10 +71,10 @@ ind = find (x > 0); if (length (ind) > 0) - if (size(ind,2) < size(ind,1)) + if (columns (ind) < rows (ind)) y = x(ind.'); else - y = x(ind); + y = x(ind); endif K = ceil (sqrt (- log (tol) / 2) / min (y)); k = (1:K)'; @@ -84,3 +85,11 @@ endif endfunction + + +%% Test input validation +%!error kolmogorov_smirnov_cdf () +%!error kolmogorov_smirnov_cdf (1,2,3) +%!error kolmogorov_smirnov_cdf (1, ones(2)) +%!error kolmogorov_smirnov_cdf ([], 1) +
--- a/scripts/statistics/distributions/laplace_cdf.m +++ b/scripts/statistics/distributions/laplace_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -31,21 +32,25 @@ print_usage (); endif - cdf = zeros (size (x)); - - k = find (isnan (x)); - if (any (k)) - cdf(k) = NaN; + if (iscomplex (x)) + error ("laplace_cdf: X must not be complex"); endif - k = find (x == Inf); - if (any (k)) - cdf(k) = 1; - endif - - k = find ((x > -Inf) & (x < Inf)); - if (any (k)) - cdf(k) = (1 + sign (x(k)) .* (1 - exp (- abs (x(k))))) / 2; - endif + cdf = (1 + sign (x) .* (1 - exp (- abs (x)))) / 2; endfunction + + +%!shared x,y +%! x = [-Inf -log(2) 0 log(2) Inf]; +%! y = [0, 1/4, 1/2, 3/4, 1]; +%!assert(laplace_cdf ([x, NaN]), [y, NaN]); + +%% Test class of input preserved +%!assert(laplace_cdf (single([x, NaN])), single([y, NaN])); + +%% Test input validation +%!error laplace_cdf () +%!error laplace_cdf (1,2) +%!error laplace_cdf (i) +
--- a/scripts/statistics/distributions/laplace_inv.m +++ b/scripts/statistics/distributions/laplace_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -31,22 +32,33 @@ print_usage (); endif - inv = -Inf (size (x)); + if (iscomplex (x)) + error ("laplace_inv: X must not be complex"); + endif - k = find (isnan (x) | (x < 0) | (x > 1)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find (x == 1); - if (any (k)) - inv(k) = Inf; - endif - - k = find ((x > 0) & (x < 1)); - if (any (k)) - inv(k) = ((x(k) < 1/2) .* log (2 * x(k)) - - (x(k) > 1/2) .* log (2 * (1 - x(k)))); - endif + k = (x >= 0) & (x <= 1); + inv(k) = ((x(k) < 1/2) .* log (2 * x(k)) + - (x(k) > 1/2) .* log (2 * (1 - x(k)))); endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(laplace_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(laplace_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(laplace_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error laplace_inv () +%!error laplace_inv (1,2) +%!error laplace_inv (i) +
--- a/scripts/statistics/distributions/laplace_pdf.m +++ b/scripts/statistics/distributions/laplace_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -30,17 +31,26 @@ if (nargin != 1) print_usage (); endif - - pdf = zeros (size (x)); - - k = find (isnan (x)); - if (any (k)) - pdf(k) = NaN; + + if (iscomplex (x)) + error ("laplace_pdf: X must not be complex"); endif - k = find ((x > -Inf) & (x < Inf)); - if (any (k)) - pdf(k) = exp (- abs (x(k))) / 2; - endif + pdf = exp (- abs (x)) / 2; endfunction + + +%!shared x,y +%! x = [-Inf -log(2) 0 log(2) Inf]; +%! y = [0, 1/4, 1/2, 1/4, 0]; +%!assert(laplace_pdf ([x, NaN]), [y, NaN]); + +%% Test class of input preserved +%!assert(laplace_pdf (single([x, NaN])), single([y, NaN])); + +%% Test input validation +%!error laplace_pdf () +%!error laplace_pdf (1,2) +%!error laplace_pdf (i) +
--- a/scripts/statistics/distributions/laplace_rnd.m +++ b/scripts/statistics/distributions/laplace_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,40 +18,57 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} laplace_rnd (@var{r}, @var{c}) -## @deftypefnx {Function File} {} laplace_rnd (@var{sz}); -## Return an @var{r} by @var{c} matrix of random numbers from the -## Laplace distribution. Or if @var{sz} is a vector, create a matrix of -## @var{sz}. +## @deftypefn {Function File} {} laplace_rnd (@var{r}) +## @deftypefnx {Function File} {} laplace_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} laplace_rnd ([@var{sz}]) +## Return a matrix of random samples from the Laplace distribution. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Laplace distribution -function rnd = laplace_rnd (r, c) +function rnd = laplace_rnd (varargin) - if (nargin == 2) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("laplace_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("laplace_rnd: C must be a positive integer"); - endif - sz = [r, c]; - elseif (nargin == 1) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("laplace_rnd: R must be a positive integer or vector"); - endif - else + if (nargin < 1) print_usage (); endif + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}(:)'; + else + error ("laplace_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("laplace_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + tmp = rand (sz); - rnd = ((tmp < 1/2) .* log (2 * tmp) - - (tmp > 1/2) .* log (2 * (1 - tmp))); + rnd = (tmp < 1/2) .* log (2 * tmp) - (tmp > 1/2) .* log (2 * (1 - tmp)); endfunction + + +%!assert(size (laplace_rnd (3)), [3, 3]); +%!assert(size (laplace_rnd ([4 1])), [4, 1]); +%!assert(size (laplace_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error laplace_rnd () +%!error laplace_rnd (-1) +%!error laplace_rnd (ones(2)) +%!error laplace_rnd ([2 -1 2]) +%!error laplace_rnd (1, ones(2)) +%!error laplace_rnd (1, -1) +
--- a/scripts/statistics/distributions/logistic_cdf.m +++ b/scripts/statistics/distributions/logistic_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} logistic_cdf (@var{x}) -## For each component of @var{x}, compute the CDF at @var{x} of the -## logistic distribution. +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the logistic distribution. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,6 +32,25 @@ print_usage (); endif - cdf = 1 ./ (1 + exp (- x)); + if (iscomplex (x)) + error ("logistic_cdf: X must not be complex"); + endif + + cdf = 1 ./ (1 + exp (-x)); endfunction + + +%!shared x,y +%! x = [-Inf -log(3) 0 log(3) Inf]; +%! y = [0, 1/4, 1/2, 3/4, 1]; +%!assert(logistic_cdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(logistic_cdf (single([x, NaN])), single([y, NaN]), eps ("single")); + +%% Test input validation +%!error logistic_cdf () +%!error logistic_cdf (1,2) +%!error logistic_cdf (i) +
--- a/scripts/statistics/distributions/logistic_inv.m +++ b/scripts/statistics/distributions/logistic_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} logistic_inv (@var{x}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the logistic distribution. ## @end deftypefn @@ -31,26 +32,38 @@ print_usage (); endif - inv = zeros (size (x)); - - k = find ((x < 0) | (x > 1) | isnan (x)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x)) + error ("logistic_inv: X must not be complex"); endif - k = find (x == 0); - if (any (k)) - inv(k) = -Inf; + if (isa (x, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find (x == 1); - if (any (k)) - inv(k) = Inf; - endif + k = (x == 0); + inv(k) = -Inf; - k = find ((x > 0) & (x < 1)); - if (any (k)) - inv (k) = - log (1 ./ x(k) - 1); - endif + k = (x == 1); + inv(k) = Inf; + + k = (x > 0) & (x < 1); + inv(k) = - log (1 ./ x(k) - 1); endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(logistic_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(logistic_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(logistic_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error logistic_inv () +%!error logistic_inv (1,2) +%!error logistic_inv (i) +
--- a/scripts/statistics/distributions/logistic_pdf.m +++ b/scripts/statistics/distributions/logistic_pdf.m @@ -18,7 +18,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} logistic_pdf (@var{x}) -## For each component of @var{x}, compute the PDF at @var{x} of the +## For each element of @var{x}, compute the PDF at @var{x} of the ## logistic distribution. ## @end deftypefn @@ -31,7 +31,26 @@ print_usage (); endif + if (iscomplex (x)) + error ("logistic_pdf: X must not be complex"); + endif + cdf = logistic_cdf (x); pdf = cdf .* (1 - cdf); endfunction + + +%!shared x,y +%! x = [-Inf -log(4) 0 log(4) Inf]; +%! y = [0, 0.16, 1/4, 0.16, 0]; +%!assert(logistic_pdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(logistic_pdf (single([x, NaN])), single([y, NaN]), eps ("single")); + +%% Test input validation +%!error logistic_pdf () +%!error logistic_pdf (1,2) +%!error logistic_pdf (i) +
--- a/scripts/statistics/distributions/logistic_rnd.m +++ b/scripts/statistics/distributions/logistic_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,39 +18,56 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} logistic_rnd (@var{r}, @var{c}) -## @deftypefnx {Function File} {} logistic_rnd (@var{sz}) -## Return an @var{r} by @var{c} matrix of random numbers from the -## logistic distribution. Or if @var{sz} is a vector, create a matrix of -## @var{sz}. +## @deftypefn {Function File} {} logistic_rnd (@var{r}) +## @deftypefnx {Function File} {} logistic_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} logistic_rnd ([@var{sz}]) +## Return a matrix of random samples from the logistic distribution. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the logistic distribution -function rnd = logistic_rnd (r, c) +function rnd = logistic_rnd (varargin) + if (nargin < 1) + print_usage (); + endif - if (nargin == 2) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("logistic_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("logistic_rnd: C must be a positive integer"); + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("logistic_rnd: dimension vector must be row vector of non-negative integers"); endif - sz = [r, c]; - elseif (nargin == 1) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("logistic_rnd: R must be a positive integer or vector"); + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("logistic_rnd: dimensions must be non-negative integers"); endif - else - print_usage (); + sz = [varargin{:}]; endif rnd = - log (1 ./ rand (sz) - 1); endfunction + + +%!assert(size (logistic_rnd (3)), [3, 3]); +%!assert(size (logistic_rnd ([4 1])), [4, 1]); +%!assert(size (logistic_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error logistic_rnd () +%!error logistic_rnd (-1) +%!error logistic_rnd (ones(2)) +%!error logistic_rnd ([2 -1 2]) +%!error logistic_rnd (1, ones(2)) +%!error logistic_rnd (1, -1) +
--- a/scripts/statistics/distributions/logncdf.m +++ b/scripts/statistics/distributions/logncdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} logncdf (@var{x}, @var{mu}, @var{sigma}) +## @deftypefn {Function File} {} logncdf (@var{x}) +## @deftypefnx {Function File} {} logncdf (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the cumulative distribution ## function (CDF) at @var{x} of the lognormal distribution with ## parameters @var{mu} and @var{sigma}. If a random variable follows this @@ -30,48 +32,69 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: CDF of the log normal distribution -function cdf = logncdf (x, mu, sigma) +function cdf = logncdf (x, mu = 0, sigma = 1) - if (! ((nargin == 1) || (nargin == 3))) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - mu = 0; - sigma = 1; - endif - - ## The following "straightforward" implementation unfortunately does - ## not work (because exp (Inf) -> NaN etc): - ## cdf = normal_cdf (log (x), log (mu), sigma); - ## Hence ... - if (!isscalar (mu) || !isscalar (sigma)) [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("logncdf: X, MU and SIGMA must be of common size or scalars"); + error ("logncdf: X, MU, and SIGMA must be of common size or scalars"); endif endif - cdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("logncdf: X, MU, and SIGMA must not be complex"); + endif - k = find (isnan (x) | !(sigma > 0) | !(sigma < Inf)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(sigma > 0) | !(sigma < Inf); + cdf(k) = NaN; + + k = (x == Inf) & (sigma > 0) & (sigma < Inf); + cdf(k) = 1; - k = find ((x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - if (isscalar (mu) && isscalar (sigma)) - cdf(k) = stdnormal_cdf ((log (x(k)) - mu) / sigma); - else - cdf(k) = stdnormal_cdf ((log (x(k)) - mu(k)) ./ sigma(k)); - endif + k = (x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + cdf(k) = stdnormal_cdf ((log (x(k)) - mu) / sigma); + else + cdf(k) = stdnormal_cdf ((log (x(k)) - mu(k)) ./ sigma(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 e Inf]; +%! y = [0, 0, 0.5, 1/2+1/2*erf(1/2), 1]; +%!assert(logncdf (x, zeros(1,5), sqrt(2)*ones(1,5)), y); +%!assert(logncdf (x, 0, sqrt(2)*ones(1,5)), y); +%!assert(logncdf (x, zeros(1,5), sqrt(2)), y); +%!assert(logncdf (x, [0 1 NaN 0 1], sqrt(2)), [0 0 NaN y(4:5)]); +%!assert(logncdf (x, 0, sqrt(2)*[0 NaN Inf 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(logncdf ([x(1:3) NaN x(5)], 0, sqrt(2)), [y(1:3) NaN y(5)]); + +%% Test class of input preserved +%!assert(logncdf ([x, NaN], 0, sqrt(2)), [y, NaN]); +%!assert(logncdf (single([x, NaN]), 0, sqrt(2)), single([y, NaN]), eps("single")); +%!assert(logncdf ([x, NaN], single(0), sqrt(2)), single([y, NaN]), eps("single")); +%!assert(logncdf ([x, NaN], 0, single(sqrt(2))), single([y, NaN]), eps("single")); + +%% Test input validation +%!error logncdf () +%!error logncdf (1,2) +%!error logncdf (1,2,3,4) +%!error logncdf (ones(3),ones(2),ones(2)) +%!error logncdf (ones(2),ones(3),ones(2)) +%!error logncdf (ones(2),ones(2),ones(3)) +%!error logncdf (i, 2, 2) +%!error logncdf (2, i, 2) +%!error logncdf (2, 2, i) +
--- a/scripts/statistics/distributions/logninv.m +++ b/scripts/statistics/distributions/logninv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} logninv (@var{x}, @var{mu}, @var{sigma}) +## @deftypefn {Function File} {} logninv (@var{x}) +## @deftypefnx {Function File} {} logninv (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the quantile (the inverse of the ## CDF) at @var{x} of the lognormal distribution with parameters @var{mu} ## and @var{sigma}. If a random variable follows this distribution, its @@ -30,48 +32,68 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the log normal distribution -function inv = logninv (x, mu, sigma) +function inv = logninv (x, mu = 0, sigma = 1) - if (! ((nargin == 1) || (nargin == 3))) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - mu = 0; - sigma = 1; - endif - - ## The following "straightforward" implementation unfortunately does - ## not work (because exp (Inf) -> NaN): - ## inv = exp (norminv (x, mu, sigma)); - ## Hence ... - if (!isscalar (mu) || !isscalar (sigma)) [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("logninv: X, MU and SIGMA must be of common size or scalars"); + error ("logninv: X, MU, and SIGMA must be of common size or scalars"); endif endif - inv = zeros (size (x)); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("logninv: X, MU, and SIGMA must not be complex"); + endif - k = find (!(x >= 0) | !(x <= 1) | !(sigma > 0) | !(sigma < Inf)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x == 1) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - inv(k) = Inf; - endif + k = !(x >= 0) | !(x <= 1) | !(sigma > 0) | !(sigma < Inf); + inv(k) = NaN; + + k = (x == 1) & (sigma > 0) & (sigma < Inf); + inv(k) = Inf; - k = find ((x > 0) & (x < 1) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - if (isscalar (mu) && isscalar (sigma)) - inv(k) = exp (mu) .* exp (sigma .* stdnormal_inv (x(k))); - else - inv(k) = exp (mu(k)) .* exp (sigma(k) .* stdnormal_inv (x(k))); - endif + k = (x >= 0) & (x < 1) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + inv(k) = exp (mu) .* exp (sigma .* stdnormal_inv (x(k))); + else + inv(k) = exp (mu(k)) .* exp (sigma(k) .* stdnormal_inv (x(k))); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(logninv (x, ones(1,5), ones(1,5)), [NaN 0 e Inf NaN]); +%!assert(logninv (x, 1, ones(1,5)), [NaN 0 e Inf NaN]); +%!assert(logninv (x, ones(1,5), 1), [NaN 0 e Inf NaN]); +%!assert(logninv (x, [1 1 NaN 0 1], 1), [NaN 0 NaN Inf NaN]); +%!assert(logninv (x, 1, [1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(logninv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(logninv ([x, NaN], 1, 1), [NaN 0 e Inf NaN NaN]); +%!assert(logninv (single([x, NaN]), 1, 1), single([NaN 0 e Inf NaN NaN])); +%!assert(logninv ([x, NaN], single(1), 1), single([NaN 0 e Inf NaN NaN])); +%!assert(logninv ([x, NaN], 1, single(1)), single([NaN 0 e Inf NaN NaN])); + +%% Test input validation +%!error logninv () +%!error logninv (1,2) +%!error logninv (1,2,3,4) +%!error logninv (ones(3),ones(2),ones(2)) +%!error logninv (ones(2),ones(3),ones(2)) +%!error logninv (ones(2),ones(2),ones(3)) +%!error logninv (i, 2, 2) +%!error logninv (2, i, 2) +%!error logninv (2, 2, i) +
--- a/scripts/statistics/distributions/lognpdf.m +++ b/scripts/statistics/distributions/lognpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} lognpdf (@var{x}, @var{mu}, @var{sigma}) +## @deftypefn {Function File} {} lognpdf (@var{x}) +## @deftypefnx {Function File} {} lognpdf (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the probability density function ## (PDF) at @var{x} of the lognormal distribution with parameters ## @var{mu} and @var{sigma}. If a random variable follows this distribution, @@ -30,43 +32,65 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: PDF of the log normal distribution -function pdf = lognpdf (x, mu, sigma) +function pdf = lognpdf (x, mu = 0, sigma = 1) - if (! ((nargin == 1) || (nargin == 3))) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - mu = 0; - sigma = 1; - endif - - ## The following "straightforward" implementation unfortunately does - ## not work for the special cases (Inf, ...) - ## pdf = (x > 0) ./ x .* normpdf (log (x), mu, sigma); - ## Hence ... - if (!isscalar (mu) || !isscalar (sigma)) [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("lognpdf: X, MU and SIGMA must be of common size or scalars"); + error ("lognpdf: X, MU, and SIGMA must be of common size or scalars"); endif endif - pdf = zeros (size (x)); - - k = find (isnan (x) | !(sigma > 0) | !(sigma < Inf)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("lognpdf: X, MU, and SIGMA must not be complex"); endif - k = find ((x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf)); - if (any (k)) - if (isscalar (mu) && isscalar (sigma)) - pdf(k) = normpdf (log (x(k)), mu, sigma) ./ x(k); - else - pdf(k) = normpdf (log (x(k)), mu(k), sigma(k)) ./ x(k); - endif + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(sigma > 0) | !(sigma < Inf); + pdf(k) = NaN; + + k = (x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + pdf(k) = normpdf (log (x(k)), mu, sigma) ./ x(k); + else + pdf(k) = normpdf (log (x(k)), mu(k), sigma(k)) ./ x(k); endif endfunction + + +%!shared x,y +%! x = [-1 0 e Inf]; +%! y = [0, 0, 1/(e*sqrt(2*pi)) * exp(-1/2), 0]; +%!assert(lognpdf (x, zeros(1,4), ones(1,4)), y, eps); +%!assert(lognpdf (x, 0, ones(1,4)), y, eps); +%!assert(lognpdf (x, zeros(1,4), 1), y, eps); +%!assert(lognpdf (x, [0 1 NaN 0], 1), [0 0 NaN y(4)], eps); +%!assert(lognpdf (x, 0, [0 NaN Inf 1]), [NaN NaN NaN y(4)], eps); +%!assert(lognpdf ([x, NaN], 0, 1), [y, NaN], eps); + +%% Test class of input preserved +%!assert(lognpdf (single([x, NaN]), 0, 1), single([y, NaN]), eps("single")); +%!assert(lognpdf ([x, NaN], single(0), 1), single([y, NaN]), eps("single")); +%!assert(lognpdf ([x, NaN], 0, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error lognpdf () +%!error lognpdf (1,2) +%!error lognpdf (1,2,3,4) +%!error lognpdf (ones(3),ones(2),ones(2)) +%!error lognpdf (ones(2),ones(3),ones(2)) +%!error lognpdf (ones(2),ones(2),ones(3)) +%!error lognpdf (i, 2, 2) +%!error lognpdf (2, i, 2) +%!error lognpdf (2, 2, i) +
--- a/scripts/statistics/distributions/lognrnd.m +++ b/scripts/statistics/distributions/lognrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,76 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the -## lognormal distribution with parameters @var{mu} and @var{sigma}. Both -## @var{mu} and @var{sigma} must be scalar or of size @var{r} by @var{c}. -## Or if @var{sz} is a vector, create a matrix of size @var{sz}. +## @deftypefn {Function File} {} lognrnd (@var{mu}, @var{sigma}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{r}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, [@var{sz}]) +## Return a matrix of random samples from the lognormal distribution with +## parameters @var{mu} and @var{sigma}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{mu} and @var{sigma}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{mu} and @var{sigma}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the log normal distribution -function rnd = lognrnd (mu, sigma, r, c) +function rnd = lognrnd (mu, sigma, varargin) - if (nargin > 1) - if (!isscalar(mu) || !isscalar(sigma)) - [retval, mu, sigma] = common_size (mu, sigma); - if (retval > 0) - error ("lognrnd: MU and SIGMA must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, mu, sigma] = common_size (mu, sigma); + if (retval > 0) + error ("lognrnd: MU and SIGMA must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("lognrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("lognrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (mu) || iscomplex (sigma)) + error ("lognrnd: MU and SIGMA must not be complex"); + endif - if (any (size (mu) != 1) - && ((length (size (mu)) != length (sz)) || any (size (mu) != sz))) - error ("lognrnd: MU and SIGMA must be scalar or of size [R, C]"); - endif - + if (nargin == 2) + sz = size (mu); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("lognrnd: R must be a positive integer or vector"); + error ("lognrnd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("lognrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (mu) != 1) - && ((length (size (mu)) != length (sz)) || any (size (mu) != sz))) - error ("lognrnd: MU and SIGMA must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(mu); + if (!isscalar (mu) && !isequal (size (mu), sz)) + error ("lognrnd: MU and SIGMA must be scalar or of size SZ"); + endif + + if (isa (mu, "single") || isa (sigma, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (mu) && isscalar (sigma)) - if (!(sigma > 0) || !(sigma < Inf)) - rnd = NaN (sz); + if ((sigma > 0) && (sigma < Inf)) + rnd = exp (mu + sigma * randn (sz)); else - rnd = exp(mu + sigma .* randn (sz)); + rnd = NaN (sz, cls); endif else rnd = exp (mu + sigma .* randn (sz)); - k = find ((sigma < 0) | (sigma == Inf)); - if (any (k)) - rnd(k) = NaN; - endif + + k = (sigma < 0) | (sigma == Inf); + rnd(k) = NaN; endif endfunction + + +%!assert(size (lognrnd (1,2)), [1, 1]); +%!assert(size (lognrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (lognrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (lognrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (lognrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (lognrnd (1, 2, 3)), [3, 3]); +%!assert(size (lognrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (lognrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (lognrnd (1, 2)), "double"); +%!assert(class (lognrnd (single(1), 2)), "single"); +%!assert(class (lognrnd (single([1 1]), 2)), "single"); +%!assert(class (lognrnd (1, single(2))), "single"); +%!assert(class (lognrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error lognrnd () +%!error lognrnd (1) +%!error lognrnd (ones(3),ones(2)) +%!error lognrnd (ones(2),ones(3)) +%!error lognrnd (i, 2) +%!error lognrnd (2, i) +%!error lognrnd (1,2, -1) +%!error lognrnd (1,2, ones(2)) +%!error lognrnd (1, 2, [2 -1 2]) +%!error lognrnd (1,2, 1, ones(2)) +%!error lognrnd (1,2, 1, -1) +%!error lognrnd (ones(2,2), 2, 3) +%!error lognrnd (ones(2,2), 2, [3, 2]) +%!error lognrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/nbincdf.m +++ b/scripts/statistics/distributions/nbincdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,9 +19,13 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} nbincdf (@var{x}, @var{n}, @var{p}) -## For each element of @var{x}, compute the CDF at x of the Pascal -## (negative binomial) distribution with parameters @var{n} and @var{p}. +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the negative binomial distribution with +## parameters @var{n} and @var{p}. ## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## ## The number of failures in a Bernoulli experiment with success ## probability @var{p} before the @var{n}-th success follows this ## distribution. @@ -35,58 +40,66 @@ print_usage (); endif - if (!isscalar(n) || !isscalar(p)) + if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("nbincdf: X, N and P must be of common size or scalar"); + error ("nbincdf: X, N, and P must be of common size or scalars"); endif endif - cdf = zeros (size (x)); - - k = find (isnan (x) | (n < 1) | (n == Inf) | (n != round (n)) - | (p < 0) | (p > 1)); - if (any (k)) - cdf(k) = NaN; + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbincdf: X, N, and P must not be complex"); endif - k = find ((x == Inf) & (n > 0) & (n < Inf) & (n == round (n)) - & (p >= 0) & (p <= 1)); - if (any (k)) - cdf(k) = 1; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (n > 0) - & (n < Inf) & (n == round (n)) & (p > 0) & (p <= 1)); - if (any (k)) - ## Does anyone know a better way to do the summation? - m = zeros (size (k)); - x = floor (x(k)); - y = cdf(k); - if (isscalar (n) && isscalar (p)) - while (1) - l = find (m <= x); - if (any (l)) - y(l) = y(l) + nbinpdf (m(l), n, p); - m(l) = m(l) + 1; - else - break; - endif - endwhile - else - n = n(k); - p = p(k); - while (1) - l = find (m <= x); - if (any (l)) - y(l) = y(l) + nbinpdf (m(l), n(l), p(l)); - m(l) = m(l) + 1; - else - break; - endif - endwhile - endif - cdf(k) = y; + k = (isnan (x) | isnan (n) | (n < 1) | (n == Inf) + | (p < 0) | (p > 1) | isnan (p)); + cdf(k) = NaN; + + k = (x == Inf) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + cdf(k) = 1; + + k = ((x >= 0) & (x < Inf) & (x == fix (x)) + & (n > 0) & (n < Inf) & (p > 0) & (p <= 1)); + if (isscalar (n) && isscalar (p)) + cdf(k) = 1 - betainc (1-p, x(k)+1, n); + else + cdf(k) = 1 - betainc (1-p(k), x(k)+1, n(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0 1/2 3/4 7/8 1]; +%!assert(nbincdf (x, ones(1,5), 0.5*ones(1,5)), y); +%!assert(nbincdf (x, 1, 0.5*ones(1,5)), y); +%!assert(nbincdf (x, ones(1,5), 0.5), y); +%!assert(nbincdf ([x(1:3) 0 x(5)], [0 1 NaN 1.5 Inf], 0.5), [NaN 1/2 NaN nbinpdf(0,1.5,0.5) NaN], eps); +%!assert(nbincdf (x, 1, 0.5*[-1 NaN 4 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(nbincdf ([x(1:2) NaN x(4:5)], 1, 0.5), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(nbincdf ([x, NaN], 1, 0.5), [y, NaN]); +%!assert(nbincdf (single([x, NaN]), 1, 0.5), single([y, NaN])); +%!assert(nbincdf ([x, NaN], single(1), 0.5), single([y, NaN])); +%!assert(nbincdf ([x, NaN], 1, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error nbincdf () +%!error nbincdf (1) +%!error nbincdf (1,2) +%!error nbincdf (1,2,3,4) +%!error nbincdf (ones(3),ones(2),ones(2)) +%!error nbincdf (ones(2),ones(3),ones(2)) +%!error nbincdf (ones(2),ones(2),ones(3)) +%!error nbincdf (i, 2, 2) +%!error nbincdf (2, i, 2) +%!error nbincdf (2, 2, i) +
--- a/scripts/statistics/distributions/nbininv.m +++ b/scripts/statistics/distributions/nbininv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,10 +19,13 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} nbininv (@var{x}, @var{n}, @var{p}) -## For each element of @var{x}, compute the quantile at @var{x} of the -## Pascal (negative binomial) distribution with parameters @var{n} and -## @var{p}. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the negative binomial distribution +## with parameters @var{n} and @var{p}. ## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## ## The number of failures in a Bernoulli experiment with success ## probability @var{p} before the @var{n}-th success follows this ## distribution. @@ -36,58 +40,89 @@ print_usage (); endif - if (!isscalar(n) || !isscalar(p)) + if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("nbininv: X, N and P must be of common size or scalar"); + error ("nbininv: X, N, and P must be of common size or scalars"); endif endif - inv = zeros (size (x)); - - k = find (isnan (x) | (x < 0) | (x > 1) | (n < 1) | (n == Inf) - | (n != round (n)) | (p < 0) | (p > 1)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbininv: X, N, and P must not be complex"); endif - k = find ((x == 1) & (n > 0) & (n < Inf) & (n == round (n)) - & (p >= 0) & (p <= 1)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif + k = (isnan (x) | (x < 0) | (x > 1) | isnan (n) | (n < 1) | (n == Inf) + | isnan (p) | (p < 0) | (p > 1)); + inv(k) = NaN; + + k = (x == 1) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + inv(k) = Inf; + k = find ((x >= 0) & (x < 1) & (n > 0) & (n < Inf) - & (n == round (n)) & (p > 0) & (p <= 1)); - if (any (k)) - m = zeros (size (k)); - x = x(k); - if (isscalar (n) && isscalar (p)) - s = p ^ n * ones (size(k)); - while (1) - l = find (s < x); - if (any (l)) - m(l) = m(l) + 1; - s(l) = s(l) + nbinpdf (m(l), n, p); - else - break; - endif - endwhile - else - n = n(k); - p = p(k); - s = p .^ n; - while (1) - l = find (s < x); - if (any (l)) - m(l) = m(l) + 1; - s(l) = s(l) + nbinpdf (m(l), n(l), p(l)); - else - break; - endif - endwhile - endif - inv(k) = m; + & (p > 0) & (p <= 1)); + m = zeros (size (k)); + x = x(k); + if (isscalar (n) && isscalar (p)) + s = p ^ n * ones (size (k)); + while (1) + l = find (s < x); + if (any (l)) + m(l) = m(l) + 1; + s(l) = s(l) + nbinpdf (m(l), n, p); + else + break; + endif + endwhile + else + n = n(k); + p = p(k); + s = p .^ n; + while (1) + l = find (s < x); + if (any (l)) + m(l) = m(l) + 1; + s(l) = s(l) + nbinpdf (m(l), n(l), p(l)); + else + break; + endif + endwhile endif + inv(k) = m; endfunction + + +%!shared x +%! x = [-1 0 3/4 1 2]; +%!assert(nbininv (x, ones(1,5), 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, 1, 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, ones(1,5), 0.5), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, [1 0 NaN Inf 1], 0.5), [NaN NaN NaN NaN NaN]); +%!assert(nbininv (x, [1 0 1.5 Inf 1], 0.5), [NaN NaN 2 NaN NaN]); +%!assert(nbininv (x, 1, 0.5*[1 -Inf NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(nbininv ([x(1:2) NaN x(4:5)], 1, 0.5), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(nbininv ([x, NaN], 1, 0.5), [NaN 0 1 Inf NaN NaN]); +%!assert(nbininv (single([x, NaN]), 1, 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(nbininv ([x, NaN], single(1), 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(nbininv ([x, NaN], 1, single(0.5)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error nbininv () +%!error nbininv (1) +%!error nbininv (1,2) +%!error nbininv (1,2,3,4) +%!error nbininv (ones(3),ones(2),ones(2)) +%!error nbininv (ones(2),ones(3),ones(2)) +%!error nbininv (ones(2),ones(2),ones(3)) +%!error nbininv (i, 2, 2) +%!error nbininv (2, i, 2) +%!error nbininv (2, 2, i) +
--- a/scripts/statistics/distributions/nbinpdf.m +++ b/scripts/statistics/distributions/nbinpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,9 +20,12 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} nbinpdf (@var{x}, @var{n}, @var{p}) ## For each element of @var{x}, compute the probability density function -## (PDF) at @var{x} of the Pascal (negative binomial) distribution with +## (PDF) at @var{x} of the negative binomial distribution with ## parameters @var{n} and @var{p}. ## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## ## The number of failures in a Bernoulli experiment with success ## probability @var{p} before the @var{n}-th success follows this ## distribution. @@ -36,36 +40,63 @@ print_usage (); endif - if (!isscalar(n) || !isscalar(p)) + if (!isscalar (n) || !isscalar (p)) [retval, x, n, p] = common_size (x, n, p); if (retval > 0) - error ("nbinpdf: X, N and P must be of common size or scalar"); + error ("nbinpdf: X, N, and P must be of common size or scalars"); endif endif - pdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbinpdf: X, N, and P must not be complex"); + endif - k = find (isnan (x) | (n < 1) | (n == Inf) | (n != round (n)) - | (p < 0) | (p > 1)); - if (any (k)) - pdf(k) = NaN; + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); endif - ## Just for the fun of it ... - k = find ((x == Inf) & (n > 0) & (n < Inf) & (n == round (n)) - & (p == 0)); - if (any (k)) - pdf(k) = 1; - endif + ok = (x < Inf) & (x == fix (x)) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + + k = (x < 0) & ok; + pdf(k) = 0; - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (n > 0) - & (n < Inf) & (n == round (n)) & (p > 0) & (p <= 1)); - if (any (k)) - if (isscalar (n) && isscalar (p)) - pdf(k) = bincoeff (-n, x(k)) .* (p ^ n) .* ((p - 1) .^ x(k)); - else - pdf(k) = bincoeff (-n(k), x(k)) .* (p(k) .^ n(k)) .* ((p(k) - 1) .^ x(k)); - endif + k = (x >= 0) & ok; + if (isscalar (n) && isscalar (p)) + pdf(k) = bincoeff (-n, x(k)) .* (p ^ n) .* ((p - 1) .^ x(k)); + else + pdf(k) = bincoeff (-n(k), x(k)) .* (p(k) .^ n(k)) .* ((p(k) - 1) .^ x(k)); endif + endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0 1/2 1/4 1/8 NaN]; +%!assert(nbinpdf (x, ones(1,5), 0.5*ones(1,5)), y); +%!assert(nbinpdf (x, 1, 0.5*ones(1,5)), y); +%!assert(nbinpdf (x, ones(1,5), 0.5), y); +%!assert(nbinpdf (x, [0 1 NaN 1.5 Inf], 0.5), [NaN 1/2 NaN 1.875*0.5^1.5/4 NaN], eps); +%!assert(nbinpdf (x, 1, 0.5*[-1 NaN 4 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(nbinpdf ([x, NaN], 1, 0.5), [y, NaN]); + +%% Test class of input preserved +%!assert(nbinpdf (single([x, NaN]), 1, 0.5), single([y, NaN])); +%!assert(nbinpdf ([x, NaN], single(1), 0.5), single([y, NaN])); +%!assert(nbinpdf ([x, NaN], 1, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error nbinpdf () +%!error nbinpdf (1) +%!error nbinpdf (1,2) +%!error nbinpdf (1,2,3,4) +%!error nbinpdf (ones(3),ones(2),ones(2)) +%!error nbinpdf (ones(2),ones(3),ones(2)) +%!error nbinpdf (ones(2),ones(2),ones(3)) +%!error nbinpdf (i, 2, 2) +%!error nbinpdf (2, i, 2) +%!error nbinpdf (2, 2, i) +
--- a/scripts/statistics/distributions/nbinrnd.m +++ b/scripts/statistics/distributions/nbinrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,85 +18,123 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} nbinrnd (@var{n}, @var{p}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the Pascal -## (negative binomial) distribution with parameters @var{n} and @var{p}. -## Both @var{n} and @var{p} must be scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} nbinrnd (@var{n}, @var{p}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the negative binomial +## distribution with parameters @var{n} and @var{p}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{n} and @var{p}. Or if @var{sz} is a vector, -## create a matrix of size @var{sz}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{n} and @var{p}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Pascal distribution -function rnd = nbinrnd (n, p, r, c) +function rnd = nbinrnd (n, p, varargin) - if (nargin > 1) - if (!isscalar(n) || !isscalar(p)) - [retval, n, p] = common_size (n, p); - if (retval > 0) - error ("nbinrnd: N and P must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, n, p] = common_size (n, p); + if (retval > 0) + error ("nbinrnd: N and P must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("nbinrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("nbinrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (n) || iscomplex (p)) + error ("nbinrnd: N and P must not be complex"); + endif - if (any (size (n) != 1) - && ((length (size (n)) != length (sz)) || any (size (n) != sz))) - error ("nbinrnd: N and P must be scalar or of size [R, C]"); - endif - + if (nargin == 2) + sz = size (n); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("nbinrnd: R must be a positive integer or vector"); + error ("nbinrnd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("nbinrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (n) != 1) - && ((length (size (n)) != length (sz)) || any (size (n) != sz))) - error ("nbinrnd: N and P must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(n); + if (!isscalar (n) && !isequal (size (n), sz)) + error ("nbinrnd: N and P must be scalar or of size SZ"); + endif + + if (isa (n, "single") || isa (p, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (n) && isscalar (p)) - if ((n < 1) || (n == Inf) || (n != round (n)) || (p <= 0) || (p > 1)); - rnd = NaN (sz); - elseif ((n > 0) && (n < Inf) && (n == round (n)) - && (p > 0) && (p <= 1)) + if ((n > 0) && (n < Inf) && (p > 0) && (p <= 1)) rnd = randp ((1 - p) ./ p .* randg (n, sz)); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + elseif ((n > 0) && (n < Inf) && (p == 0)) + rnd = zeros (sz, cls); else - rnd = zeros (sz); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); + rnd = NaN (sz, cls); - k = find ((n < 1) | (n == Inf) | (n != round (n)) | (p <= 0) | (p > 1)); - if (any (k)) - rnd(k) = NaN; - endif + k = (n > 0) & (n < Inf) & (p == 0); + rnd(k) = 0; - k = find ((n > 0) & (n < Inf) & (n == round (n)) & (p > 0) & (p <= 1)); - if (any (k)) - rnd(k) = randp ((1 - p(k)) ./ p(k) .* randg (n(k), size(k))); - endif + k = (n > 0) & (n < Inf) & (p > 0) & (p <= 1); + rnd(k) = randp ((1 - p(k)) ./ p(k) .* randg (n(k))); endif endfunction + + +%!assert(size (nbinrnd (2, 1/2)), [1, 1]); +%!assert(size (nbinrnd (2*ones(2,1), 1/2)), [2, 1]); +%!assert(size (nbinrnd (2*ones(2,2), 1/2)), [2, 2]); +%!assert(size (nbinrnd (2, 1/2*ones(2,1))), [2, 1]); +%!assert(size (nbinrnd (2, 1/2*ones(2,2))), [2, 2]); +%!assert(size (nbinrnd (2, 1/2, 3)), [3, 3]); +%!assert(size (nbinrnd (2, 1/2, [4 1])), [4, 1]); +%!assert(size (nbinrnd (2, 1/2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (nbinrnd (2, 1/2)), "double"); +%!assert(class (nbinrnd (single(2), 1/2)), "single"); +%!assert(class (nbinrnd (single([2 2]), 1/2)), "single"); +%!assert(class (nbinrnd (2, single(1/2))), "single"); +%!assert(class (nbinrnd (2, single([1/2 1/2]))), "single"); + +%% Test input validation +%!error nbinrnd () +%!error nbinrnd (1) +%!error nbinrnd (ones(3),ones(2)) +%!error nbinrnd (ones(2),ones(3)) +%!error nbinrnd (i, 2) +%!error nbinrnd (2, i) +%!error nbinrnd (1,2, -1) +%!error nbinrnd (1,2, ones(2)) +%!error nbinrnd (1, 2, [2 -1 2]) +%!error nbinrnd (1,2, 1, ones(2)) +%!error nbinrnd (1,2, 1, -1) +%!error nbinrnd (ones(2,2), 2, 3) +%!error nbinrnd (ones(2,2), 2, [3, 2]) +%!error nbinrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/normcdf.m +++ b/scripts/statistics/distributions/normcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,56 +18,82 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} normcdf (@var{x}, @var{m}, @var{s}) +## @deftypefn {Function File} {} normcdf (@var{x}) +## @deftypefnx {Function File} {} normcdf (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the cumulative distribution ## function (CDF) at @var{x} of the normal distribution with mean -## @var{m} and standard deviation @var{s}. +## @var{mu} and standard deviation @var{sigma}. ## -## Default values are @var{m} = 0, @var{s} = 1. +## Default values are @var{mu} = 0, @var{sigma} = 1. ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> ## Description: CDF of the normal distribution -function cdf = normcdf (x, m, s) +function cdf = normcdf (x, mu = 0, sigma = 1) - if (! ((nargin == 1) || (nargin == 3))) + if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - m = 0; - s = 1; - endif - - if (!isscalar (m) || !isscalar (s)) - [retval, x, m, s] = common_size (x, m, s); + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("normcdf: X, M and S must be of common size or scalar"); + error ("normcdf: X, MU, and SIGMA must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("normcdf: X, MU, and SIGMA must not be complex"); + endif - if (isscalar (m) && isscalar(s)) - if (find (isinf (m) | isnan (m) | !(s > 0) | !(s < Inf))) - cdf = NaN (sz); + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")); + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + cdf = stdnormal_cdf ((x - mu) / sigma); else - cdf = stdnormal_cdf ((x - m) ./ s); + cdf = NaN (size (x), class (cdf)); endif else - k = find (isinf (m) | isnan (m) | !(s > 0) | !(s < Inf)); - if (any (k)) - cdf(k) = NaN; - endif + k = isinf (mu) | isnan (mu) | !(sigma > 0) | !(sigma < Inf); + cdf(k) = NaN; - k = find (!isinf (m) & !isnan (m) & (s > 0) & (s < Inf)); - if (any (k)) - cdf(k) = stdnormal_cdf ((x(k) - m(k)) ./ s(k)); - endif + k = ! k; + cdf(k) = stdnormal_cdf ((x(k) - mu(k)) ./ sigma(k)); endif - cdf((s == 0) & (x == m)) = 0.5; +endfunction + + +%!shared x,y +%! x = [-Inf 1 2 Inf]; +%! y = [0, 0.5, 1/2*(1+erf(1/sqrt(2))), 1]; +%!assert(normcdf (x, ones(1,4), ones(1,4)), y); +%!assert(normcdf (x, 1, ones(1,4)), y); +%!assert(normcdf (x, ones(1,4), 1), y); +%!assert(normcdf (x, [0 -Inf NaN Inf], 1), [y(1) NaN NaN NaN]); +%!assert(normcdf (x, 1, [Inf NaN -1 0]), [NaN NaN NaN NaN]); +%!assert(normcdf ([x(1:2) NaN x(4)], 1, 1), [y(1:2) NaN y(4)]); -endfunction +%% Test class of input preserved +%!assert(normcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(normcdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); +%!assert(normcdf ([x, NaN], single(1), 1), single([y, NaN]), eps("single")); +%!assert(normcdf ([x, NaN], 1, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error normcdf () +%!error normcdf (1,2) +%!error normcdf (1,2,3,4) +%!error normcdf (ones(3),ones(2),ones(2)) +%!error normcdf (ones(2),ones(3),ones(2)) +%!error normcdf (ones(2),ones(2),ones(3)) +%!error normcdf (i, 2, 2) +%!error normcdf (2, i, 2) +%!error normcdf (2, 2, i) +
--- a/scripts/statistics/distributions/norminv.m +++ b/scripts/statistics/distributions/norminv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,62 +18,76 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} norminv (@var{x}, @var{m}, @var{s}) +## @deftypefn {Function File} {} norminv (@var{x}) +## @deftypefnx {Function File} {} norminv (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the quantile (the inverse of the -## CDF) at @var{x} of the normal distribution with mean @var{m} and -## standard deviation @var{s}. +## CDF) at @var{x} of the normal distribution with mean @var{mu} and +## standard deviation @var{sigma}. ## -## Default values are @var{m} = 0, @var{s} = 1. +## Default values are @var{mu} = 0, @var{sigma} = 1. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the normal distribution -function inv = norminv (x, m, s) +function inv = norminv (x, mu = 0, sigma = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - m = 0; - s = 1; - endif - - if (!isscalar (m) || !isscalar (s)) - [retval, x, m, s] = common_size (x, m, s); + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("norminv: X, M and S must be of common size or scalars"); + error ("norminv: X, MU, and SIGMA must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("norminv: X, MU, and SIGMA must not be complex"); + endif - if (isscalar (m) && isscalar (s)) - if (find (isinf (m) | isnan (m) | !(s > 0) | !(s < Inf))) - inv = NaN (sz); - else - inv = m + s .* stdnormal_inv (x); + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + inv = mu + sigma * stdnormal_inv (x); endif else - k = find (isinf (m) | isnan (m) | !(s > 0) | !(s < Inf)); - if (any (k)) - inv(k) = NaN; - endif - - k = find (!isinf (m) & !isnan (m) & (s > 0) & (s < Inf)); - if (any (k)) - inv(k) = m(k) + s(k) .* stdnormal_inv (x(k)); - endif + k = !isinf (mu) & !isnan (mu) & (sigma > 0) & (sigma < Inf); + inv(k) = mu(k) + sigma(k) .* stdnormal_inv (x(k)); endif - k = find ((s == 0) & (x > 0) & (x < 1)); - if (any (k)) - inv(k) = m(k); - endif +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(norminv (x, ones(1,5), ones(1,5)), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, 1, ones(1,5)), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, ones(1,5), 1), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, [1 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(norminv (x, 1, [1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(norminv ([x(1:2) NaN x(4:5)], 1, 1), [NaN -Inf NaN Inf NaN]); - inv((s == 0) & (x == 0)) = -Inf; - inv((s == 0) & (x == 1)) = Inf; +%% Test class of input preserved +%!assert(norminv ([x, NaN], 1, 1), [NaN -Inf 1 Inf NaN NaN]); +%!assert(norminv (single([x, NaN]), 1, 1), single([NaN -Inf 1 Inf NaN NaN])); +%!assert(norminv ([x, NaN], single(1), 1), single([NaN -Inf 1 Inf NaN NaN])); +%!assert(norminv ([x, NaN], 1, single(1)), single([NaN -Inf 1 Inf NaN NaN])); -endfunction +%% Test input validation +%!error norminv () +%!error norminv (1,2) +%!error norminv (1,2,3,4) +%!error norminv (ones(3),ones(2),ones(2)) +%!error norminv (ones(2),ones(3),ones(2)) +%!error norminv (ones(2),ones(2),ones(3)) +%!error norminv (i, 2, 2) +%!error norminv (2, i, 2) +%!error norminv (2, 2, i) +
--- a/scripts/statistics/distributions/normpdf.m +++ b/scripts/statistics/distributions/normpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,57 +18,81 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} normpdf (@var{x}, @var{m}, @var{s}) +## @deftypefn {Function File} {} normpdf (@var{x}) +## @deftypefnx {Function File} {} normpdf (@var{x}, @var{mu}, @var{sigma}) ## For each element of @var{x}, compute the probability density function -## (PDF) at @var{x} of the normal distribution with mean @var{m} and -## standard deviation @var{s}. +## (PDF) at @var{x} of the normal distribution with mean @var{mu} and +## standard deviation @var{sigma}. ## -## Default values are @var{m} = 0, @var{s} = 1. +## Default values are @var{mu} = 0, @var{sigma} = 1. ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> ## Description: PDF of the normal distribution -function pdf = normpdf (x, m, s) +function pdf = normpdf (x, mu = 0, sigma = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - m = 0; - s = 1; - endif - - if (!isscalar (m) || !isscalar (s)) - [retval, x, m, s] = common_size (x, m, s); + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); if (retval > 0) - error ("normpdf: X, M and S must be of common size or scalars"); + error ("normpdf: X, MU, and SIGMA must be of common size or scalars"); endif endif - sz = size (x); - pdf = zeros (sz); + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("normpdf: X, MU, and SIGMA must not be complex"); + endif - if (isscalar (m) && isscalar (s)) - if (find (isinf (m) | isnan (m) | !(s > 0) | !(s < Inf))) - pdf = NaN (sz); + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + pdf = stdnormal_pdf ((x - mu) / sigma) / sigma; else - pdf = stdnormal_pdf ((x - m) ./ s) ./ s; + pdf = NaN (size (x), class (pdf)); endif else - k = find (isinf (m) | isnan (m) | !(s > 0) | !(s < Inf)); - if (any (k)) - pdf(k) = NaN; - endif + k = isinf (mu) | !(sigma > 0) | !(sigma < Inf); + pdf(k) = NaN; - k = find (!isinf (m) & !isnan (m) & (s > 0) & (s < Inf)); - if (any (k)) - pdf(k) = stdnormal_pdf ((x(k) - m(k)) ./ s(k)) ./ s(k); - endif + k = !isinf (mu) & (sigma > 0) & (sigma < Inf); + pdf(k) = stdnormal_pdf ((x(k) - mu(k)) ./ sigma(k)) ./ sigma(k); endif - pdf((s == 0) & (x == m)) = Inf; - pdf((s == 0) & ((x < m) | (x > m))) = 0; +endfunction + + +%!shared x,y +%! x = [-Inf 1 2 Inf]; +%! y = 1/sqrt(2*pi)*exp (-(x-1).^2/2); +%!assert(normpdf (x, ones(1,4), ones(1,4)), y); +%!assert(normpdf (x, 1, ones(1,4)), y); +%!assert(normpdf (x, ones(1,4), 1), y); +%!assert(normpdf (x, [0 -Inf NaN Inf], 1), [y(1) NaN NaN NaN]); +%!assert(normpdf (x, 1, [Inf NaN -1 0]), [NaN NaN NaN NaN]); +%!assert(normpdf ([x, NaN], 1, 1), [y, NaN]); -endfunction +%% Test class of input preserved +%!assert(normpdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); +%!assert(normpdf ([x, NaN], single(1), 1), single([y, NaN]), eps("single")); +%!assert(normpdf ([x, NaN], 1, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error normpdf () +%!error normpdf (1,2) +%!error normpdf (1,2,3,4) +%!error normpdf (ones(3),ones(2),ones(2)) +%!error normpdf (ones(2),ones(3),ones(2)) +%!error normpdf (ones(2),ones(2),ones(3)) +%!error normpdf (i, 2, 2) +%!error normpdf (2, i, 2) +%!error normpdf (2, 2, i) +
--- a/scripts/statistics/distributions/normrnd.m +++ b/scripts/statistics/distributions/normrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,75 +18,114 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} normrnd (@var{m}, @var{s}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} normrnd (@var{m}, @var{s}, @var{sz}) -## Return an @var{r} by @var{c} or @code{size (@var{sz})} matrix of -## random samples from the normal distribution with parameters mean @var{m} -## and standard deviation @var{s}. Both @var{m} and @var{s} must be scalar -## or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} normrnd (@var{mu}, @var{sigma}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, @var{r}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, [@var{sz}]) +## Return a matrix of random samples from the normal distribution with +## parameters mean @var{mu} and standard deviation @var{sigma}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{m} and @var{s}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{mu} and @var{sigma}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the normal distribution -function rnd = normrnd (m, s, r, c) +function rnd = normrnd (mu, sigma, varargin) - if (nargin > 1) - if (!isscalar (m) || !isscalar (s)) - [retval, m, s] = common_size (m, s); - if (retval > 0) - error ("normrnd: M and S must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, mu, sigma] = common_size (mu, sigma); + if (retval > 0) + error ("normrnd: mu and sigma must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("normrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("normrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (mu) || iscomplex (sigma)) + error ("normrnd: MU and SIGMA must not be complex"); + endif - if (any (size (m) != 1) - && (length (size (m)) != length (sz) || any (size (m) != sz))) - error ("normrnd: M and S must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (mu); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("normrnd: R must be a positive integer or vector"); + error ("normrnd: dimension vector must be row vector of non-negative integers"); endif - - if (any (size (m) != 1) - && (length (size (m)) != length (sz) || any (size (m) != sz))) - error ("normrnd: M and S must be scalar or of size SZ"); + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("normrnd: dimensions must be non-negative integers"); endif - elseif (nargin == 2) - sz = size(m); - else - print_usage (); + sz = [varargin{:}]; endif - if (isscalar (m) && isscalar (s)) - if (find (isnan (m) | isinf (m) | !(s > 0) | !(s < Inf))) - rnd = NaN (sz); + if (!isscalar (mu) && !isequal (size (mu), sz)) + error ("normrnd: mu and sigma must be scalar or of size SZ"); + endif + + if (isa (mu, "single") || isa (sigma, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isnan (mu) && !isinf (mu) && (sigma > 0) && (sigma < Inf)) + rnd = mu + sigma * randn (sz); else - rnd = m + s .* randn (sz); + rnd = NaN (sz, cls); endif else - rnd = m + s .* randn (sz); - k = find (isnan (m) | isinf (m) | !(s > 0) | !(s < Inf)); - if (any (k)) - rnd(k) = NaN; - endif + rnd = mu + sigma .* randn (sz); + k = isnan (mu) | isinf (mu) | !(sigma > 0) | !(sigma < Inf); + rnd(k) = NaN; endif endfunction + + +%!assert(size (normrnd (1,2)), [1, 1]); +%!assert(size (normrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (normrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (normrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (normrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (normrnd (1, 2, 3)), [3, 3]); +%!assert(size (normrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (normrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (normrnd (1, 2)), "double"); +%!assert(class (normrnd (single(1), 2)), "single"); +%!assert(class (normrnd (single([1 1]), 2)), "single"); +%!assert(class (normrnd (1, single(2))), "single"); +%!assert(class (normrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error normrnd () +%!error normrnd (1) +%!error normrnd (ones(3),ones(2)) +%!error normrnd (ones(2),ones(3)) +%!error normrnd (i, 2) +%!error normrnd (2, i) +%!error normrnd (1,2, -1) +%!error normrnd (1,2, ones(2)) +%!error normrnd (1, 2, [2 -1 2]) +%!error normrnd (1,2, 1, ones(2)) +%!error normrnd (1,2, 1, -1) +%!error normrnd (ones(2,2), 2, 3) +%!error normrnd (ones(2,2), 2, [3, 2]) +%!error normrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/poisscdf.m +++ b/scripts/statistics/distributions/poisscdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,29 +36,55 @@ if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("poisscdf: X and LAMBDA must be of common size or scalar"); + error ("poisscdf: X and LAMBDA must be of common size or scalars"); endif endif - cdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (lambda)) + error ("poisscdf: X and LAMBDA must not be complex"); + endif - k = find (isnan (x) | !(lambda > 0)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (lambda, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (lambda > 0)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(lambda > 0); + cdf(k) = NaN; + + k = (x == Inf) & (lambda > 0); + cdf(k) = 1; - k = find ((x >= 0) & (x < Inf) & (lambda > 0)); - if (any (k)) - if (isscalar (lambda)) - cdf(k) = 1 - gammainc (lambda, floor (x(k)) + 1); - else - cdf(k) = 1 - gammainc (lambda(k), floor (x(k)) + 1); - endif + k = (x >= 0) & (x < Inf) & (lambda > 0); + if (isscalar (lambda)) + cdf(k) = 1 - gammainc (lambda, floor (x(k)) + 1); + else + cdf(k) = 1 - gammainc (lambda(k), floor (x(k)) + 1); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0, gammainc(1, (x(2:4) +1), 'upper'), 1]; +%!assert(poisscdf (x, ones(1,5)), y); +%!assert(poisscdf (x, 1), y); +%!assert(poisscdf (x, [1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(poisscdf ([x(1:2) NaN Inf x(5)], 1), [y(1:2) NaN 1 y(5)]); + +%% Test class of input preserved +%!assert(poisscdf ([x, NaN], 1), [y, NaN]); +%!assert(poisscdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(poisscdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error poisscdf () +%!error poisscdf (1) +%!error poisscdf (1,2,3) +%!error poisscdf (ones(3),ones(2)) +%!error poisscdf (ones(2),ones(3)) +%!error poisscdf (i, 2) +%!error poisscdf (2, i) +
--- a/scripts/statistics/distributions/poissinv.m +++ b/scripts/statistics/distributions/poissinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,7 +19,7 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} poissinv (@var{x}, @var{lambda}) -## For each component of @var{x}, compute the quantile (the inverse of +## For each element of @var{x}, compute the quantile (the inverse of ## the CDF) at @var{x} of the Poisson distribution with parameter ## @var{lambda}. ## @end deftypefn @@ -35,42 +36,68 @@ if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("poissinv: X and LAMBDA must be of common size or scalar"); + error ("poissinv: X and LAMBDA must be of common size or scalars"); endif endif - inv = zeros (size (x)); - - k = find ((x < 0) | (x > 1) | isnan (x) | !(lambda > 0)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (lambda)) + error ("poissinv: X and LAMBDA must not be complex"); endif - k = find ((x == 1) & (lambda > 0)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (lambda, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); endif + k = (x < 0) | (x > 1) | isnan (x) | !(lambda > 0); + inv(k) = NaN; + + k = (x == 1) & (lambda > 0); + inv(k) = Inf; + k = find ((x > 0) & (x < 1) & (lambda > 0)); - if (any (k)) - if (isscalar (lambda)) - cdf = exp (-lambda) * ones (size (k)); + if (isscalar (lambda)) + cdf = exp (-lambda) * ones (size (k)); + else + cdf = exp (-lambda(k)); + endif + + while (1) + m = find (cdf < x(k)); + if (any (m)) + inv(k(m)) += 1; + if (isscalar (lambda)) + cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda); + else + cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda(k(m))); + endif else - cdf = exp (-lambda(k)); + break; endif - while (1) - m = find (cdf < x(k)); - if (any (m)) - inv(k(m)) = inv(k(m)) + 1; - if (isscalar (lambda)) - cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda); - else - cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda(k(m))); - endif - else - break; - endif - endwhile - endif + endwhile endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(poissinv (x, ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(poissinv (x, 1), [NaN 0 1 Inf NaN]); +%!assert(poissinv (x, [1 0 NaN 1 1]), [NaN NaN NaN Inf NaN]); +%!assert(poissinv ([x(1:2) NaN x(4:5)], 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(poissinv ([x, NaN], 1), [NaN 0 1 Inf NaN NaN]); +%!assert(poissinv (single([x, NaN]), 1), single([NaN 0 1 Inf NaN NaN])); +%!assert(poissinv ([x, NaN], single(1)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error poissinv () +%!error poissinv (1) +%!error poissinv (1,2,3) +%!error poissinv (ones(3),ones(2)) +%!error poissinv (ones(2),ones(3)) +%!error poissinv (i, 2) +%!error poissinv (2, i) +
--- a/scripts/statistics/distributions/poisspdf.m +++ b/scripts/statistics/distributions/poisspdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -34,24 +35,51 @@ if (!isscalar (lambda)) [retval, x, lambda] = common_size (x, lambda); if (retval > 0) - error ("poisspdf: X and LAMBDA must be of common size or scalar"); + error ("poisspdf: X and LAMBDA must be of common size or scalars"); endif endif - pdf = zeros (size (x)); - - k = find (!(lambda > 0) | isnan (x)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (lambda)) + error ("poisspdf: X and LAMBDA must not be complex"); endif - k = find ((x >= 0) & (x < Inf) & (x == round (x)) & (lambda > 0)); - if (any (k)) - if (isscalar (lambda)) - pdf(k) = exp (x(k) .* log (lambda) - lambda - gammaln (x(k) + 1)); - else - pdf(k) = exp (x(k) .* log (lambda(k)) - lambda(k) - gammaln (x(k) + 1)); - endif + if (isa (x, "single") || isa (lambda, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(lambda > 0); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (lambda > 0); + if (isscalar (lambda)) + pdf(k) = exp (x(k) * log (lambda) - lambda - gammaln (x(k) + 1)); + else + pdf(k) = exp (x(k) .* log (lambda(k)) - lambda(k) - gammaln (x(k) + 1)); endif endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0, exp(-1)*[1 1 0.5], 0]; +%!assert(poisspdf (x, ones(1,5)), y, eps); +%!assert(poisspdf (x, 1), y, eps); +%!assert(poisspdf (x, [1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)], eps); +%!assert(poisspdf ([x, NaN], 1), [y, NaN], eps); + +%% Test class of input preserved +%!assert(poisspdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(poisspdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error poisspdf () +%!error poisspdf (1) +%!error poisspdf (1,2,3) +%!error poisspdf (ones(3),ones(2)) +%!error poisspdf (ones(2),ones(3)) +%!error poisspdf (i, 2) +%!error poisspdf (2, i) +
--- a/scripts/statistics/distributions/poissrnd.m +++ b/scripts/statistics/distributions/poissrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,73 +18,103 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} poissrnd (@var{lambda}, @var{r}, @var{c}) -## Return an @var{r} by @var{c} matrix of random samples from the -## Poisson distribution with parameter @var{lambda}, which must be a -## scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} poissrnd (@var{lambda}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, @var{r}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, [@var{sz}]) +## Return a matrix of random samples from the Poisson distribution with +## parameter @var{lambda}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the size of @var{lambda}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{lambda}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Poisson distribution -function rnd = poissrnd (lambda, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("poissrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("poissrnd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = poissrnd (lambda, varargin) - if (any (size (lambda) != 1) - && ((length (size (lambda)) != length (sz)) || any (size (lambda) != sz))) - error ("poissrnd: LAMBDA must be scalar or of size [R, C]"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("poissrnd: R must be a positive integer or vector"); - endif - - if (any (size (lambda) != 1) - && ((length (size (lambda)) != length (sz)) || any (size (lambda) != sz))) - error ("poissrnd: LAMBDA must be scalar or of size sz"); - endif - elseif (nargin == 1) - sz = size (lambda); - else + if (nargin < 1) print_usage (); endif - if (isscalar (lambda)) + if (nargin == 1) + sz = size (lambda); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("poissrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("poissrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (!(lambda >= 0) || !(lambda < Inf)) - rnd = NaN (sz); - elseif (lambda > 0 && lambda < Inf) - rnd = randp(lambda, sz); + if (!isscalar (lambda) && !isequal (size (lambda), sz)) + error ("poissrnd: LAMBDA must be scalar or of size SZ"); + endif + + if (iscomplex (lambda)) + error ("poissrnd: LAMBDA must not be complex"); + endif + + if (isa (lambda, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (lambda)) + if (lambda > 0 && lambda < Inf) + rnd = randp (lambda, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif else - rnd = zeros (sz); + rnd = NaN (sz, cls); endif else - rnd = zeros (sz); + rnd = NaN (sz, cls); - k = find (!(lambda >= 0) | !(lambda < Inf)); - if (any (k)) - rnd(k) = NaN; - endif - - k = find ((lambda > 0) & (lambda < Inf)); - if (any (k)) - rnd(k) = randp(lambda(k), size(k)); - endif + k = (lambda > 0) & (lambda < Inf); + rnd(k) = randp (lambda(k)); endif endfunction + + +%!assert(size (poissrnd (2)), [1, 1]); +%!assert(size (poissrnd (ones(2,1))), [2, 1]); +%!assert(size (poissrnd (ones(2,2))), [2, 2]); +%!assert(size (poissrnd (1, 3)), [3, 3]); +%!assert(size (poissrnd (1, [4 1])), [4, 1]); +%!assert(size (poissrnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (poissrnd (2)), "double"); +%!assert(class (poissrnd (single(2))), "single"); +%!assert(class (poissrnd (single([2 2]))), "single"); + +%% Test input validation +%!error poissrnd () +%!error poissrnd (1, -1) +%!error poissrnd (1, ones(2)) +%!error poissrnd (1, 2, ones(2)) +%!error poissrnd (i) +%!error poissrnd (1, 2, -1) +%!error poissrnd (1, [2 -1 2]) +%!error poissrnd (ones(2,2), 3) +%!error poissrnd (ones(2,2), [3, 2]) +%!error poissrnd (ones(2,2), 2, 3) +
--- a/scripts/statistics/distributions/stdnormal_cdf.m +++ b/scripts/statistics/distributions/stdnormal_cdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} stdnormal_cdf (@var{x}) -## For each component of @var{x}, compute the CDF of the standard normal -## distribution at @var{x}. +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the standard normal distribution +## (mean = 0, standard deviation = 1). ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,9 +33,8 @@ print_usage (); endif - sz = size (x); - if (numel(x) == 0) - error ("stdnormal_cdf: X must not be empty"); + if (iscomplex (x)) + error ("stdnormal_cdf: X must not be complex"); endif cdf = erfc (x / (-sqrt(2))) / 2; @@ -41,5 +42,16 @@ endfunction +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = [0, 0.5, 1/2*(1+erf(1/sqrt(2))), 1]; +%!assert(stdnormal_cdf ([x, NaN]), [y, NaN]); +%% Test class of input preserved +%!assert(stdnormal_cdf (single([x, NaN])), single([y, NaN]), eps("single")); +%% Test input validation +%!error stdnormal_cdf () +%!error stdnormal_cdf (1,2) +%!error stdnormal_cdf (i) +
--- a/scripts/statistics/distributions/stdnormal_inv.m +++ b/scripts/statistics/distributions/stdnormal_inv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,8 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} stdnormal_inv (@var{x}) -## For each component of @var{x}, compute the quantile (the -## inverse of the CDF) at @var{x} of the standard normal distribution. +## For each element of @var{x}, compute the quantile (the +## inverse of the CDF) at @var{x} of the standard normal distribution +## (mean = 0, standard deviation = 1). ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> @@ -31,6 +33,25 @@ print_usage (); endif + if (iscomplex (x)) + error ("stdnormal_inv: X must not be complex"); + endif + inv = sqrt (2) * erfinv (2 * x - 1); endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(stdnormal_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(stdnormal_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(stdnormal_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error stdnormal_inv () +%!error stdnormal_inv (1,2) +%!error stdnormal_inv (i) +
--- a/scripts/statistics/distributions/stdnormal_pdf.m +++ b/scripts/statistics/distributions/stdnormal_pdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -19,7 +20,8 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} stdnormal_pdf (@var{x}) ## For each element of @var{x}, compute the probability density function -## (PDF) of the standard normal distribution at @var{x}. +## (PDF) at @var{x} of the standard normal distribution (mean = 0, +## standard deviation = 1). ## @end deftypefn ## Author: TT <Teresa.Twaroch@ci.tuwien.ac.at> @@ -31,17 +33,25 @@ print_usage (); endif - sz = size(x); - pdf = zeros (sz); - - k = find (isnan (x)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x)) + error ("stdnormal_pdf: X must not be complex"); endif - k = find (!isinf (x)); - if (any (k)) - pdf (k) = (2 * pi)^(- 1/2) * exp (- x(k) .^ 2 / 2); - endif + pdf = (2 * pi)^(- 1/2) * exp (- x .^ 2 / 2); endfunction + + +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = 1/sqrt(2*pi)*exp (-x.^2/2); +%!assert(stdnormal_pdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(stdnormal_pdf (single([x, NaN])), single([y, NaN]), eps("single")); + +%% Test input validation +%!error stdnormal_pdf () +%!error stdnormal_pdf (1,2) +%!error stdnormal_pdf (i) +
--- a/scripts/statistics/distributions/stdnormal_rnd.m +++ b/scripts/statistics/distributions/stdnormal_rnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,39 +18,57 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} stdnormal_rnd (@var{r}, @var{c}) -## @deftypefnx {Function File} {} stdnormal_rnd (@var{sz}) -## Return an @var{r} by @var{c} or @code{size (@var{sz})} matrix of -## random numbers from the standard normal distribution. +## @deftypefn {Function File} {} stdnormal_rnd (@var{r}) +## @deftypefnx {Function File} {} stdnormal_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} stdnormal_rnd ([@var{sz}]) +## Return a matrix of random samples from the standard normal distribution +## (mean = 0, standard deviation = 1). +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the standard normal distribution -function rnd = stdnormal_rnd (r, c) +function rnd = stdnormal_rnd (varargin) - if (nargin != 1 && nargin != 2) + if (nargin < 1) print_usage (); endif - if (nargin == 2) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("stdnormal_rnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("stdnormal_rnd: C must be a positive integer"); + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("stdnormal_rnd: dimension vector must be row vector of non-negative integers"); endif - sz = [r, c]; - else - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("stdnormal_rnd: R must be a positive integer or vector"); + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("stdnormal_rnd: dimensions must be non-negative integers"); endif + sz = [varargin{:}]; endif rnd = randn (sz); endfunction + + +%!assert(size (stdnormal_rnd (3)), [3, 3]); +%!assert(size (stdnormal_rnd ([4 1])), [4, 1]); +%!assert(size (stdnormal_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error stdnormal_rnd () +%!error stdnormal_rnd (-1) +%!error stdnormal_rnd (ones(2)) +%!error stdnormal_rnd ([2 -1 2]) +%!error stdnormal_rnd (1, ones(2)) +%!error stdnormal_rnd (1, -1) +
--- a/scripts/statistics/distributions/tcdf.m +++ b/scripts/statistics/distributions/tcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,33 +36,59 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("tcdf: X and N must be of common size or scalar"); + error ("tcdf: X and N must be of common size or scalars"); endif endif - cdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (n)) + error ("tcdf: X and N must not be complex"); + endif - k = find (isnan (x) | !(n > 0)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x == Inf) & (n > 0)); - if (any (k)) - cdf(k) = 1; + k = !isinf (x) & (n > 0); + if (isscalar (n)) + cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 / n), n/2, 1/2) / 2; + else + cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 ./ n(k)), n(k)/2, 1/2) / 2; + endif + k &= (x > 0); + if (any (k(:))) + cdf(k) = 1 - cdf(k); endif - k = find ((x > -Inf) & (x < Inf) & (n > 0)); - if (any (k)) - if (isscalar (n)) - cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 ./ n), n / 2, 1 / 2) / 2; - else - cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 ./ n(k)), n(k) / 2, 1 / 2) / 2; - endif - ind = find (x(k) > 0); - if (any (ind)) - cdf(k(ind)) = 1 - cdf(k(ind)); - endif - endif + k = isnan (x) | !(n > 0); + cdf(k) = NaN; + + k = (x == Inf) & (n > 0); + cdf(k) = 1; endfunction + + +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = [0 1/2 3/4 1]; +%!assert(tcdf (x, ones(1,4)), y, eps); +%!assert(tcdf (x, 1), y, eps); +%!assert(tcdf (x, [0 1 NaN 1]), [NaN 1/2 NaN 1], eps); +%!assert(tcdf ([x(1:2) NaN x(4)], 1), [y(1:2) NaN y(4)], eps); + +%% Test class of input preserved +%!assert(tcdf ([x, NaN], 1), [y, NaN], eps); +%!assert(tcdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(tcdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error tcdf () +%!error tcdf (1) +%!error tcdf (1,2,3) +%!error tcdf (ones(3),ones(2)) +%!error tcdf (ones(2),ones(3)) +%!error tcdf (i, 2) +%!error tcdf (2, i) +
--- a/scripts/statistics/distributions/tinv.m +++ b/scripts/statistics/distributions/tinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -18,11 +19,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} tinv (@var{x}, @var{n}) -## For each probability value @var{x}, compute the inverse of the -## cumulative distribution function (CDF) of the t (Student) -## distribution with degrees of freedom @var{n}. This function is -## analogous to looking in a table for the t-value of a single-tailed -## distribution. +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the t (Student) distribution with @var{n} +## degrees of freedom. This function is analogous to looking in a table +## for the t-value of a single-tailed distribution. ## @end deftypefn ## For very large n, the "correct" formula does not really work well, @@ -41,44 +41,68 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("tinv: X and N must be of common size or scalar"); + error ("tinv: X and N must be of common size or scalars"); endif endif - inv = zeros (size (x)); - - k = find ((x < 0) | (x > 1) | isnan (x) | !(n > 0)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (n)) + error ("tinv: X and N must not be complex"); endif - k = find ((x == 0) & (n > 0)); - if (any (k)) - inv(k) = -Inf; - endif - - k = find ((x == 1) & (n > 0)); - if (any (k)) - inv(k) = Inf; + if (isa (x, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & (n > 0) & (n < 10000)); - if (any (k)) - if (isscalar (n)) - inv(k) = (sign (x(k) - 1/2) - .* sqrt (n .* (1 ./ betainv (2*min (x(k), 1 - x(k)), - n/2, 1/2) - 1))); - else + k = (x == 0) & (n > 0); + inv(k) = -Inf; + + k = (x == 1) & (n > 0); + inv(k) = Inf; + + if (isscalar (n)) + k = (x > 0) & (x < 1); + if ((n > 0) && (n < 10000)) inv(k) = (sign (x(k) - 1/2) - .* sqrt (n(k) .* (1 ./ betainv (2*min (x(k), 1 - x(k)), - n(k)/2, 1/2) - 1))); + .* sqrt (n * (1 ./ betainv (2*min (x(k), 1 - x(k)), + n/2, 1/2) - 1))); + elseif (n >= 10000) + ## For large n, use the quantiles of the standard normal + inv(k) = stdnormal_inv (x(k)); endif - endif + else + k = (x > 0) & (x < 1) & (n > 0) & (n < 10000); + inv(k) = (sign (x(k) - 1/2) + .* sqrt (n(k) .* (1 ./ betainv (2*min (x(k), 1 - x(k)), + n(k)/2, 1/2) - 1))); - ## For large n, use the quantiles of the standard normal - k = find ((x > 0) & (x < 1) & (n >= 10000)); - if (any (k)) + ## For large n, use the quantiles of the standard normal + k = (x > 0) & (x < 1) & (n >= 10000); inv(k) = stdnormal_inv (x(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(tinv (x, ones(1,5)), [NaN -Inf 0 Inf NaN]); +%!assert(tinv (x, 1), [NaN -Inf 0 Inf NaN], eps); +%!assert(tinv (x, [1 0 NaN 1 1]), [NaN NaN NaN Inf NaN], eps); +%!assert(tinv ([x(1:2) NaN x(4:5)], 1), [NaN -Inf NaN Inf NaN]); + +%% Test class of input preserved +%!assert(tinv ([x, NaN], 1), [NaN -Inf 0 Inf NaN NaN], eps); +%!assert(tinv (single([x, NaN]), 1), single([NaN -Inf 0 Inf NaN NaN]), eps("single")); +%!assert(tinv ([x, NaN], single(1)), single([NaN -Inf 0 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error tinv () +%!error tinv (1) +%!error tinv (1,2,3) +%!error tinv (ones(3),ones(2)) +%!error tinv (ones(2),ones(3)) +%!error tinv (i, 2) +%!error tinv (2, i) +
--- a/scripts/statistics/distributions/tpdf.m +++ b/scripts/statistics/distributions/tpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -35,26 +36,58 @@ if (!isscalar (n)) [retval, x, n] = common_size (x, n); if (retval > 0) - error ("tpdf: X and N must be of common size or scalar"); + error ("tpdf: X and N must be of common size or scalars"); endif endif - pdf = zeros (size (x)); + if (iscomplex (x) || iscomplex (n)) + error ("tpdf: X and N must not be complex"); + endif - k = find (isnan (x) | !(n > 0) | !(n < Inf)); - if (any (k)) - pdf(k) = NaN; + if (isa (x, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); endif - k = find (!isinf (x) & !isnan (x) & (n > 0) & (n < Inf)); - if (any (k)) - if (isscalar (n)) - pdf(k) = (exp (- (n + 1) .* log (1 + x(k) .^ 2 ./ n)/2) - / (sqrt (n) * beta (n/2, 1/2))); - else - pdf(k) = (exp (- (n(k) + 1) .* log (1 + x(k) .^ 2 ./ n(k))/2) - ./ (sqrt (n(k)) .* beta (n(k)/2, 1/2))); - endif + k = isnan (x) | !(n > 0) | !(n < Inf); + pdf(k) = NaN; + + k = !isinf (x) & !isnan (x) & (n > 0) & (n < Inf); + if (isscalar (n)) + pdf(k) = (exp (- (n + 1) * log (1 + x(k) .^ 2 / n)/2) + / (sqrt (n) * beta (n/2, 1/2))); + else + pdf(k) = (exp (- (n(k) + 1) .* log (1 + x(k) .^ 2 ./ n(k))/2) + ./ (sqrt (n(k)) .* beta (n(k)/2, 1/2))); endif endfunction + + +%!test +%! x = rand (10,1); +%! y = 1./(pi * (1 + x.^2)); +%! assert(tpdf (x, 1), y, 5*eps); + +%!shared x,y +%! x = [-Inf 0 0.5 1 Inf]; +%! y = 1./(pi * (1 + x.^2)); +%!assert(tpdf (x, ones(1,5)), y, eps); +%!assert(tpdf (x, 1), y, eps); +%!assert(tpdf (x, [0 NaN 1 1 1]), [NaN NaN y(3:5)], eps); + +%% Test class of input preserved +%!assert(tpdf ([x, NaN], 1), [y, NaN], eps); +%!assert(tpdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(tpdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error tpdf () +%!error tpdf (1) +%!error tpdf (1,2,3) +%!error tpdf (ones(3),ones(2)) +%!error tpdf (ones(2),ones(3)) +%!error tpdf (i, 2) +%!error tpdf (2, i) +
--- a/scripts/statistics/distributions/trnd.m +++ b/scripts/statistics/distributions/trnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,74 +18,100 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} trnd (@var{n}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} trnd (@var{n}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the t -## (Student) distribution with @var{n} degrees of freedom. @var{n} must -## be a scalar or of size @var{r} by @var{c}. Or if @var{sz} is a -## vector create a matrix of size @var{sz}. +## @deftypefn {Function File} {} trnd (@var{n}) +## @deftypefnx {Function File} {} trnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} trnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} trnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the t (Student) distribution with +## @var{n} degrees of freedom. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the size of @var{n}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the t distribution -function rnd = trnd (n, r, c) - - if (nargin == 3) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("trnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("trnd: C must be a positive integer"); - endif - sz = [r, c]; +function rnd = trnd (n, varargin) - if (any (size (n) != 1) - && ((length (size (n)) != length (sz)) || any (size (n) != sz))) - error ("trnd: N must be scalar or of size SZ"); - endif - elseif (nargin == 2) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("trnd: R must be a positive integer or vector"); - endif - - if (any (size (n) != 1) - && ((length (size (n)) != length (sz)) || any (size (n) != sz))) - error ("trnd: N must be scalar or of size SZ"); - endif - elseif (nargin == 1) - sz = size (n); - else + if (nargin < 1) print_usage (); endif + if (nargin == 1) + sz = size (n); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("trnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("trnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("trnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("trnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + if (isscalar (n)) - if (!(n > 0) || !(n < Inf)) - rnd = NaN (sz); - elseif ((n > 0) && (n < Inf)) - rnd = randn(sz) ./ sqrt(2*randg(n/2,sz)./n); + if ((n > 0) && (n < Inf)) + rnd = randn (sz) ./ sqrt (2*randg (n/2, sz) / n); else - rnd = zeros (size (n)); + rnd = NaN (sz, cls); endif else - rnd = zeros (size (n)); + rnd = NaN (sz, cls); - k = find (!(n > 0) | !(n < Inf)); - if (any (k)) - rnd(k) = NaN; - endif - - k = find ((n > 0) & (n < Inf)); - if (any (k)) - rnd(k) = randn(size(k)) ./ sqrt(2*randg(n(k)/2,size(k))./n(k)); - endif + k = (n > 0) & (n < Inf); + rnd(k) = randn (sum (k(:)), 1) ./ sqrt (2*randg (n(k)/2) ./ n(k))(:); endif endfunction + + +%!assert(size (trnd (2)), [1, 1]); +%!assert(size (trnd (ones(2,1))), [2, 1]); +%!assert(size (trnd (ones(2,2))), [2, 2]); +%!assert(size (trnd (1, 3)), [3, 3]); +%!assert(size (trnd (1, [4 1])), [4, 1]); +%!assert(size (trnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (trnd (1)), "double"); +%!assert(class (trnd (single(1))), "single"); +%!assert(class (trnd (single([1 1]))), "single"); + +%% Test input validation +%!error trnd () +%!error trnd (1, -1) +%!error trnd (1, ones(2)) +%!error trnd (i) +%!error trnd (1, [2 -1 2]) +%!error trnd (1, 2, ones(2)) +%!error trnd (1, 2, -1) +%!error trnd (ones(2,2), 3) +%!error trnd (ones(2,2), [3, 2]) +%!error trnd (ones(2,2), 2, 3) +
--- a/scripts/statistics/distributions/unidcdf.m +++ b/scripts/statistics/distributions/unidcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2007-2011 David Bateman ## ## This file is part of Octave. @@ -17,26 +18,72 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unidcdf (@var{x}, @var{v}) +## @deftypefn {Function File} {} unidcdf (@var{x}, @var{n}) ## For each element of @var{x}, compute the cumulative distribution -## function (CDF) at @var{x} of a discrete uniform distribution which -## assumes the values in @var{v} with equal probability. -## If @var{v} is a scalar then @code{1/@var{v}} is the probability of a -## single element. +## function (CDF) at @var{x} of a discrete uniform distribution which assumes +## the integer values 1--@var{n} with equal probability. ## @end deftypefn -function cdf = unidcdf (x, v) +function cdf = unidcdf (x, n) if (nargin != 2) print_usage (); endif - if (isscalar(v)) - v = [1:v].'; + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidcdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidcdf: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); else - v = v(:); + cdf = zeros (size (x)); + endif + + knan = isnan (x) | ! (n > 0 & n == fix (n)); + if (any (knan(:))) + cdf(knan) = NaN; endif - cdf = discrete_cdf (x, v, ones(size(v))); + k = (x >= n) & !knan; + cdf(k) = 1; + + k = (x >= 1) & (x < n) & !knan; + if (isscalar (n)) + cdf(k) = floor (x(k)) / n; + else + cdf(k) = floor (x(k)) ./ n(k); + endif endfunction + + +%!shared x,y +%! x = [0 1 2.5 10 11]; +%! y = [0, 0.1 0.2 1.0 1.0]; +%!assert(unidcdf (x, 10*ones(1,5)), y); +%!assert(unidcdf (x, 10), y); +%!assert(unidcdf (x, 10*[0 1 NaN 1 1]), [NaN 0.1 NaN y(4:5)]); +%!assert(unidcdf ([x(1:2) NaN Inf x(5)], 10), [y(1:2) NaN 1 y(5)]); + +%% Test class of input preserved +%!assert(unidcdf ([x, NaN], 10), [y, NaN]); +%!assert(unidcdf (single([x, NaN]), 10), single([y, NaN])); +%!assert(unidcdf ([x, NaN], single(10)), single([y, NaN])); + +%% Test input validation +%!error unidcdf () +%!error unidcdf (1) +%!error unidcdf (1,2,3) +%!error unidcdf (ones(3),ones(2)) +%!error unidcdf (ones(2),ones(3)) +%!error unidcdf (i, 2) +%!error unidcdf (2, i) +
--- a/scripts/statistics/distributions/unidinv.m +++ b/scripts/statistics/distributions/unidinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2007-2011 David Bateman ## ## This file is part of Octave. @@ -17,25 +18,64 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unidinv (@var{x}, @var{v}) -## For each component of @var{x}, compute the quantile (the inverse of -## the CDF) at @var{x} of the discrete uniform distribution which assumes the -## values in @var{v} with equal probability. -## If @var{v} is a scalar then @code{1/@var{v}} is the probability of a -## single element. +## @deftypefn {Function File} {} unidinv (@var{x}, @var{n}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the discrete uniform distribution which assumes +## the integer values 1--@var{n} with equal probability. ## @end deftypefn -function inv = unidinv (x, v) +function inv = unidinv (x, n) if (nargin != 2) print_usage (); endif - if (isscalar(v)) - v = [1:v].'; + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidcdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidinv: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); else - v = v(:); + inv = NaN (size (x)); + endif + + ## For Matlab compatibility, unidinv(0) = NaN + k = (x > 0) & (x <= 1) & (n > 0 & n == fix (n)); + if (isscalar (n)) + inv(k) = floor (x(k) * n); + else + inv(k) = floor (x(k) .* n(k)); endif - inv = discrete_inv (x, v, ones(size(v))); endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(unidinv (x, 10*ones(1,5)), [NaN NaN 5 10 NaN], eps); +%!assert(unidinv (x, 10), [NaN NaN 5 10 NaN], eps); +%!assert(unidinv (x, 10*[0 1 NaN 1 1]), [NaN NaN NaN 10 NaN], eps); +%!assert(unidinv ([x(1:2) NaN x(4:5)], 10), [NaN NaN NaN 10 NaN], eps); + +%% Test class of input preserved +%!assert(unidinv ([x, NaN], 10), [NaN NaN 5 10 NaN NaN], eps); +%!assert(unidinv (single([x, NaN]), 10), single([NaN NaN 5 10 NaN NaN]), eps); +%!assert(unidinv ([x, NaN], single(10)), single([NaN NaN 5 10 NaN NaN]), eps); + +%% Test input validation +%!error unidinv () +%!error unidinv (1) +%!error unidinv (1,2,3) +%!error unidinv (ones(3),ones(2)) +%!error unidinv (ones(2),ones(3)) +%!error unidinv (i, 2) +%!error unidinv (2, i) +
--- a/scripts/statistics/distributions/unidpdf.m +++ b/scripts/statistics/distributions/unidpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2007-2011 David Bateman ## ## This file is part of Octave. @@ -17,25 +18,70 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unidpdf (@var{x}, @var{v}) +## @deftypefn {Function File} {} unidpdf (@var{x}, @var{n}) ## For each element of @var{x}, compute the probability density function ## (PDF) at @var{x} of a discrete uniform distribution which assumes -## the values in @var{v} with equal probability. -## If @var{v} is a scalar then @code{1/@var{v}} is the probability of a -## single element. +## the integer values 1--@var{n} with equal probability. +## +## Warning: The underlying implementation uses the double class and +## will only be accurate for @var{n} @leq{} @code{bitmax} +## (@w{@math{2^{53} - 1}} on IEEE-754 compatible systems). ## @end deftypefn -function pdf = unidpdf (x, v) +function pdf = unidpdf (x, n) if (nargin != 2) print_usage (); endif - if (isscalar(v)) - v = [1:v].'; + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidpdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidpdf: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); else - v = v(:); + pdf = zeros (size (x)); endif - pdf = discrete_pdf (x, v, ones(size(v))); + k = isnan (x) | ! (n > 0 & n == fix (n)); + pdf(k) = NaN; + + k = !k & (x >= 1) & (x <= n) & (x == fix (x)); + if (isscalar (n)) + pdf(k) = 1 / n; + else + pdf(k) = 1 ./ n(k); + endif + endfunction + + +%!shared x,y +%! x = [-1 0 1 2 10 11]; +%! y = [0 0 0.1 0.1 0.1 0]; +%!assert(unidpdf (x, 10*ones(1,6)), y); +%!assert(unidpdf (x, 10), y); +%!assert(unidpdf (x, 10*[0 NaN 1 1 1 1]), [NaN NaN y(3:6)]); +%!assert(unidpdf ([x, NaN], 10), [y, NaN]); + +%% Test class of input preserved +%!assert(unidpdf (single([x, NaN]), 10), single([y, NaN])); +%!assert(unidpdf ([x, NaN], single(10)), single([y, NaN])); + +%% Test input validation +%!error unidpdf () +%!error unidpdf (1) +%!error unidpdf (1,2,3) +%!error unidpdf (ones(3),ones(2)) +%!error unidpdf (ones(2),ones(3)) +%!error unidpdf (i, 2) +%!error unidpdf (2, i) +
--- a/scripts/statistics/distributions/unidrnd.m +++ b/scripts/statistics/distributions/unidrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 2005-2011 John W. Eaton ## ## This file is part of Octave. @@ -17,44 +18,94 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unidrnd (@var{mx}); -## @deftypefnx {Function File} {} unidrnd (@var{mx}, @var{v}); -## @deftypefnx {Function File} {} unidrnd (@var{mx}, @var{m}, @var{n}, @dots{}); -## Return random values from a discrete uniform distribution with maximum -## value(s) given by the integer @var{mx} (which may be a scalar or -## multi-dimensional array). +## @deftypefn {Function File} {} unidrnd (@var{n}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the discrete uniform distribution +## which assumes the integer values 1--@var{n} with equal probability. +## @var{n} may be a scalar or a multi-dimensional array. ## -## If @var{mx} is a scalar, the size of the result is specified by -## the vector @var{v}, or by the optional arguments @var{m}, @var{n}, -## @dots{}. Otherwise, the size of the result is the same as the size -## of @var{mx}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. ## @end deftypefn ## Author: jwe -function retval = unidrnd (n, varargin) +function rnd = unidrnd (n, varargin) + + if (nargin < 1) + print_usage (); + endif + if (nargin == 1) - dims = size (n); + sz = size (n); elseif (nargin == 2) - if (rows (varargin{1}) == 1 && columns (varargin{1}) > 1) - dims = varargin{1}; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("unidrnd: invalid dimension vector"); + error ("unidrnd: dimension vector must be row vector of non-negative integers"); endif elseif (nargin > 2) - for i = 1:nargin-1 - if (! isscalar (varargin{i})) - error ("unidrnd: expecting scalar dimensions"); - endif - endfor - dims = [varargin{:}]; + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("unidrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("unidrnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("unidrnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n)) + if (n > 0 && n == fix (n)) + rnd = ceil (rand (sz) * n); + else + rnd = NaN (sz, cls); + endif else - print_usage (); + rnd = ceil (rand (sz) .* n); + + k = ! (n > 0 & n == fix (n)); + rnd(k) = NaN; endif - if (isscalar (n) - || (length (size (n)) == length (dims) && all (size (n) == dims))) - retval = ceil (rand (dims) .* n); - else - error ("unidrnd: dimension mismatch"); - endif + endfunction + + +%!assert(size (unidrnd (2)), [1, 1]); +%!assert(size (unidrnd (ones(2,1))), [2, 1]); +%!assert(size (unidrnd (ones(2,2))), [2, 2]); +%!assert(size (unidrnd (10, [4 1])), [4, 1]); +%!assert(size (unidrnd (10, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (unidrnd (2)), "double"); +%!assert(class (unidrnd (single(2))), "single"); +%!assert(class (unidrnd (single([2 2]))), "single"); + +%% Test input validation +%!error unidrnd () +%!error unidrnd (10, [1;2;3]) +%!error unidrnd (10, 2, ones(2)) +%!error unidrnd (10*ones(2), 2, 1) +%!error unidrnd (i) +
--- a/scripts/statistics/distributions/unifcdf.m +++ b/scripts/statistics/distributions/unifcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,9 +18,11 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unifcdf (@var{x}, @var{a}, @var{b}) -## Return the CDF at @var{x} of the uniform distribution on [@var{a}, -## @var{b}], i.e., PROB (uniform (@var{a}, @var{b}) @leq{} x). +## @deftypefn {Function File} {} unifcdf (@var{x}) +## @deftypefnx {Function File} {} unifcdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the uniform distribution on the interval +## [@var{a}, @var{b}]. ## ## Default values are @var{a} = 0, @var{b} = 1. ## @end deftypefn @@ -27,44 +30,69 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: CDF of the uniform distribution -function cdf = unifcdf (x, a, b) +function cdf = unifcdf (x, a = 0, b = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - a = 0; - b = 1; - endif - - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("unifcdf: X, A and B must be of common size or scalar"); + error ("unifcdf: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - cdf = zeros (sz); + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifcdf: X, A, and B must not be complex"); + endif - k = find (isnan (x) | !(a < b)); - if (any (k)) - cdf(k) = NaN; + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); endif - k = find ((x >= b) & (a < b)); - if (any (k)) - cdf(k) = 1; - endif + k = isnan (x) | !(a < b); + cdf(k) = NaN; + + k = (x >= b) & (a < b); + cdf(k) = 1; - k = find ((x > a) & (x < b)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - cdf(k) = (x(k) < b) .* (x(k) - a) ./ (b - a); - else - cdf(k) = (x(k) < b(k)) .* (x(k) - a(k)) ./ (b(k) - a(k)); - endif + k = (x > a) & (x < b); + if (isscalar (a) && isscalar (b)) + cdf(k) = (x(k) < b) .* (x(k) - a) / (b - a); + else + cdf(k) = (x(k) < b(k)) .* (x(k) - a(k)) ./ (b(k) - a(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2] + 1; +%! y = [0 0 0.5 1 1]; +%!assert(unifcdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(unifcdf (x, 1, 2*ones(1,5)), y); +%!assert(unifcdf (x, ones(1,5), 2), y); +%!assert(unifcdf (x, [2 1 NaN 1 1], 2), [NaN 0 NaN 1 1]); +%!assert(unifcdf (x, 1, 2*[0 1 NaN 1 1]), [NaN 0 NaN 1 1]); +%!assert(unifcdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(unifcdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(unifcdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(unifcdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(unifcdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error unifcdf () +%!error unifcdf (1,2) +%!error unifcdf (1,2,3,4) +%!error unifcdf (ones(3),ones(2),ones(2)) +%!error unifcdf (ones(2),ones(3),ones(2)) +%!error unifcdf (ones(2),ones(2),ones(3)) +%!error unifcdf (i, 2, 2) +%!error unifcdf (2, i, 2) +%!error unifcdf (2, 2, i) +
--- a/scripts/statistics/distributions/unifinv.m +++ b/scripts/statistics/distributions/unifinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,9 +18,11 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unifinv (@var{x}, @var{a}, @var{b}) +## @deftypefn {Function File} {} unifinv (@var{x}) +## @deftypefnx {Function File} {} unifinv (@var{x}, @var{a}, @var{b}) ## For each element of @var{x}, compute the quantile (the inverse of the -## CDF) at @var{x} of the uniform distribution on [@var{a}, @var{b}]. +## CDF) at @var{x} of the uniform distribution on the interval +## [@var{a}, @var{b}]. ## ## Default values are @var{a} = 0, @var{b} = 1. ## @end deftypefn @@ -27,39 +30,62 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the uniform distribution -function inv = unifinv (x, a, b) +function inv = unifinv (x, a = 0, b = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - a = 0; - b = 1; - endif - - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("unifinv: X, A and B must be of common size or scalar"); + error ("unifinv: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - inv = zeros (sz); - - k = find ((x < 0) | (x > 1) | isnan (x) | !(a < b)); - if (any (k)) - inv(k) = NaN; + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifinv: X, A, and B must not be complex"); endif - k = find ((x >= 0) & (x <= 1) & (a < b)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - inv(k) = a + x(k) .* (b - a); - else - inv(k) = a(k) + x(k) .* (b(k) - a(k)); - endif + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x >= 0) & (x <= 1) & (a < b); + if (isscalar (a) && isscalar (b)) + inv(k) = a + x(k) * (b - a); + else + inv(k) = a(k) + x(k) .* (b(k) - a(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(unifinv (x, ones(1,5), 2*ones(1,5)), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, 1, 2*ones(1,5)), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, ones(1,5), 2), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, [1 2 NaN 1 1], 2), [NaN NaN NaN 2 NaN]); +%!assert(unifinv (x, 1, 2*[1 0 NaN 1 1]), [NaN NaN NaN 2 NaN]); +%!assert(unifinv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 1 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(unifinv ([x, NaN], 1, 2), [NaN 1 1.5 2 NaN NaN]); +%!assert(unifinv (single([x, NaN]), 1, 2), single([NaN 1 1.5 2 NaN NaN])); +%!assert(unifinv ([x, NaN], single(1), 2), single([NaN 1 1.5 2 NaN NaN])); +%!assert(unifinv ([x, NaN], 1, single(2)), single([NaN 1 1.5 2 NaN NaN])); + +%% Test input validation +%!error unifinv () +%!error unifinv (1,2) +%!error unifinv (1,2,3,4) +%!error unifinv (ones(3),ones(2),ones(2)) +%!error unifinv (ones(2),ones(3),ones(2)) +%!error unifinv (ones(2),ones(2),ones(3)) +%!error unifinv (i, 2, 2) +%!error unifinv (2, i, 2) +%!error unifinv (2, 2, i) +
--- a/scripts/statistics/distributions/unifpdf.m +++ b/scripts/statistics/distributions/unifpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,9 +18,10 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unifpdf (@var{x}, @var{a}, @var{b}) -## For each element of @var{x}, compute the PDF at @var{x} of the uniform -## distribution on [@var{a}, @var{b}]. +## @deftypefn {Function File} {} unifpdf (@var{x}) +## @deftypefnx {Function File} {} unifpdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the probability density function (PDF) +## at @var{x} of the uniform distribution on the interval [@var{a}, @var{b}]. ## ## Default values are @var{a} = 0, @var{b} = 1. ## @end deftypefn @@ -27,39 +29,65 @@ ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: PDF of the uniform distribution -function pdf = unifpdf (x, a, b) +function pdf = unifpdf (x, a = 0, b = 1) if (nargin != 1 && nargin != 3) print_usage (); endif - if (nargin == 1) - a = 0; - b = 1; - endif - - if (!isscalar (a) || !isscalar(b)) + if (!isscalar (a) || !isscalar (b)) [retval, x, a, b] = common_size (x, a, b); if (retval > 0) - error ("unifpdf: X, A and B must be of common size or scalars"); + error ("unifpdf: X, A, and B must be of common size or scalars"); endif endif - sz = size (x); - pdf = zeros (sz); - - k = find (isnan (x) | !(a < b)); - if (any (k)) - pdf(k) = NaN; + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifpdf: X, A, and B must not be complex"); endif - k = find ((x >= a) & (x <= b)); - if (any (k)) - if (isscalar (a) && isscalar(b)) - pdf(k) = 1 ./ (b - a); - else - pdf(k) = 1 ./ (b(k) - a(k)); - endif + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(a < b); + pdf(k) = NaN; + + k = (x >= a) & (x <= b) & (a < b); + if (isscalar (a) && isscalar (b)) + pdf(k) = 1 / (b - a); + else + pdf(k) = 1 ./ (b(k) - a(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2] + 1; +%! y = [0 1 1 1 0]; +%!assert(unifpdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(unifpdf (x, 1, 2*ones(1,5)), y); +%!assert(unifpdf (x, ones(1,5), 2), y); +%!assert(unifpdf (x, [2 NaN 1 1 1], 2), [NaN NaN y(3:5)]); +%!assert(unifpdf (x, 1, 2*[0 NaN 1 1 1]), [NaN NaN y(3:5)]); +%!assert(unifpdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(unifpdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(unifpdf (single([x, NaN]), single(1), 2), single([y, NaN])); +%!assert(unifpdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error unifpdf () +%!error unifpdf (1,2) +%!error unifpdf (1,2,3,4) +%!error unifpdf (ones(3),ones(2),ones(2)) +%!error unifpdf (ones(2),ones(3),ones(2)) +%!error unifpdf (ones(2),ones(2),ones(3)) +%!error unifpdf (i, 2, 2) +%!error unifpdf (2, i, 2) +%!error unifpdf (2, 2, i) +
--- a/scripts/statistics/distributions/unifrnd.m +++ b/scripts/statistics/distributions/unifrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,75 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} unifrnd (@var{a}, @var{b}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, @var{sz}) -## Return an @var{r} by @var{c} or a @code{size (@var{sz})} matrix of -## random samples from the uniform distribution on [@var{a}, @var{b}]. -## Both @var{a} and @var{b} must be scalar or of size @var{r} by @var{c}. +## @deftypefn {Function File} {} unifrnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the uniform distribution on +## [@var{a}, @var{b}]. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{a} and @var{b}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the uniform distribution -function rnd = unifrnd (a, b, r, c) +function rnd = unifrnd (a, b, varargin) - if (nargin > 1) - if (!isscalar(a) || !isscalar(b)) - [retval, a, b] = common_size (a, b); - if (retval > 0) - error ("unifrnd: A and B must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("unifrnd: A and B must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("unifrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("unifrnd: C must be a positive integer"); - endif - sz = [r, c]; - - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("unifrnd: A and B must be scalar or of size [R, C]"); - endif - elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; - else - error ("unifrnd: R must be a positive integer or vector"); - endif - - if (any (size (a) != 1) - && (length (size (a)) != length (sz) || any (size (a) != sz))) - error ("unifrnd: A and B must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(a); - else - print_usage (); + if (iscomplex (a) || iscomplex (b)) + error ("unifrnd: A and B must not be complex"); endif - if (isscalar(a) && isscalar(b)) - if (find (!(-Inf < a) | !(a < b) | !(b < Inf))) - rnd = NaN(sz); + if (nargin == 2) + sz = size (a); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - rnd = a + (b - a) .* rand (sz); + error ("unifrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("unifrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (a) && !isequal (size (a), sz)) + error ("unifrnd: A and B must be scalar or of size SZ"); + endif + + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((-Inf < a) && (a < b) && (b < Inf)) + rnd = a + (b - a) * rand (sz); + else + rnd = NaN (sz, cls); endif else rnd = a + (b - a) .* rand (sz); - k = find (!(-Inf < a) | !(a < b) | !(b < Inf)); - if (any (k)) - rnd(k) = NaN; - endif + k = !(-Inf < a) | !(a < b) | !(b < Inf); + rnd(k) = NaN; endif endfunction + + +%!assert(size (unifrnd (1,2)), [1, 1]); +%!assert(size (unifrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (unifrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (unifrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (unifrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (unifrnd (1, 2, 3)), [3, 3]); +%!assert(size (unifrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (unifrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (unifrnd (1, 2)), "double"); +%!assert(class (unifrnd (single(1), 2)), "single"); +%!assert(class (unifrnd (single([1 1]), 2)), "single"); +%!assert(class (unifrnd (1, single(2))), "single"); +%!assert(class (unifrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error unifrnd () +%!error unifrnd (1) +%!error unifrnd (ones(3),ones(2)) +%!error unifrnd (ones(2),ones(3)) +%!error unifrnd (i, 2) +%!error unifrnd (2, i) +%!error unifrnd (1,2, -1) +%!error unifrnd (1,2, ones(2)) +%!error unifrnd (1, 2, [2 -1 2]) +%!error unifrnd (1,2, 1, ones(2)) +%!error unifrnd (1,2, 1, -1) +%!error unifrnd (ones(2,2), 2, 3) +%!error unifrnd (ones(2,2), 2, [3, 2]) +%!error unifrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/distributions/wblcdf.m +++ b/scripts/statistics/distributions/wblcdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,9 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} wblcdf (@var{x}, @var{scale}, @var{shape}) +## @deftypefn {Function File} {} wblcdf (@var{x}) +## @deftypefnx {Function File} {} wblcdf (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblcdf (@var{x}, @var{scale}, @var{shape}) ## Compute the cumulative distribution function (CDF) at @var{x} of the ## Weibull distribution with scale parameter @var{scale} and shape ## parameter @var{shape}, which is @@ -28,59 +31,83 @@ ## @ifnottex ## ## @example -## 1 - exp(-(x/scale)^shape) +## 1 - exp (-(x/scale)^shape) ## @end example ## ## @noindent ## for @var{x} @geq{} 0. +## +## Default values are @var{scale} = 1, @var{shape} = 1. ## @end ifnottex ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: CDF of the Weibull distribution -function cdf = wblcdf (x, scale, shape) +function cdf = wblcdf (x, scale = 1, shape = 1) if (nargin < 1 || nargin > 3) print_usage (); endif - if (nargin < 3) - shape = 1; - endif - - if (nargin < 2) - scale = 1; - endif - if (!isscalar (shape) || !isscalar (scale)) [retval, x, shape, scale] = common_size (x, shape, scale); if (retval > 0) - error ("wblcdf: X, SCALE and SHAPE must be of common size or scalar"); + error ("wblcdf: X, SCALE, and SHAPE must be of common size or scalars"); endif endif - cdf = NaN (size (x)); - - ok = ((shape > 0) & (shape < Inf) & (scale > 0) & (scale < Inf)); + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblcdf: X, SCALE, and SHAPE must not be complex"); + endif - k = find ((x <= 0) & ok); - if (any (k)) - cdf(k) = 0; + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); endif - k = find ((x > 0) & (x < Inf) & ok); - if (any (k)) - if (isscalar (shape) && isscalar (scale)) - cdf(k) = 1 - exp (- (x(k) / scale) .^ shape); - else - cdf(k) = 1 - exp (- (x(k) ./ scale(k)) .^ shape(k)); - endif - endif + ok = (shape > 0) & (shape < Inf) & (scale > 0) & (scale < Inf); + + k = (x <= 0) & ok; + cdf(k) = 0; - k = find ((x == Inf) & ok); - if (any (k)) - cdf(k) = 1; + k = (x == Inf) & ok; + cdf(k) = 1; + + k = (x > 0) & (x < Inf) & ok; + if (isscalar (shape) && isscalar (scale)) + cdf(k) = 1 - exp (- (x(k) / scale) .^ shape); + else + cdf(k) = 1 - exp (- (x(k) ./ scale(k)) .^ shape(k)); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1-exp(-x(2:4)), 1]; +%!assert(wblcdf (x, ones(1,5), ones(1,5)), y); +%!assert(wblcdf (x, 1, ones(1,5)), y); +%!assert(wblcdf (x, ones(1,5), 1), y); +%!assert(wblcdf (x, [0 1 NaN Inf 1], 1), [NaN 0 NaN NaN 1]); +%!assert(wblcdf (x, 1, [0 1 NaN Inf 1]), [NaN 0 NaN NaN 1]); +%!assert(wblcdf ([x(1:2) NaN x(4:5)], 1, 1), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(wblcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(wblcdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(wblcdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(wblcdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error wblcdf () +%!error wblcdf (1,2,3,4) +%!error wblcdf (ones(3),ones(2),ones(2)) +%!error wblcdf (ones(2),ones(3),ones(2)) +%!error wblcdf (ones(2),ones(2),ones(3)) +%!error wblcdf (i, 2, 2) +%!error wblcdf (2, i, 2) +%!error wblcdf (2, 2, i) +
--- a/scripts/statistics/distributions/wblinv.m +++ b/scripts/statistics/distributions/wblinv.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,57 +18,82 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} wblinv (@var{x}, @var{scale}, @var{shape}) +## @deftypefn {Function File} {} wblinv (@var{x}) +## @deftypefnx {Function File} {} wblinv (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblinv (@var{x}, @var{scale}, @var{shape}) ## Compute the quantile (the inverse of the CDF) at @var{x} of the ## Weibull distribution with scale parameter @var{scale} and shape ## parameter @var{shape}. +## +## Default values are @var{scale} = 1, @var{shape} = 1. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Quantile function of the Weibull distribution -function inv = wblinv (x, scale, shape) +function inv = wblinv (x, scale = 1, shape = 1) if (nargin < 1 || nargin > 3) print_usage (); endif - if (nargin < 3) - shape = 1; - endif - - if (nargin < 2) - scale = 1; - endif - if (!isscalar (scale) || !isscalar (shape)) [retval, x, scale, shape] = common_size (x, scale, shape); if (retval > 0) - error ("wblinv: X, SCALE and SHAPE must be of common size or scalar"); + error ("wblinv: X, SCALE, and SHAPE must be of common size or scalars"); endif endif - inv = NaN (size (x)); - - ok = ((scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf)); + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblinv: X, SCALE, and SHAPE must not be complex"); + endif - k = find ((x == 0) & ok); - if (any (k)) - inv(k) = 0; + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find ((x > 0) & (x < 1) & ok); - if (any (k)) - if (isscalar (scale) && isscalar (shape)) - inv(k) = scale * (- log (1 - x(k))) .^ (1 / shape); - else - inv(k) = scale(k) .* (- log (1 - x(k))) .^ (1 ./ shape(k)); - endif - endif + ok = (scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf); + + k = (x == 0) & ok; + inv(k) = 0; - k = find ((x == 1) & ok); - if (any (k)) - inv(k) = Inf; + k = (x == 1) & ok; + inv(k) = Inf; + + k = (x > 0) & (x < 1) & ok; + if (isscalar (scale) && isscalar (shape)) + inv(k) = scale * (- log (1 - x(k))) .^ (1 / shape); + else + inv(k) = scale(k) .* (- log (1 - x(k))) .^ (1 ./ shape(k)); endif endfunction + + +%!shared x +%! x = [-1 0 0.63212055882855778 1 2]; +%!assert(wblinv (x, ones(1,5), ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, 1, ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, ones(1,5), 1), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, [1 -1 NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(wblinv (x, 1, [1 -1 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(wblinv ([x(1:2) NaN x(4:5)], 1, 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(wblinv ([x, NaN], 1, 1), [NaN 0 1 Inf NaN NaN], eps); +%!assert(wblinv (single([x, NaN]), 1, 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(wblinv ([x, NaN], single(1), 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(wblinv ([x, NaN], 1, single(1)), single([NaN 0 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error wblinv () +%!error wblinv (1,2,3,4) +%!error wblinv (ones(3),ones(2),ones(2)) +%!error wblinv (ones(2),ones(3),ones(2)) +%!error wblinv (ones(2),ones(2),ones(3)) +%!error wblinv (i, 2, 2) +%!error wblinv (2, i, 2) +%!error wblinv (2, 2, i) +
--- a/scripts/statistics/distributions/wblpdf.m +++ b/scripts/statistics/distributions/wblpdf.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,7 +18,9 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} wblpdf (@var{x}, @var{scale}, @var{shape}) +## @deftypefn {Function File} {} wblpdf (@var{x}) +## @deftypefnx {Function File} {} wblpdf (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblpdf (@var{x}, @var{scale}, @var{shape}) ## Compute the probability density function (PDF) at @var{x} of the ## Weibull distribution with scale parameter @var{scale} and shape ## parameter @var{shape} which is given by @@ -27,57 +30,83 @@ ## @ifnottex ## ## @example -## shape * scale^(-shape) * x^(shape-1) * exp(-(x/scale)^shape) +## shape * scale^(-shape) * x^(shape-1) * exp (-(x/scale)^shape) ## @end example ## ## @end ifnottex ## @noindent ## for @var{x} @geq{} 0. +## +## Default values are @var{scale} = 1, @var{shape} = 1. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: PDF of the Weibull distribution -function pdf = wblpdf (x, scale, shape) +function pdf = wblpdf (x, scale = 1, shape = 1) if (nargin < 1 || nargin > 3) print_usage (); endif - if (nargin < 3) - shape = 1; - endif - - if (nargin < 2) - scale = 1; - endif - if (!isscalar (scale) || !isscalar (shape)) [retval, x, scale, shape] = common_size (x, scale, shape); if (retval > 0) - error ("wblpdf: X, SCALE and SHAPE must be of common size or scalar"); + error ("wblpdf: X, SCALE, and SHAPE must be of common size or scalars"); endif endif - pdf = NaN (size (x)); - ok = ((scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf)); + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblpdf: X, SCALE, and SHAPE must not be complex"); + endif - k = find ((x > -Inf) & (x < 0) & ok); - if (any (k)) - pdf(k) = 0; + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); endif - k = find ((x >= 0) & (x < Inf) & ok); - if (any (k)) - if (isscalar (scale) && isscalar (shape)) - pdf(k) = (shape .* (scale .^ -shape) - .* (x(k) .^ (shape - 1)) - .* exp(- (x(k) / scale) .^ shape)); - else - pdf(k) = (shape(k) .* (scale(k) .^ -shape(k)) - .* (x(k) .^ (shape(k) - 1)) - .* exp(- (x(k) ./ scale(k)) .^ shape(k))); - endif + ok = ((scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf)); + + k = (x < 0) & ok; + pdf(k) = 0; + + k = (x >= 0) & (x < Inf) & ok; + if (isscalar (scale) && isscalar (shape)) + pdf(k) = (shape * (scale .^ -shape) + .* (x(k) .^ (shape - 1)) + .* exp (- (x(k) / scale) .^ shape)); + else + pdf(k) = (shape(k) .* (scale(k) .^ -shape(k)) + .* (x(k) .^ (shape(k) - 1)) + .* exp (- (x(k) ./ scale(k)) .^ shape(k))); endif endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, exp(-x(2:4)), NaN]; +%!assert(wblpdf (x, ones(1,5), ones(1,5)), y); +%!assert(wblpdf (x, 1, ones(1,5)), y); +%!assert(wblpdf (x, ones(1,5), 1), y); +%!assert(wblpdf (x, [0 NaN Inf 1 1], 1), [NaN NaN NaN y(4:5)]); +%!assert(wblpdf (x, 1, [0 NaN Inf 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(wblpdf ([x, NaN], 1, 1), [y, NaN]); + +%% Test class of input preserved +%!assert(wblpdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(wblpdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(wblpdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error wblpdf () +%!error wblpdf (1,2,3,4) +%!error wblpdf (ones(3),ones(2),ones(2)) +%!error wblpdf (ones(2),ones(3),ones(2)) +%!error wblpdf (ones(2),ones(2),ones(3)) +%!error wblpdf (i, 2, 2) +%!error wblpdf (2, i, 2) +%!error wblpdf (2, 2, i) +
--- a/scripts/statistics/distributions/wblrnd.m +++ b/scripts/statistics/distributions/wblrnd.m @@ -1,3 +1,4 @@ +## Copyright (C) 2011 Rik Wehbring ## Copyright (C) 1995-2011 Kurt Hornik ## ## This file is part of Octave. @@ -17,78 +18,115 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{r}, @var{c}) -## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{sz}) -## Return an @var{r} by @var{c} matrix of random samples from the -## Weibull distribution with parameters @var{scale} and @var{shape} -## which must be scalar or of size @var{r} by @var{c}. Or if @var{sz} -## is a vector return a matrix of size @var{sz}. +## @deftypefn {Function File} {} wblrnd (@var{scale}, @var{shape}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{r}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, [@var{sz}]) +## Return a matrix of random samples from the Weibull distribution with +## parameters @var{scale} and @var{shape}. ## -## If @var{r} and @var{c} are omitted, the size of the result matrix is -## the common size of @var{alpha} and @var{sigma}. +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{scale} and @var{shape}. ## @end deftypefn ## Author: KH <Kurt.Hornik@wu-wien.ac.at> ## Description: Random deviates from the Weibull distribution -function rnd = wblrnd (scale, shape, r, c) +function rnd = wblrnd (scale, shape, varargin) - if (nargin > 1) - if (!isscalar(scale) || !isscalar(shape)) - [retval, scale, shape] = common_size (scale, shape); - if (retval > 0) - error ("wblrnd: SCALE and SHAPE must be of common size or scalar"); - endif + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (scale) || !isscalar (shape)) + [retval, scale, shape] = common_size (scale, shape); + if (retval > 0) + error ("wblrnd: SCALE and SHAPE must be of common size or scalars"); endif endif - if (nargin == 4) - if (! (isscalar (r) && (r > 0) && (r == round (r)))) - error ("wblrnd: R must be a positive integer"); - endif - if (! (isscalar (c) && (c > 0) && (c == round (c)))) - error ("wblrnd: C must be a positive integer"); - endif - sz = [r, c]; + if (iscomplex (scale) || iscomplex (shape)) + error ("wblrnd: SCALE and SHAPE must not be complex"); + endif - if (any (size (scale) != 1) - && ((length (size (scale)) != length (sz)) - || any (size (scale) != sz))) - error ("wblrnd: SCALE and SHAPE must be scalar or of size [R, C]"); - endif + if (nargin == 2) + sz = size (scale); elseif (nargin == 3) - if (isscalar (r) && (r > 0)) - sz = [r, r]; - elseif (isvector(r) && all (r > 0)) - sz = r(:)'; + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; else - error ("wblrnd: R must be a positive integer or vector"); + error ("wblrnd: dimension vector must be row vector of non-negative integers"); endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("wblrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif - if (any (size (scale) != 1) - && ((length (size (scale)) != length (sz)) - || any (size (scale) != sz))) - error ("wblrnd: SCALE and SHAPE must be scalar or of size SZ"); - endif - elseif (nargin == 2) - sz = size(scale); + if (!isscalar (scale) && !isequal (size (scale), sz)) + error ("wblrnd: SCALE and SHAPE must be scalar or of size SZ"); + endif + + if (isa (scale, "single") || isa (shape, "single")) + cls = "single"; else - print_usage (); + cls = "double"; endif if (isscalar (scale) && isscalar (shape)) - if (scale > 0 && scale < Inf && shape > 0 && shape < Inf) - rnd = scale .* rande(sz) .^ (1./shape); + if ((scale > 0) && (scale < Inf) && (shape > 0) && (shape < Inf)) + rnd = scale * rande (sz) .^ (1/shape); else - rnd = NaN (sz); + rnd = NaN (sz, cls); endif else - rnd = scale .* rande(sz) .^ (1./shape); - k = find ((scale <= 0) | (scale == Inf) | ((shape <= 0) & (shape == Inf))); - if (any(k)) - rnd(k) = NaN; - endif + rnd = scale .* rande (sz) .^ (1./shape); + + k = (scale <= 0) | (scale == Inf) | (shape <= 0) | (shape == Inf); + rnd(k) = NaN; endif endfunction + +%!assert(size (wblrnd (1,2)), [1, 1]); +%!assert(size (wblrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (wblrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (wblrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (wblrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (wblrnd (1, 2, 3)), [3, 3]); +%!assert(size (wblrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (wblrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (wblrnd (1, 2)), "double"); +%!assert(class (wblrnd (single(1), 2)), "single"); +%!assert(class (wblrnd (single([1 1]), 2)), "single"); +%!assert(class (wblrnd (1, single(2))), "single"); +%!assert(class (wblrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error wblrnd () +%!error wblrnd (1) +%!error wblrnd (ones(3),ones(2)) +%!error wblrnd (ones(2),ones(3)) +%!error wblrnd (i, 2) +%!error wblrnd (2, i) +%!error wblrnd (1,2, -1) +%!error wblrnd (1,2, ones(2)) +%!error wblrnd (1, 2, [2 -1 2]) +%!error wblrnd (1,2, 1, ones(2)) +%!error wblrnd (1,2, 1, -1) +%!error wblrnd (ones(2,2), 2, 3) +%!error wblrnd (ones(2,2), 2, [3, 2]) +%!error wblrnd (ones(2,2), 2, 2, 3) +
--- a/scripts/statistics/tests/anova.m +++ b/scripts/statistics/tests/anova.m @@ -88,7 +88,7 @@ v_b = SSB / df_b; v_w = SSW / df_w; f = v_b / v_w; - pval = 1 - f_cdf (f, df_b, df_w); + pval = 1 - fcdf (f, df_b, df_w); if (nargout == 0) ## This eventually needs to be done more cleanly ...
--- a/scripts/statistics/tests/cor_test.m +++ b/scripts/statistics/tests/cor_test.m @@ -91,7 +91,7 @@ m = method (1); if (m == "p") - r = cor (x, y); + r = corr (x, y); df = n - 2; t.method = "Pearson's product moment correlation"; t.params = df;
--- a/scripts/statistics/tests/f_test_regression.m +++ b/scripts/statistics/tests/f_test_regression.m @@ -68,7 +68,7 @@ [b, v] = ols (y, x); diff = rr * b - r; f = diff' * inv (rr * inv (x' * x) * rr') * diff / (q * v); - pval = 1 - f_cdf (f, df_num, df_den); + pval = 1 - fcdf (f, df_num, df_den); if (nargout == 0) printf (" pval: %g\n", pval);
--- a/scripts/statistics/tests/hotelling_test.m +++ b/scripts/statistics/tests/hotelling_test.m @@ -63,7 +63,7 @@ d = mean (x) - m; Tsq = n * d * (cov (x) \ d'); - pval = 1 - f_cdf ((n-p) * Tsq / (p * (n-1)), p, n-p); + pval = 1 - fcdf ((n-p) * Tsq / (p * (n-1)), p, n-p); if (nargout == 0) printf (" pval: %g\n", pval);
--- a/scripts/statistics/tests/hotelling_test_2.m +++ b/scripts/statistics/tests/hotelling_test_2.m @@ -76,7 +76,7 @@ d = mean (x) - mean (y); S = ((n_x - 1) * cov (x) + (n_y - 1) * cov (y)) / (n_x + n_y - 2); Tsq = (n_x * n_y / (n_x + n_y)) * d * (S \ d'); - pval = 1 - f_cdf ((n_x + n_y - p - 1) * Tsq / (p * (n_x + n_y - 2)), + pval = 1 - fcdf ((n_x + n_y - p - 1) * Tsq / (p * (n_x + n_y - 2)), p, n_x + n_y - p - 1); if (nargout == 0)
--- a/scripts/statistics/tests/manova.m +++ b/scripts/statistics/tests/manova.m @@ -34,7 +34,7 @@ ## Three test statistics (Wilks, Hotelling-Lawley, and Pillai-Bartlett) ## and corresponding approximate p-values are calculated and displayed. -## (Currently NOT because the f_cdf respectively betai code is too bad.) +## (Currently NOT because the fcdf respectively betai code is too bad.) ## Author: TF <Thomas.Fuereder@ci.tuwien.ac.at> ## Adapted-By: KH <Kurt.Hornik@wu-wien.ac.at> @@ -107,7 +107,7 @@ df_den = delta * eta - df_num / 2 + 1; WT = exp (- log (Lambda) / eta) - 1; - W_pval_2 = 1 - f_cdf (WT * df_den / df_num, df_num, df_den); + W_pval_2 = 1 - fcdf (WT * df_den / df_num, df_num, df_den); if (0) @@ -123,7 +123,7 @@ df_num = theta * (2 * u + theta + 1); df_den = 2 * (theta * v + 1); - HL_pval = 1 - f_cdf (HL * df_den / df_num, df_num, df_den); + HL_pval = 1 - fcdf (HL * df_den / df_num, df_num, df_den); ## Pillai-Bartlett ## =============== @@ -131,7 +131,7 @@ PB = sum (l ./ (1 + l)); df_den = theta * (2 * v + theta + 1); - PB_pval = 1 - f_cdf (PB * df_den / df_num, df_num, df_den); + PB_pval = 1 - fcdf (PB * df_den / df_num, df_num, df_den); printf ("\n"); printf ("One-way MANOVA Table:\n");
--- a/scripts/statistics/tests/mcnemar_test.m +++ b/scripts/statistics/tests/mcnemar_test.m @@ -42,7 +42,7 @@ if (! (min (size (x)) > 1) && issquare (x)) error ("mcnemar_test: X must be a square matrix of size > 1"); - elseif (! (all (all (x >= 0)) && all (all (x == round (x))))) + elseif (! (all (all (x >= 0)) && all (all (x == fix (x))))) error ("mcnemar_test: all entries of X must be nonnegative integers"); endif
--- a/scripts/statistics/tests/var_test.m +++ b/scripts/statistics/tests/var_test.m @@ -54,7 +54,7 @@ df_num = length (x) - 1; df_den = length (y) - 1; f = var (x) / var (y); - cdf = f_cdf (f, df_num, df_den); + cdf = fcdf (f, df_num, df_den); if (nargin == 2) alt = "!=";
--- a/scripts/statistics/tests/wilcoxon_test.m +++ b/scripts/statistics/tests/wilcoxon_test.m @@ -23,7 +23,7 @@ ## @var{y}) == 1/2. Under the null, the test statistic @var{z} ## approximately follows a standard normal distribution when @var{n} > 25. ## -## @strong{Warning}: This function assumes a normal distribution for @var{z} +## @strong{Caution:} This function assumes a normal distribution for @var{z} ## and thus is invalid for @var{n} @leq{} 25. ## ## With the optional argument string @var{alt}, the alternative of
--- a/scripts/strings/base2dec.m +++ b/scripts/strings/base2dec.m @@ -28,10 +28,12 @@ ## @end group ## @end example ## -## If @var{s} is a matrix, returns a column vector with one value per +## If @var{s} is a string matrix, return a column vector with one value per ## row of @var{s}. If a row contains invalid symbols then the -## corresponding value will be NaN@. Rows are right-justified before -## converting so that trailing spaces are ignored. +## corresponding value will be NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## value per cell element in @var{s}. ## ## If @var{base} is a string, the characters of @var{base} are used as the ## symbols for the digits of @var{s}. Space (' ') may not be used as a @@ -55,6 +57,12 @@ print_usage (); endif + if (iscellstr (s)) + s = char (s); + elseif (! ischar (s)) + error ("base2dec: S must be a string or cellstring"); + endif + symbols = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; if (ischar (base)) symbols = base; @@ -89,9 +97,11 @@ endfunction + %!assert(base2dec ("11120", 3), 123); %!assert(base2dec ("yyyzx", "xyz"), 123); %!assert(base2dec ("-1", 2), NaN); +%!assert(base2dec ({"A1", "1A"}, 16), [161; 26]); %%Test input validation %!error base2dec ();
--- a/scripts/strings/bin2dec.m +++ b/scripts/strings/bin2dec.m @@ -28,8 +28,11 @@ ## @end group ## @end example ## -## If @var{s} is a string matrix, return a column vector of converted -## numbers, one per row of @var{s}. Invalid rows evaluate to NaN. +## If @var{s} is a string matrix, return a column vector with one converted +## number per row of @var{s}; Invalid rows evaluate to NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## converted number per cell element in @var{s}. ## @seealso{dec2bin, base2dec, hex2dec} ## @end deftypefn @@ -38,17 +41,19 @@ function d = bin2dec (s) - if (nargin == 1 && ischar (s)) - d = base2dec (s, 2); - else + if (nargin != 1) print_usage (); endif + d = base2dec (s, 2); + endfunction + %!assert(bin2dec ("0000"), 0); %!assert(bin2dec ("1110"), 14); %!assert(bin2dec ("11111111111111111111111111111111111111111111111111111"), 2^53-1); +%!assert(bin2dec ({"1110", "1111"}), [14; 15]); %%Test input validation %!error bin2dec ();
--- a/scripts/strings/blanks.m +++ b/scripts/strings/blanks.m @@ -22,7 +22,7 @@ ## ## @example ## @group -## blanks(10); +## blanks (10); ## whos ans; ## @result{} ## Attr Name Size Bytes Class @@ -40,7 +40,7 @@ if (nargin != 1) print_usage (); - elseif (! (isscalar (n) && n == round (n))) + elseif (! (isscalar (n) && n == fix (n) && n >= 0)) error ("blanks: N must be a non-negative integer"); endif @@ -50,14 +50,16 @@ endfunction + ## There really isn't that much to test here %!assert(blanks (0), "") %!assert(blanks (5), " ") %!assert(blanks (10), " ") -%!assert(strcmp (blanks (3), " ")); +%% Test input validation +%!error blanks () +%!error blanks (1, 2) +%!error blanks (ones (2)) +%!error blanks (2.1) +%!error blanks (-2) -%!error blanks (); - -%!error blanks (1, 2); -
--- a/scripts/strings/deblank.m +++ b/scripts/strings/deblank.m @@ -18,10 +18,22 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} deblank (@var{s}) -## Remove trailing blanks and nulls from @var{s}. If @var{s} +## Remove trailing whitespace and nulls from @var{s}. If @var{s} ## is a matrix, @var{deblank} trims each row to the length of longest -## string. If @var{s} is a cell array, operate recursively on each -## element of the cell array. +## string. If @var{s} is a cell array of strings, operate recursively on each +## string element. +## +## Examples: +## @example +## @group +## deblank (" abc ") +## @result{} " abc" +## +## deblank ([" abc "; " def "]) +## @result{} [" abc " ; " def"] +## @end group +## @end example +## @seealso{strtrim} ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> @@ -33,53 +45,44 @@ print_usage (); endif - char_arg = ischar (s); - - if (char_arg || isnumeric (s)) + if (ischar (s)) - if (! isempty (s)) - if (char_arg) - k = find (! isspace (s) & s != "\0"); - else - warning ("deblank: expecting character string argument"); - k = find (s != 0); - endif - - if (isempty (k)) - s = resize (s, 0, 0); - else - s = s(:,1:ceil (max (k) / rows (s))); - endif + k = find (! isspace (s) & s != "\0"); + if (isempty (s) || isempty (k)) + s = ""; + else + s = s(:,1:ceil (max (k) / rows (s))); endif - elseif (iscell(s)) + elseif (iscell (s)) - s = cellfun (@deblank, s, "uniformoutput", false); + char_idx = cellfun ("isclass", s, "char"); + cell_idx = cellfun ("isclass", s, "cell"); + if (! all (char_idx | cell_idx)) + error ("deblank: S argument must be a string or cellstring"); + endif + + ## Divide work load. Recursive cellfun deblank call is slow + ## and avoided where possible. + s(char_idx) = regexprep (s(char_idx), "[\\s\v\\0]+$", ''); + s(cell_idx) = cellfun ("deblank", s(cell_idx), "UniformOutput", false); else - error ("deblank: expecting character string argument"); + error ("deblank: S argument must be a string or cellstring"); endif endfunction -%!assert (strcmp (deblank (" f o o "), " f o o")); - -%!assert (deblank ([]), []) -%!assert (deblank ({}), {}) -%!assert (deblank (""), "") - -%!assert (deblank ([0,0,0]), []) -%!assert (deblank (' '), '') -%!assert (deblank (" "), "") -%!assert (typeinfo (deblank (" ")), "string") -%!assert (typeinfo (deblank (' ')), "sq_string") - -%!assert (deblank ([1,2,0]), [1,2]) -%!assert (deblank ([1,2,0,32]), [1,2,0,32]) +%!assert (deblank (" f o o \0"), " f o o"); +%!assert (deblank (' '), ''); +%!assert (deblank (" "), ""); +%!assert (deblank (""), ""); +%!assert (deblank ({}), {}); +%!assert (deblank ({" abc ", {" def "}}), {" abc", {" def"}}); -%!assert (deblank (int8 ([1,2,0])), int8 ([1,2])) +%!error <Invalid call to deblank> deblank (); +%!error <Invalid call to deblank> deblank ("foo", "bar"); +%!error <argument must be a string> deblank (1); +%!error <argument must be a string> deblank ({[]}); -%!error deblank (); - -%!error deblank ("foo", "bar");
--- a/scripts/strings/dec2base.m +++ b/scripts/strings/dec2base.m @@ -29,8 +29,9 @@ ## @end group ## @end example ## -## If @var{d} is a vector, return a string matrix with one row per value, -## padded with leading zeros to the width of the largest value. +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. ## ## If @var{base} is a string then the characters of @var{base} are used as ## the symbols for the digits of @var{d}. Space (' ') may not be used @@ -57,13 +58,17 @@ print_usage (); endif + if (iscell (d)) + d = cell2mat (d); + endif + # Create column vector for algorithm - if (columns (d) > 1 || !isvector (d)) + if (! iscolumn (d)) d = d(:); endif - if (any (d < 0 | d != fix (d))) - error ("dec2base: input must be non-negative integers"); + if (! isnumeric (d) || iscomplex (d) || any (d < 0 | d != fix (d))) + error ("dec2base: input must be real non-negative integers"); endif symbols = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; @@ -84,7 +89,7 @@ ## determine number of digits required to handle all numbers, can overflow ## by 1 digit - max_len = round (log (max (max (d), 1)) ./ log (base)) + 1; + max_len = round (log (max (max (d(:)), 1)) / log (base)) + 1; if (nargin == 3) max_len = max (max_len, len); @@ -93,12 +98,12 @@ ## determine digits for each number digits = zeros (length (d), max_len); for k = max_len:-1:1 - digits(:,k) = mod(d, base); + digits(:,k) = mod (d, base); d = round ((d - digits(:,k)) / base); endfor ## convert digits to symbols - retval = reshape (symbols (digits+1), size (digits)); + retval = reshape (symbols(digits+1), size (digits)); ## Check if the first element is the zero symbol. It seems possible ## that LEN is provided, and is less than the computed MAX_LEN and @@ -106,51 +111,56 @@ ## have a leading zero to remove. But if LEN >= MAX_LEN, we should ## not remove any leading zeros. if ((nargin == 2 || (nargin == 3 && max_len > len)) - && all (retval(:,1) == symbols(1)) && length (retval) != 1) + && length (retval) != 1 && ! any (retval(:,1) != symbols(1))) retval = retval(:,2:end); endif endfunction + %!test -%! s0=''; -%! for n=1:13 -%! for b=2:16 -%! pp=dec2base(b^n+1,b); -%! assert(dec2base(b^n,b),['1',s0,'0']); -%! assert(dec2base(b^n+1,b),['1',s0,'1']); -%! end -%! s0=[s0,'0']; -%! end +%! s0 = ''; +%! for n = 1:13 +%! for b = 2:16 +%! pp = dec2base (b^n+1, b); +%! assert (dec2base(b^n, b), ['1',s0,'0']); +%! assert (dec2base(b^n+1, b), ['1',s0,'1']); +%! endfor +%! s0 = [s0,'0']; +%! endfor %!test %! digits='0123456789ABCDEF'; -%! for n=1:13 -%! for b=2:16 -%! pm=dec2base(b^n-1,b); -%! assert(length(pm),n); -%! assert(all(pm==digits(b))); -%! end -%! end +%! for n = 1:13 +%! for b = 2:16 +%! pm = dec2base(b^n-1, b); +%! assert (length (pm), n); +%! assert (all (pm==digits(b))); +%! endfor +%! endfor %!test -%! for b=2:16 -%! assert(dec2base(0,b),'0'); -%! end +%! for b = 2:16 +%! assert (dec2base (0, b), '0'); +%! endfor -%!assert(dec2base(0,2,4), "0000"); -%!assert(dec2base(2^51-1,2), ... +%!assert(dec2base (0, 2, 4), "0000"); +%!assert(dec2base (2^51-1, 2), ... %! '111111111111111111111111111111111111111111111111111'); -%!assert(dec2base(uint64(2)^63-1,16), '7FFFFFFFFFFFFFFF'); +%!assert(dec2base(uint64(2)^63-1, 16), '7FFFFFFFFFFFFFFF'); +%!assert(dec2base([1, 2; 3, 4], 2, 3), ["001"; "011"; "010"; "100"]); +%!assert(dec2base({1, 2; 3, 4}, 2, 3), ["001"; "011"; "010"; "100"]); %%Test input validation %!error dec2base () %!error dec2base (1) %!error dec2base (1, 2, 3, 4) +%!error dec2base ("A") +%!error dec2base (2i) %!error dec2base (-1) %!error dec2base (1.1) -%!error dec2base (1,"ABA") -%!error dec2base (1,"A B") +%!error dec2base (1, "ABA") +%!error dec2base (1, "A B") %!error dec2base (1, ones(2)) %!error dec2base (1, 1) %!error dec2base (1, 37)
--- a/scripts/strings/dec2bin.m +++ b/scripts/strings/dec2bin.m @@ -28,8 +28,9 @@ ## @end group ## @end example ## -## If @var{d} is a vector, returns a string matrix, one row per value, -## padded with leading zeros to the width of the largest value. +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. ## ## The optional second argument, @var{len}, specifies the minimum ## number of digits in the result. @@ -51,8 +52,10 @@ endfunction -%!assert(strcmp (dec2bin (14), "1110")); -%!assert(strcmp (dec2bin (14, 6), "001110")); + +%!assert(dec2bin (14), "1110"); +%!assert(dec2bin (14, 6), "001110"); +%!assert(dec2bin ({1, 2; 3, 4}), ["001"; "011"; "010"; "100"]); %%Test input validation %!error dec2bin ();
--- a/scripts/strings/dec2hex.m +++ b/scripts/strings/dec2hex.m @@ -28,8 +28,9 @@ ## @end group ## @end example ## -## If @var{d} is a vector, return a string matrix, one row per value, -## padded with leading zeros to the width of the largest value. +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. ## ## The optional second argument, @var{len}, specifies the minimum ## number of digits in the result. @@ -51,8 +52,10 @@ endfunction -%!assert(strcmpi (dec2hex (2748), "abc")); -%!assert(strcmpi (dec2hex (2748, 5), "00abc")); + +%!assert(dec2hex (2748), "ABC"); +%!assert(dec2hex (2748, 5), "00ABC"); +%!assert(dec2hex ({2748, 2746}), ["ABC"; "ABA"]); %% Test input validation %!error dec2hex ();
--- a/scripts/strings/findstr.m +++ b/scripts/strings/findstr.m @@ -17,20 +17,24 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} findstr (@var{s}, @var{t}, @var{overlap}) +## @deftypefn {Function File} {} findstr (@var{s}, @var{t}) +## @deftypefnx {Function File} {} findstr (@var{s}, @var{t}, @var{overlap}) ## Return the vector of all positions in the longer of the two strings ## @var{s} and @var{t} where an occurrence of the shorter of the two starts. -## If the optional argument @var{overlap} is nonzero, the returned vector +## If the optional argument @var{overlap} is true, the returned vector ## can include overlapping positions (this is the default). For example: ## ## @example ## @group ## findstr ("ababab", "a") -## @result{} [1, 3, 5] +## @result{} [1, 3, 5]; ## findstr ("abababa", "aba", 0) ## @result{} [1, 5] ## @end group ## @end example +## +## @strong{Caution:} @code{findstr} is scheduled for deprecation. Use +## @code{strfind} in all new code. ## @seealso{strfind, strmatch, strcmp, strncmp, strcmpi, strncmpi, find} ## @end deftypefn @@ -40,7 +44,7 @@ ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ## Adapted-By: jwe -function v = findstr (s, t, overlap) +function v = findstr (s, t, overlap = true) if (nargin < 2 || nargin > 3) print_usage (); @@ -50,15 +54,9 @@ error ("findstr: arguments must have only one non-singleton dimension"); endif - if (nargin == 2) - overlap = 1; - endif - ## Make S be the longer string. if (length (s) < length (t)) - tmp = s; - s = t; - t = tmp; + [s, t] = deal (t, s); endif l_s = length (s); @@ -126,18 +124,20 @@ v = []; endif - ## Always return a column vector, because that's what the old one did. - if (rows (v) > 1) + ## Always return a row vector, because that's what the old one did. + if (iscolumn (v)) v = v.'; endif endfunction -%!assert ((findstr ("abababa", "a") == [1, 3, 5, 7] -%! && findstr ("abababa", "aba") == [1, 3, 5] -%! && findstr ("abababa", "aba", 0) == [1, 5])); + +%!assert (findstr ("abababa", "a"), [1, 3, 5, 7]) +%!assert (findstr ("abababa", "aba"), [1, 3, 5]); +%!assert (findstr ("aba", "abababa", 0), [1, 5]); -%!error findstr (); +%% Test input validation +%!error findstr () +%!error findstr ("foo", "bar", 3, 4); +%!error findstr (["AB" ; "CD"], "C"); -%!error findstr ("foo", "bar", 3, 4); -
--- a/scripts/strings/hex2dec.m +++ b/scripts/strings/hex2dec.m @@ -30,8 +30,12 @@ ## @end group ## @end example ## -## If @var{s} is a string matrix, returns a column vector of converted -## numbers, one per row of @var{s}. Invalid rows evaluate to NaN. +## If @var{s} is a string matrix, return a column vector with one converted +## number per row of @var{s}; Invalid rows evaluate to NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## converted number per cell element in @var{s}. +## ## @seealso{dec2hex, base2dec, bin2dec} ## @end deftypefn @@ -40,17 +44,19 @@ function d = hex2dec (s) - if (nargin == 1 && ischar (s)) - d = base2dec (s, 16); - else + if (nargin != 1) print_usage (); endif + d = base2dec (s, 16); + endfunction + %!assert(hex2dec ("0000"), 0); %!assert(hex2dec ("1FFFFFFFFFFFFF"), 2^53-1); -%!assert(hex2dec ("12b") == 299 && hex2dec ("12B") == 299); +%!assert(hex2dec (["12b"; "12B"]), [299; 299]); +%!assert(hex2dec ({"A1", "1A"}), [161; 26]); %%Test input validation %!error hex2dec ();
--- a/scripts/strings/index.m +++ b/scripts/strings/index.m @@ -20,7 +20,10 @@ ## @deftypefn {Function File} {} index (@var{s}, @var{t}) ## @deftypefnx {Function File} {} index (@var{s}, @var{t}, @var{direction}) ## Return the position of the first occurrence of the string @var{t} in the -## string @var{s}, or 0 if no occurrence is found. For example: +## string @var{s}, or 0 if no occurrence is found. @var{s} may also be a +## string array or cell array of strings. +## +## For example: ## ## @example ## @group @@ -31,70 +34,83 @@ ## ## If @var{direction} is @samp{"first"}, return the first element found. ## If @var{direction} is @samp{"last"}, return the last element found. -## The @code{rindex} function is equivalent to @code{index} with -## @var{direction} set to @samp{"last"}. ## -## @strong{Caution:} This function does not work for arrays of -## character strings. ## @seealso{find, rindex} ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ## Adapted-By: jwe +## This is patterned after the AWK function of the same name. -function n = index (s, t, direction) - - ## This is patterned after the AWK function of the same name. +function n = index (s, t, direction = "first") if (nargin < 2 || nargin > 3) print_usage (); - elseif (nargin < 3) - direction = "first"; endif - direction = lower (direction); + + if (ischar (s)) + if (! isrow (s)) + s = cellstr (s); # Handle string arrays by conversion to cellstr + endif + elseif (! iscellstr (s)) + error ("index: S must be a string, string array, or cellstr"); + endif f = strfind (s, t); - if (iscell (f)) + if (isempty (f)) + f = 0; + elseif (iscell (f)) f(cellfun ("isempty", f)) = {0}; - elseif (isempty (f)) - f = 0; endif - if (strcmp (direction, "last")) + direction = tolower (direction); + + if (strcmp (direction, "first")) if (iscell (f)) - n = cellfun (@min, f); + n = cellfun ("min", f); + else + n = f(1); + endif + elseif (strcmp (direction, "last")) + if (iscell (f)) + n = cellfun ("max", f); else n = f(end); endif - elseif (strcmp (direction, "first")) - if (iscell (f)) - n = cellfun (@max, f); - else - n = f(1); - endif else - error ("index: DIRECTION must be either \"first\" or \"last\""); + error ('index: DIRECTION must be either "first" or "last"'); endif + endfunction -## Test the function out -%!assert(index("astringbstringcstring", "s"), 2) -%!assert(index("astringbstringcstring", "st"), 2) -%!assert(index("astringbstringcstring", "str"), 2) -%!assert(index("astringbstringcstring", "string"), 2) -%!assert(index("abc---", "abc+++"), 0) + +%!assert (index ("foobarbaz", "b") == 4 && index ("foobarbaz", "z") == 9); + +%!assert (index("astringbstringcstring", "s"), 2) +%!assert (index("astringbstringcstring", "st"), 2) +%!assert (index("astringbstringcstring", "str"), 2) +%!assert (index("astringbstringcstring", "string"), 2) +%!assert (index("abc---", "abc+++"), 0) ## test everything out in reverse -%!assert(index("astringbstringcstring", "s", "last"), 16) -%!assert(index("astringbstringcstring", "st", "last"), 16) -%!assert(index("astringbstringcstring", "str", "last"), 16) -%!assert(index("astringbstringcstring", "string", "last"), 16) -%!assert(index("abc---", "abc+++", "last"), 0) - +%!assert (index("astringbstringcstring", "s", "last"), 16) +%!assert (index("astringbstringcstring", "st", "last"), 16) +%!assert (index("astringbstringcstring", "str", "last"), 16) +%!assert (index("astringbstringcstring", "string", "last"), 16) +%!assert (index("abc---", "abc+++", "last"), 0) -%!assert(index ("foobarbaz", "b") == 4 && index ("foobarbaz", "z") == 9); +%!test +%! str = char ("Hello", "World", "Goodbye", "World"); +%! assert (index (str, "o"), [5; 2; 2; 2]); +%! assert (index (str, "o", "last"), [5; 2; 3; 2]); +%! str = cellstr (str); +%! assert (index (str, "o"), [5; 2; 2; 2]); +%! assert (index (str, "o", "last"), [5; 2; 3; 2]); -%!error index (); +%% Test input validation +%!error index () +%!error index ("a") +%!error index ("a", "b", "first", "d") +%!error index (1, "bar") +%!error index ("foo", "bar", 3) -%!error index ("foo", "bar", 3); -
--- a/scripts/strings/isstrprop.m +++ b/scripts/strings/isstrprop.m @@ -84,47 +84,52 @@ function retval = isstrprop (str, prop) - if (nargin == 2) - switch (prop) - case "alpha" - retval = isalpha (str); - case {"alnum", "alphanum"} - retval = isalnum (str); - case "ascii" - retval = isascii (str); - case "cntrl" - retval = iscntrl (str); - case "digit" - retval = isdigit (str); - case {"graph", "graphic"} - retval = isgraph (str); - case "lower" - retval = islower (str); - case "print" - retval = isprint (str); - case "punct" - retval = ispunct (str); - case {"space", "wspace"} - retval = isspace (str); - case "upper" - retval = isupper (str); - case "xdigit" - retval = isxdigit (str); - otherwise - error ("isstrprop: invalid string property"); - endswitch - else + if (nargin != 2) print_usage (); endif + switch (prop) + case "alpha" + retval = isalpha (str); + case {"alnum", "alphanum"} + retval = isalnum (str); + case "ascii" + retval = isascii (str); + case "cntrl" + retval = iscntrl (str); + case "digit" + retval = isdigit (str); + case {"graph", "graphic"} + retval = isgraph (str); + case "lower" + retval = islower (str); + case "print" + retval = isprint (str); + case "punct" + retval = ispunct (str); + case {"space", "wspace"} + retval = isspace (str); + case "upper" + retval = isupper (str); + case "xdigit" + retval = isxdigit (str); + otherwise + error ("isstrprop: invalid string property"); + endswitch + endfunction -%!error <invalid string property> isstrprop ("abc123", "foo") + %!assert (isstrprop ("abc123", "alpha"), logical ([1, 1, 1, 0, 0, 0])) +%!assert (isstrprop ("abc123", "digit"), logical ([0, 0, 0, 1, 1, 1])) %!assert (isstrprop ("Hello World", "wspace"), isspace ("Hello World")) %!assert (isstrprop ("Hello World", "graphic"), isgraph ("Hello World")) +%!assert (isstrprop (char ("AbC", "123"), "upper"), logical ([1 0 1; 0 0 0])) +%!assert (isstrprop ({"AbC", "123"}, "lower"), {logical([0 1 0]), logical([0 0 0])}) %%Input Validation %!error isstrprop () %!error isstrprop ("abc123") %!error isstrprop ("abc123", "alpha", "alpha") +%!error <invalid string property> isstrprop ("abc123", "foo") +
--- a/scripts/strings/mat2str.m +++ b/scripts/strings/mat2str.m @@ -18,20 +18,19 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{s} =} mat2str (@var{x}, @var{n}) -## @deftypefnx {Function File} {@var{s} =} mat2str (@dots{}, 'class') -## -## Format real/complex numerical matrices as strings. This function -## returns values that are suitable for the use of the @code{eval} -## function. +## @deftypefnx {Function File} {@var{s} =} mat2str (@var{x}, @var{n}, "class") +## Format real, complex, and logical matrices as strings. The +## returned string may be used to reconstruct the original matrix by using +## the @code{eval} function. ## ## The precision of the values is given by @var{n}. If @var{n} is a ## scalar then both real and imaginary parts of the matrix are printed -## to the same precision. Otherwise @code{@var{n} (1)} defines the -## precision of the real part and @code{@var{n} (2)} defines the -## precision of the imaginary part. The default for @var{n} is 17. +## to the same precision. Otherwise @code{@var{n}(1)} defines the +## precision of the real part and @code{@var{n}(2)} defines the +## precision of the imaginary part. The default for @var{n} is 15. ## -## If the argument 'class' is given, then the class of @var{x} is -## included in the string in such a way that the eval will result in the +## If the argument "class" is given then the class of @var{x} is +## included in the string in such a way that @code{eval} will result in the ## construction of a matrix of the same class. ## ## @example @@ -40,10 +39,16 @@ ## @result{} "[-0.3333+0.14i;0.3333-0.14i]" ## ## mat2str ([ -1/3 +i/7; 1/3 -i/7 ], [4 2]) -## @result{} "[-0.3333+0i,0+0.14i;0.3333+0i,-0-0.14i]" +## @result{} "[-0.3333+0i 0+0.14i;0.3333+0i -0-0.14i]" +## +## mat2str (int16([1 -1]), "class") +## @result{} "int16([1 -1])" ## -## mat2str (int16([1 -1]), 'class') -## @result{} "int16([1,-1])" +## mat2str (logical (eye (2))) +## @result{} "[true false;false true]" +## +## isequal (x, eval (mat2str (x))) +## @result{} 1 ## @end group ## @end example ## @@ -52,35 +57,26 @@ ## Author: Rolf Fabian <fabian@tu-cottbus.de> -function s = mat2str (x, n, cls) - - if (nargin < 2 || isempty (n)) - ## Default precision - n = 17; - endif - - if (nargin < 3) - if (ischar (n)) - cls = n; - n = 17; - else - cls = ""; - endif - endif +function s = mat2str (x, n = 15, cls = "") if (nargin < 1 || nargin > 3 || ! (isnumeric (x) || islogical (x))) print_usage (); + elseif (ndims (x) > 2) + error ("mat2str: X must be two dimensional"); endif - if (ndims (x) > 2) - error ("mat2str: X must be two dimensional"); + if (nargin == 2 && ischar (n)) + cls = n; + n = 15; + elseif (isempty (n)) + n = 15; # Default precision endif x_islogical = islogical (x); x_iscomplex = iscomplex (x); if (x_iscomplex) - if (length (n) == 1) + if (isscalar (n)) n = [n, n]; endif fmt = sprintf ("%%.%dg%%+.%dgi", n(1), n(2)); @@ -107,7 +103,7 @@ endif else ## Non-scalar X, print brackets - fmt = cstrcat (fmt, ","); + fmt = cstrcat (fmt, " "); if (x_iscomplex) t = x.'; s = sprintf (fmt, [real(t(:))'; imag(t(:))']); @@ -120,20 +116,32 @@ s = cstrcat ("[", s); s(end) = "]"; - ind = find (s == ","); + idx = strfind (s, " "); nc = columns (x); - s(ind(nc:nc:end)) = ";"; + s(idx(nc:nc:end)) = ";"; endif if (strcmp ("class", cls)) - s = cstrcat (class(x), "(", s, ")"); + s = cstrcat (class (x), "(", s, ")"); endif + endfunction + +%!assert (mat2str (0.7), "0.7"); +%!assert (mat2str (pi), "3.14159265358979"); +%!assert (mat2str (pi, 5), "3.1416"); +%!assert (mat2str (single (pi), 5, "class"), "single(3.1416)"); %!assert (mat2str ([-1/3 + i/7; 1/3 - i/7], [4 2]), "[-0.3333+0.14i;0.3333-0.14i]") -%!assert (mat2str ([-1/3 +i/7; 1/3 -i/7], [4 2]), "[-0.3333+0i,0+0.14i;0.3333+0i,-0-0.14i]") -%!assert (mat2str (int16 ([1 -1]), 'class'), "int16([1,-1])") - +%!assert (mat2str ([-1/3 +i/7; 1/3 -i/7], [4 2]), "[-0.3333+0i 0+0.14i;0.3333+0i -0-0.14i]") +%!assert (mat2str (int16 ([1 -1]), 'class'), "int16([1 -1])") %!assert (mat2str (true), "true"); %!assert (mat2str (false), "false"); -%!assert (mat2str (logical (eye (2))), "[true,false;false,true]"); +%!assert (mat2str (logical (eye (2))), "[true false;false true]"); + +%% Test input validation +%!error mat2str () +%!error mat2str (1,2,3,4) +%!error mat2str (["Hello"]) +%!error mat2str (ones(3,3,2)) +
--- a/scripts/strings/regexptranslate.m +++ b/scripts/strings/regexptranslate.m @@ -18,14 +18,14 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} regexptranslate (@var{op}, @var{s}) -## Translate a string for use in a regular expression. This might +## Translate a string for use in a regular expression. This may ## include either wildcard replacement or special character escaping. -## The behavior can be controlled by the @var{op} that can have the +## The behavior is controlled by @var{op} which can take the following ## values ## ## @table @asis ## @item "wildcard" -## The wildcard characters @code{.}, @code{*} and @code{?} are replaced +## The wildcard characters @code{.}, @code{*}, and @code{?} are replaced ## with wildcards that are appropriate for a regular expression. ## For example: ## @@ -57,29 +57,31 @@ print_usage (); endif - if (ischar (op)) - op = tolower (op); - if (strcmp ("wildcard", op)) - y = regexprep (regexprep (regexprep (s, '\.', '\.'), '\*', - '.*'), '\?', '.'); - elseif (strcmp ("escape", op)) - ch = {'\$', '\.', '\?', '\[', '\]'}; - y = s; - for i = 1 : length (ch) - y = regexprep (y, ch{i}, ch{i}); - endfor - else - error ("regexptranslate: unexpected operation"); - endif + if (! ischar (op)) + error ("regexptranslate: operation OP must be a string"); + endif + + op = tolower (op); + if (strcmp ("wildcard", op)) + y = regexprep (regexprep (regexprep (s, '\.', '\.'), + '\*', '.*'), + '\?', '.'); + elseif (strcmp ("escape", op)) + y = regexprep (s, '([^\w])', '\$1'); else - error ("regexptranslate: expecting operation to be a string"); + error ("regexptranslate: invalid operation OP"); endif + endfunction -%!error <Invalid call to regexptranslate> regexptranslate (); -%!error <Invalid call to regexptranslate> regexptranslate ("wildcard"); -%!error <Invalid call to regexptranslate> regexptranslate ("a", "b", "c"); -%!error <unexpected operation> regexptranslate ("foo", "abc"); -%!error <expecting operation to be a string> regexptranslate (10, "abc"); + %!assert (regexptranslate ("wildcard", "/a*b?c."), "/a.*b.c\\.") -%!assert (regexptranslate ("escape", '$.?[]'), '\$\.\?\[\]') +%!assert (regexptranslate ("escape", '$.?[abc]'), '\$\.\?\[abc\]') + +%% Test input validation +%!error <Invalid call to regexptranslate> regexptranslate () +%!error <Invalid call to regexptranslate> regexptranslate ("wildcard") +%!error <Invalid call to regexptranslate> regexptranslate ("a", "b", "c") +%!error <invalid operation> regexptranslate ("foo", "abc") +%!error <operation OP must be a string> regexptranslate (10, "abc") +
--- a/scripts/strings/rindex.m +++ b/scripts/strings/rindex.m @@ -20,7 +20,9 @@ ## @deftypefn {Function File} {} rindex (@var{s}, @var{t}) ## Return the position of the last occurrence of the character string ## @var{t} in the character string @var{s}, or 0 if no occurrence is -## found. For example: +## found. @var{s} may also be a string array or cell array of strings. +## +## For example: ## ## @example ## @group @@ -29,18 +31,18 @@ ## @end group ## @end example ## -## @strong{Caution:} This function does not work for arrays of -## character strings. +## The @code{rindex} function is equivalent to @code{index} with +## @var{direction} set to @samp{"last"}. +## ## @seealso{find, index} ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ## Adapted-By: jwe +## This is patterned after the AWK function of the same name. function n = rindex (s, t) - ## This is patterned after the AWK function of the same name. - if (nargin != 2) print_usage (); endif @@ -49,9 +51,17 @@ endfunction + %!assert(rindex ("foobarbaz", "b") == 7 && rindex ("foobarbaz", "o") == 3); -%!error rindex (); +%!test +%! str = char ("Hello", "World", "Goodbye", "World"); +%! assert (rindex (str, "o"), [5; 2; 3; 2]); +%! str = cellstr (str); +%! assert (rindex (str, "o"), [5; 2; 3; 2]); -%!error rindex ("foo", "bar", 3); +%% Test input validation +%!error rindex () +%!error rindex ("foo") +%!error rindex ("foo", "bar", "last")
--- a/scripts/strings/str2num.m +++ b/scripts/strings/str2num.m @@ -17,7 +17,7 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {@var{x} =} str2num (@var{s}) +## @deftypefn {Function File} {@var{x} =} str2num (@var{s}) ## @deftypefnx {Function File} {[@var{x}, @var{state}] =} str2num (@var{s}) ## Convert the string (or character array) @var{s} to a number (or an ## array). Examples: @@ -35,13 +35,15 @@ ## @end example ## ## The optional second output, @var{state}, is logically true when the -## coversion is successful. If the conversion fails the numeric output, +## coversion is successful. If the conversion fails the numeric output, ## @var{x}, is empty and @var{state} is false. ## ## @strong{Caution:} As @code{str2num} uses the @code{eval} function ## to do the conversion, @code{str2num} will execute any code contained ## in the string @var{s}. Use @code{str2double} for a safer and faster ## conversion. +## +## For cell array of strings use @code{str2double}. ## @seealso{str2double, eval} ## @end deftypefn @@ -49,31 +51,35 @@ function [m, state] = str2num (s) - if (nargin == 1 && ischar (s)) - [nr, nc] = size (s); - sep = ";"; - sep = sep (ones (nr, 1), 1); - s = sprintf ("m = [%s];", reshape ([s, sep]', 1, nr * (nc + 1))); - state = true; - eval (s, "m = []; state = false;"); - if (ischar (m)) - m = []; - state = false; - endif - else + if (nargin != 1) print_usage (); + elseif (! ischar (s)) + error ("str2num: S must be a string or string array"); + endif + + s(:, end+1) = ";"; + s = sprintf ("m = [%s];", reshape (s', 1, numel (s))); + state = true; + eval (s, "m = []; state = false;"); + if (ischar (m)) + m = []; + state = false; endif endfunction -%!assert(str2num ("-1.3e2") == -130 && str2num ("[1, 2; 3, 4]") == [1, 2; 3, 4]); -%!error str2num (); - -%!error str2num ("string", 1); +%!assert(str2num ("-1.3e2"), -130); +%!assert(str2num ("[1, 2; 3, 4]"), [1, 2; 3, 4]); %!test %! [x, state] = str2num ("pi"); -%! assert (state) -%! [x, state] = str2num (tmpnam); -%! assert (! state) +%! assert (state); +%! [x, state] = str2num ("Hello World"); +%! assert (! state); + +%% Test input validation +%!error str2num () +%!error str2num ("string", 1) +%!error <S must be a string> str2num ({"string"}) +
--- a/scripts/strings/strcat.m +++ b/scripts/strings/strcat.m @@ -61,14 +61,14 @@ elseif (nargin > 1) ## Convert to cells of strings uo = "uniformoutput"; - reals = cellfun (@isreal, varargin); + reals = cellfun ("isreal", varargin); if (any (reals)) - varargin(reals) = cellfun (@char, varargin(reals), uo, false); + varargin(reals) = cellfun ("char", varargin(reals), uo, false); endif - chars = cellfun (@ischar, varargin); + chars = cellfun ("isclass", varargin, "char"); allchar = all (chars); - varargin(chars) = cellfun (@cellstr, varargin(chars), uo, false); - if (! all (cellfun (@iscell, varargin))) + varargin(chars) = cellfun ("cellstr", varargin(chars), uo, false); + if (! all (cellfun ("isclass", varargin, "cell"))) error ("strcat: inputs must be strings or cells of strings"); endif @@ -81,7 +81,7 @@ endif ## Cellfun handles everything for us. - st = cellfun (@horzcat, varargin{:}, uo, false); + st = cellfun ("horzcat", varargin{:}, uo, false); if (allchar) ## If all inputs were strings, return strings.
--- a/scripts/strings/strchr.m +++ b/scripts/strings/strchr.m @@ -20,8 +20,9 @@ ## @deftypefn {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}) ## @deftypefnx {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}, @var{n}) ## @deftypefnx {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}, @var{n}, @var{direction}) +## @deftypefnx {Function File} {[@var{i}, @var{j}] =} strchr (@dots{}) ## Search for the string @var{str} for occurrences of characters from -## the set @var{chars}. The return value, as well as the @var{n} and +## the set @var{chars}. The return value(s), as well as the @var{n} and ## @var{direction} arguments behave identically as in @code{find}. ## ## This will be faster than using regexp in most cases. @@ -30,12 +31,18 @@ ## @end deftypefn function varargout = strchr (str, chars, varargin) - if (nargin < 2 || ! ischar (str) || ! ischar (chars)) + + if (nargin < 2) print_usage (); + elseif (! ischar (str)) + error ("strchr: STR argument must be a string or string array"); + elseif (! ischar (chars)) + error ("strchr: CHARS argument must be a string"); endif + if (isempty (chars)) mask = false (size (str)); - elseif (length (chars) <= 6) + elseif (length (chars) <= 4) ## With a few characters, it pays off to build the mask incrementally. ## We do it via a for loop to save memory. mask = str == chars(1); @@ -43,22 +50,31 @@ mask |= str == chars(i); endfor else - ## Index the str into a mask of valid values. This is slower than - ## it could be because of the +1 issue. - f = false (1, 256); + ## Index the str into a mask of valid values. + ## This is slower than it could be because of the +1 issue. + f = false (256, 1); f(uint8(chars)+1) = true; ## Default goes via double -- unnecessarily long. si = uint32 (str); - ## in-place + ## in-place is faster than str+1 ++si; mask = reshape (f(si), size (str)); endif + varargout = cell (1, nargout); varargout{1} = []; [varargout{:}] = find (mask, varargin{:}); + endfunction -%!assert(strchr("Octave is the best software",""),zeros(1,0)) -%!assert(strchr("Octave is the best software","best"),[3, 6, 9, 11, 13, 15, 16, 17, 18, 20, 23, 27]) -%!assert(strchr("Octave is the best software","software"),[3, 4, 6, 9, 11, 13, 16, 17, 18, 20, 21, 22, 23, 24, 25, 26, 27]) + +%!assert (strchr ("Octave is the best software", ""), zeros (1,0)) +%!assert (strchr ("Octave is the best software", "best"), [3, 6, 9, 11, 13, 15, 16, 17, 18, 20, 23, 27]) +%!assert (strchr ("Octave is the best software", "software"), [3, 4, 6, 9, 11, 13, 16, 17, 18, 20, 21, 22, 23, 24, 25, 26, 27]) +%% Test input validation +%!error strchr () +%!error strchr (1) +%!error <STR argument must be a string> strchr (1, "aeiou") +%!error <CHARS argument must be a string> strchr ("aeiou", 1) +
--- a/scripts/strings/strjust.m +++ b/scripts/strings/strjust.m @@ -18,10 +18,11 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} strjust (@var{s}, @var{pos}) +## @deftypefn {Function File} {} strjust (@var{s}) +## @deftypefnx {Function File} {} strjust (@var{s}, @var{pos}) ## Return the text, @var{s}, justified according to @var{pos}, which may ## be @samp{"left"}, @samp{"center"}, or @samp{"right"}. If @var{pos} -## is omitted, @samp{"right"} is assumed. +## is omitted it defaults to @samp{"right"}. ## ## Null characters are replaced by spaces. All other character ## data are treated as non-white space. @@ -41,69 +42,71 @@ ## @seealso{deblank, strrep, strtrim, untabify} ## @end deftypefn -function y = strjust (s, pos) +function y = strjust (s, pos = "right") if (nargin < 1 || nargin > 2) print_usage (); - endif - - if (nargin == 1) - pos = "right"; - else - pos = tolower (pos); - endif - - if (ndims (s) != 2) - error ("strjust: input must be a string or character matrix"); + elseif (! ischar (s) || ndims (s) > 2) + error ("strjust: S must be a string or 2-D character matrix"); endif if (isempty (s)) y = s; - else - ## Apparently, Matlab considers nulls to be blanks as well; however, does - ## not preserve the nulls, but rather converts them to blanks. That's a - ## bit unexpected, but it allows simpler processing, because we can move - ## just the nonblank characters. So we'll do the same here. + return; + endif - [nr, nc] = size (s); - ## Find the indices of all nonblanks. - nonbl = s != " " & s != "\0"; - [idx, jdx] = find (nonbl); + ## Apparently, Matlab considers nulls to be blanks as well; however, does + ## not preserve the nulls, but rather converts them to blanks. That's a + ## bit unexpected, but it allows simpler processing, because we can move + ## just the nonblank characters. So we'll do the same here. + + [nr, nc] = size (s); + ## Find the indices of all nonblanks. + nonbl = s != " " & s != "\0"; + [idx, jdx] = find (nonbl); - if (strcmp (pos, "right")) - ## We wish to find the maximum column index for each row. Because jdx is - ## sorted, we can take advantage of the fact that assignment is processed - ## sequentially and for duplicate indices the last value will remain. - maxs = nc * ones (nr, 1); - maxs(idx) = jdx; - shift = nc - maxs; - elseif (strcmp (pos, "left")) - ## See above for explanation. - mins = ones (nr, 1); - mins(flipud (idx(:))) = flipud (jdx(:)); - shift = 1 - mins; - else - ## Use both of the above. - mins = ones (nr, 1); - mins(flipud (idx(:))) = flipud (jdx(:)); - maxs = nc * ones (nr, 1); - maxs(idx) = jdx; - shift = floor ((nc + 1 - maxs - mins) / 2); - endif + if (strcmpi (pos, "right")) + ## We wish to find the maximum column index for each row. Because jdx is + ## sorted, we can take advantage of the fact that assignment is processed + ## sequentially and for duplicate indices the last value will remain. + maxs = repmat (nc, [nr, 1]); + maxs(idx) = jdx; + shift = nc - maxs; + elseif (strcmpi (pos, "left")) + ## See above for explanation. + mins = ones (nr, 1); + mins(flipud (idx(:))) = flipud (jdx(:)); + shift = 1 - mins; + else + ## Use both of the above to achieve centering. + mins = ones (nr, 1); + mins(flipud (idx(:))) = flipud (jdx(:)); + maxs = repmat (nc, [nr, 1]); + maxs(idx) = jdx; + shift = floor ((nc + 1 - maxs - mins) / 2); + endif - ## Adjust the column indices. - jdx += shift (idx); + ## Adjust the column indices. + jdx += shift(idx); - ## Create a blank matrix and position the nonblank characters. - y = " "(ones (1, nr), ones (1, nc)); - y(sub2ind ([nr, nc], idx, jdx)) = s(nonbl); - endif + ## Create a blank matrix and position the nonblank characters. + y = repmat (" ", nr, nc); + y(sub2ind ([nr, nc], idx, jdx)) = s(nonbl); endfunction -%!error <Invalid call to strjust> strjust(); -%!error <Invalid call to strjust> strjust(["a";"ab"], "center", 1); + %!assert (strjust (["a"; "ab"; "abc"; "abcd"]), %! [" a";" ab"; " abc"; "abcd"]); -%!assert (strjust (["a"; "ab"; "abc"; "abcd"], "center"), +%!assert (strjust ([" a"; " ab"; "abc"; "abcd"], "left"), +%! ["a "; "ab "; "abc "; "abcd"]); +%!assert (strjust (["a"; "ab"; "abc"; "abcd"], "CENTER"), %! [" a "; " ab"; "abc "; "abcd"]); +%!assert (strjust (["";""]), ""); + +%% Test input validation +%!error <Invalid call to strjust> strjust () +%!error <Invalid call to strjust> strjust (["a";"ab"], "center", 1) +%!error <S must be a string> strjust (ones(3,3)) +%!error <S must be a string> strjust (char (ones(3,3,3))) +
--- a/scripts/strings/strmatch.m +++ b/scripts/strings/strmatch.m @@ -19,13 +19,15 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} strmatch (@var{s}, @var{A}, "exact") -## Return indices of entries of @var{A} that match the string @var{s}. -## The second argument @var{A} may be a string matrix or a cell array of -## strings. If the third argument @code{"exact"} is not given, then +## @deftypefn {Function File} {} strmatch (@var{s}, @var{A}) +## @deftypefnx {Function File} {} strmatch (@var{s}, @var{A}, "exact") +## Return indices of entries of @var{A} which begin with the string @var{s}. +## The second argument @var{A} must be a string, character matrix, or a cell +## array of strings. If the third argument @code{"exact"} is not given, then ## @var{s} only needs to match @var{A} up to the length of @var{s}. -## Trailing whitespace is ignored. -## Results are returned as a column vector. +## Trailing spaces and nulls in @var{s} and @var{A} are ignored when matching. +## option. +## ## For example: ## ## @example @@ -33,13 +35,16 @@ ## strmatch ("apple", "apple juice") ## @result{} 1 ## -## strmatch ("apple", ["apple pie"; "apple juice"; "an apple"]) +## strmatch ("apple", ["apple "; "apple juice"; "an apple"]) ## @result{} [1; 2] ## -## strmatch ("apple", @{"apple pie"; "apple juice"; "tomato"@}) -## @result{} [1; 2] +## strmatch ("apple", ["apple "; "apple juice"; "an apple"], "exact") +## @result{} [1] ## @end group ## @end example +## +## @strong{Caution:} @code{strmatch} is scheduled for deprecation. Use +## @code{strcmpi} or @code{strncmpi} in all new code. ## @seealso{strfind, findstr, strcmp, strncmp, strcmpi, strncmpi, find} ## @end deftypefn @@ -52,29 +57,19 @@ print_usage (); endif - if (! ischar (s)) + if (! ischar (s) || (! isempty (s) && ! isvector (s))) error ("strmatch: S must be a string"); + elseif (! (ischar (A) || iscellstr (A))) + error ("strmatch: A must be a string or cell array of strings"); endif - ## Truncate trailing whitespace. - s = strtrimr (s); - + ## Trim blanks and nulls from search string + s = regexprep (s, "[ \\0]+$", ''); len = length (s); exact = nargin == 3 && ischar (exact) && strcmp (exact, "exact"); - if (iscell (A)) - if (len > 0) - idx = find (strncmp (s, A, len)); - else - idx = find (strcmp (s, A)); - endif - if (exact) - ## We can't just use strcmp, because we need to ignore whitespace. - B = cellfun (@strtrimr, A(idx), "uniformoutput", false); - idx = idx (strcmp (s, B)); - endif - elseif (ischar (A)) + if (ischar (A)) [nr, nc] = size (A); if (len > nc) idx = []; @@ -82,34 +77,43 @@ match = all (bsxfun (@eq, A(:,1:len), s), 2); if (exact) AA = A(:,len+1:nc); - match &= all (AA == "\0" | AA == " ", 2); + match &= all (AA == " " | AA == "\0", 2); endif idx = find (match); endif else - error ("strmatch: A must be a string or cell array of strings"); + if (len > 0) + idx = find (strncmp (s, A, len)); + else + idx = find (strcmp (s, A)); + endif + if (exact) + ## We can't just use strcmp, because we need to ignore spaces at end. + B = regexprep (A(idx), "[ \\0]+$", ''); + idx = idx(strcmp (s, B)); + endif endif endfunction -## Removes nuls and blanks from the end of the array -function s = strtrimr (s) - blnks = s == "\0" | s == " "; - i = find (blnks, 1, "last"); - if (i && all (blnks(i:end))) - s = s(1:i-1); - endif -endfunction -%!error <Invalid call to strmatch> strmatch(); -%!error <Invalid call to strmatch> strmatch("a", "aaa", "exact", 1); %!assert (strmatch("a", {"aaa", "bab", "bbb"}), 1); %!assert (strmatch ("apple", "apple juice"), 1); -%!assert (strmatch ("apple", ["apple pie"; "apple juice"; "an apple"]), -%! [1; 2]); -%!assert (strmatch ("apple", {"apple pie"; "apple juice"; "tomato"}), -%! [1; 2]); +%!assert (strmatch ("apple", ["apple pie"; "apple juice"; "an apple"]), [1; 2]); +%!assert (strmatch ("apple", {"apple pie"; "apple juice"; "tomato"}), [1; 2]); %!assert (strmatch ("apple pie", "apple"), []); -%!assert (strmatch ("a b", {"a b", "a c", "c d"})); -%!assert (strmatch ("", {"", "foo", "bar", ""}), [1, 4]) -%!assert (strmatch ('', { '', '% comment line', 'var a = 5', ''}, 'exact'), [1,4]) +%!assert (strmatch ("a ", "a"), 1); +%!assert (strmatch ("a", "a \0", "exact"), 1); +%!assert (strmatch ("a b", {"a b", "a c", "c d"}), 1); +%!assert (strmatch ("", {"", "foo", "bar", ""}), [1, 4]); +%!assert (strmatch ('', { '', '% comment', 'var a = 5', ''}, 'exact'), [1,4]); + +%% Test input validation +%!error <Invalid call to strmatch> strmatch(); +%!error <Invalid call to strmatch> strmatch("a"); +%!error <Invalid call to strmatch> strmatch("a", "aaa", "exact", 1); +%!error <S must be a string> strmatch(1, "aaa"); +%!error <S must be a string> strmatch(char ("a", "bb"), "aaa"); +%!error <A must be a string> strmatch("a", 1); +%!error <A must be a string> strmatch("a", {"hello", [1]}); +
--- a/scripts/strings/strsplit.m +++ b/scripts/strings/strsplit.m @@ -17,53 +17,101 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{s}] =} strsplit (@var{p}, @var{sep}, @var{strip_empty}) -## Split a single string using one or more delimiters and return a cell -## array of strings. Consecutive delimiters and delimiters at +## @deftypefn {Function File} {[@var{cstr}] =} strsplit (@var{s}, @var{sep}) +## @deftypefnx {Function File} {[@var{cstr}] =} strsplit (@var{s}, @var{sep}, @var{strip_empty}) +## Split the string @var{s} using one or more separators @var{sep} and return +## a cell array of strings. Consecutive separators and separators at ## boundaries result in empty strings, unless @var{strip_empty} is true. ## The default value of @var{strip_empty} is false. +## +## 2-D character arrays are split at separators and at the original column +## boundaries. +## +## Example: +## @example +## strsplit ("a,b,c", ",") +## @result{} +## @{ +## [1,1] = a +## [1,2] = b +## [1,3] = c +## @} +## +## strsplit (["a,b" ; "cde"], ",") +## @result{} +## @{ +## [1,1] = a +## [1,2] = b +## [1,3] = cde +## @} +## @group +## @end group +## @end example ## @seealso{strtok} ## @end deftypefn -function s = strsplit (p, sep, strip_empty = false) +function cstr = strsplit (s, sep, strip_empty = false) - if (nargin < 2 || nargin > 3 || ! ischar (p) || rows (p) > 1 - || ! ischar (sep) || ! islogical (strip_empty)) + if (nargin < 2 || nargin > 3) print_usage (); + elseif (! ischar (s) || ! ischar (sep)) + error ("strsplit: S and SEP must be string values"); + elseif (! isscalar (strip_empty)) + error ("strsplit: STRIP_EMPTY must be a scalar value"); endif - if (isempty (p)) - s = cell (size (p)); + if (isempty (s)) + cstr = cell (size (s)); else - ## Split p according to delimiter. - if (isscalar (sep)) - ## Single separator. - idx = find (p == sep); - else - ## Multiple separators. - idx = strchr (p, sep); + if (rows (s) > 1) + ## For 2-D arrays, add separator character at line boundaries + ## and transform to single string + s(:, end+1) = sep(1); + s = reshape (s.', 1, numel (s)); + s(end) = []; endif - ## Get substring sizes. + ## Split s according to delimiter + if (isscalar (sep)) + ## Single separator + idx = find (s == sep); + else + ## Multiple separators + idx = strchr (s, sep); + endif + + ## Get substring lengths. if (isempty (idx)) - sizes = numel (p); + strlens = length (s); else - sizes = [idx(1)-1, diff(idx)-1, numel(p)-idx(end)]; + strlens = [idx(1)-1, diff(idx)-1, numel(s)-idx(end)]; endif ## Remove separators. - p(idx) = []; + s(idx) = []; if (strip_empty) ## Omit zero lengths. - sizes = sizes (sizes != 0); + strlens = strlens(strlens != 0); endif + ## Convert! - s = mat2cell (p, 1, sizes); + cstr = mat2cell (s, 1, strlens); endif endfunction -%!assert (all (strcmp (strsplit ("road to hell", " "), {"road", "to", "hell"}))) + +%!assert (strsplit ("road to hell", " "), {"road", "to", "hell"}) +%!assert (strsplit ("road to^hell", " ^"), {"road", "to", "hell"}) +%!assert (strsplit ("road to--hell", " -", true), {"road", "to", "hell"}) +%!assert (strsplit (["a,bc";",de"], ","), {"a", "bc", ones(1,0), "de "}) +%!assert (strsplit (["a,bc";",de"], ",", true), {"a", "bc", "de "}) +%!assert (strsplit (["a,bc";",de"], ", ", true), {"a", "bc", "de"}) -%!assert (all (strcmp (strsplit ("road to^hell", " ^"), {"road", "to", "hell"}))) +%% Test input validation +%!error strsplit () +%!error strsplit ("abc") +%!error strsplit ("abc", "b", true, 4) +%!error <S and SEP must be string values> strsplit (123, "b") +%!error <S and SEP must be string values> strsplit ("abc", 1) +%!error <STRIP_EMPTY must be a scalar value> strsplit ("abc", "def", ones(3,3)) -%!assert (all (strcmp (strsplit ("road to--hell", " -", true), {"road", "to", "hell"})))
--- a/scripts/strings/strtok.m +++ b/scripts/strings/strtok.m @@ -17,13 +17,18 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{tok}, @var{rem}] =} strtok (@var{str}, @var{delim}) +## @deftypefn {Function File} {[@var{tok}, @var{rem}] =} strtok (@var{str}) +## @deftypefnx {Function File} {[@var{tok}, @var{rem}] =} strtok (@var{str}, @var{delim}) ## -## Find all characters up to but not including the first character which -## is in the string delim. If @var{rem} is requested, it contains the -## remainder of the string, starting at the first delimiter. Leading -## delimiters are ignored. If @var{delim} is not specified, space is -## assumed. For example: +## Find all characters in the string @var{str} up to, but not including, the +## first character which is in the string @var{delim}. If @var{rem} is +## requested, it contains the remainder of the string, starting at the first +## delimiter. Leading delimiters are ignored. If @var{delim} is not +## specified, whitespace is assumed. @var{str} may also be a cell array of +## strings in which case the function executes on every individual string +## and returns a cell array of tokens and remainders. +## +## Examples: ## ## @example ## @group @@ -36,126 +41,184 @@ ## rem = *27+31 ## @end group ## @end example -## @seealso{index, strsplit} +## @seealso{index, strsplit, strchr, isspace} ## @end deftypefn -## FIXME: check what to do for a null delimiter - function [tok, rem] = strtok (str, delim) - if (nargin<1 || nargin > 2) + if (nargin < 1 || nargin > 2) print_usage (); + elseif (! (ischar (str) || iscellstr (str))) + error ("strtok: STR must be a string or cell array of strings."); + elseif (ischar (str) && ! isvector (str) &&! isempty (str)) + error ("strtok: STR cannot be a 2-D character array."); endif if (nargin < 2 || isempty (delim)) - delim = "\t\n\v\f\r "; + ws_delim = true; + else + ws_delim = false; endif if (isempty (str)) tok = rem = ""; - elseif (length (delim) > 3) - start = 1; - len = length (str); - while (start <= len) - if (all (str(start) != delim)) - break; - endif - start++; - endwhile - stop = start; - while (stop <= len) - if (any (str(stop) == delim)) - break; - endif - stop++; - endwhile - tok = str(start:stop-1); - rem = str(stop:len); - else - if (length (delim) == 1) - idx = find (str == delim); - elseif (length (delim) == 2) - idx = find (str == delim(1) | str == delim(2)); + elseif (ischar (str)) + if (ws_delim) + idx = isspace (str); + elseif (length (delim) <= 7) + ## Build index of delimiters incrementally for low N. + idx = str == delim(1); + for i = 2:length (delim) + idx |= str == delim(i); + endfor else - idx = find (str == delim(1) | str == delim(2) | str == delim(3)); + ## Index the str into a mask of valid values. Faster for large N. + f = false (256, 1); + ## This is slower than it could be because of the +1 issue. + f(uint8(delim)+1) = true; + ## Default goes via double -- unnecessarily long. + si = uint32 (str); + ## in-place is faster than str+1 + ++si; + idx = f(si); endif - if (isempty (idx)) + + idx_dlim = find (idx, 1); + idx_nodlim = find (! idx, 1); + if (isempty (idx_dlim)) + ## No delimiter. Return whole string. tok = str; rem = ""; + elseif (idx_dlim > idx_nodlim) + ## Normal case. No leading delimiters and at least 1 delimiter in STR. + tok = str(1:idx_dlim-1); + rem = str(idx_dlim:end); else - ## Find first non-leading delimiter. - skip = find (idx(:)' != 1:length(idx)); - if (isempty (skip)) - tok = str(idx(length(idx))+1:length(str)); + ## Leading delimiter found. + idx_dlim = find (idx(idx_nodlim+1:end), 1); + if (isempty (idx_dlim)) + ## No further delimiters. Return STR stripped of delimiter prefix. + tok = str(idx_nodlim:end); rem = ""; else - tok = str(skip(1):idx(skip(1))-1); - rem = str(idx(skip(1)):length(str)); + ## Strip delimiter prefix. Return STR up to 1st delimiter + tok = str(idx_nodlim:(idx_dlim + idx_nodlim -1)); + rem = str((idx_dlim + idx_nodlim):end); endif endif + else # Cell array of strings + if (ws_delim) + delim = '\s'; + endif + ptn = [ '^[' delim ']*','([^' delim ']+)','([' delim '].*)$' ]; + matches = regexp (str, ptn, "tokens"); + eidx = cellfun ("isempty", matches); + midx = ! eidx; + tok = cell (size (str)); + tok(eidx) = regexprep (str(eidx), [ '^[' delim ']+' ], ''); + ## Unwrap doubly nested cell array from regexp + tmp = [matches{midx}]; + if (! isempty (tmp)) + tmp = [tmp{:}]; + endif + tok(midx) = tmp(1:2:end); + if (isargout (2)) + rem = cell (size (str)); + rem(eidx) = {""}; + rem(midx) = tmp(2:2:end); + endif endif endfunction + %!demo %! strtok("this is the life") %! % split at the first space, returning "this" %!demo %! s = "14*27+31" -%! while 1 -%! [t,s] = strtok(s, "+-*/"); -%! printf("<%s>", t); -%! if isempty(s), break; endif -%! printf("<%s>", s(1)); +%! while (1) +%! [t, s] = strtok (s, "+-*/"); +%! printf ("<%s>", t); +%! if (isempty (s)) +%! break; +%! endif +%! printf ("<%s>", s(1)); %! endwhile %! printf("\n"); %! % ---------------------------------------------------- %! % Demonstrates processing of an entire string split on -%! % a variety of delimiters. Tokens and delimiters are -%! % printed one after another in angle brackets. The -%! % string is: +%! % a variety of delimiters. Tokens and delimiters are +%! % printed one after another in angle brackets. -%!# test the tokens for all cases -%!assert(strtok(""), ""); # no string -%!assert(strtok("this"), "this"); # no delimiter in string -%!assert(strtok("this "), "this"); # delimiter at end -%!assert(strtok("this is"), "this"); # delimiter in middle -%!assert(strtok(" this"), "this"); # delimiter at start -%!assert(strtok(" this "), "this"); # delimiter at start and end -%!assert(strtok(" "), ""(1:0)); # delimiter only +%% Test the tokens for all cases +%!assert (strtok (""), ""); # no string +%!assert (strtok ("this"), "this"); # no delimiter in string +%!assert (strtok ("this "), "this"); # delimiter at end +%!assert (strtok ("this is"), "this"); # delimiter in middle +%!assert (strtok (" this"), "this"); # delimiter at start +%!assert (strtok (" this "), "this"); # delimiter at start and end +%!assert (strtok (" "), ""(1:0)); # delimiter only + +%% Test the remainder for all cases +%!test [t,r] = strtok (""); assert (r, ""); +%!test [t,r] = strtok ("this"); assert (r, ""); +%!test [t,r] = strtok ("this "); assert (r, " "); +%!test [t,r] = strtok ("this is"); assert (r, " is"); +%!test [t,r] = strtok (" this"); assert (r, ""); +%!test [t,r] = strtok (" this "); assert (r, " "); +%!test [t,r] = strtok (" "); assert (r, ""); -%!# test the remainder for all cases -%!test [t,r] = strtok(""); assert(r, ""); -%!test [t,r] = strtok("this"); assert(r, char (zeros (1, 0))); -%!test [t,r] = strtok("this "); assert(r, " "); -%!test [t,r] = strtok("this is"); assert(r, " is"); -%!test [t,r] = strtok(" this"); assert(r, char (zeros (1, 0))); -%!test [t,r] = strtok(" this "); assert(r, " "); -%!test [t,r] = strtok(" "); assert(r, char (zeros (1, 0))); - -%!# simple check with 2 and 3 delimeters -%!assert(strtok("this is", "i "), "th"); -%!assert(strtok("this is", "ij "), "th"); +%% Test all tokens and remainders with cell array input +%!test +%! str = {"", "this", "this ", "this is", " this", " this ", " "}; +%! [t, r] = strtok (str); +%! assert (t{1}, ""); +%! assert (r{1}, ""); +%! assert (t{2}, "this"); +%! assert (r{2}, ""); +%! assert (t{3}, "this"); +%! assert (r{3}, " "); +%! assert (t{4}, "this"); +%! assert (r{4}, " is"); +%! assert (t{5}, "this"); +%! assert (r{5}, ""); +%! assert (t{6}, "this"); +%! assert (r{6}, " "); +%! assert (t{7}, ""); +%! assert (r{7}, ""); -%!# test all cases for 4 delimiters since a different -%!# algorithm is used when more than 3 delimiters -%!assert(strtok("","jkl "), ""); -%!assert(strtok("this","jkl "), "this"); -%!assert(strtok("this ","jkl "), "this"); -%!assert(strtok("this is","jkl "), "this"); -%!assert(strtok(" this","jkl "), "this"); -%!assert(strtok(" this ","jkl "), "this"); -%!assert(strtok(" ","jkl "), ""(1:0)); +%% Simple check for 2, 3, and 4 delimeters +%!assert(strtok ("this is", "i "), "th"); +%!assert(strtok ("this is", "ij "), "th"); +%!assert(strtok ("this is", "ijk "), "th"); -%!# test 'bad' string orientations -%!assert(strtok(" this "'), "this"'); # delimiter at start and end -%!assert(strtok(" this "',"jkl "), "this"'); +%% Test all cases for 8 delimiters since a different +%!# algorithm is used when more than 7 delimiters +%!assert (strtok ("","jklmnop "), ""); +%!assert (strtok ("this","jklmnop "), "this"); +%!assert (strtok ("this ","jklmnop "), "this"); +%!assert (strtok ("this is","jklmnop "), "this"); +%!assert (strtok (" this","jklmnop "), "this"); +%!assert (strtok (" this ","jklmnop "), "this"); +%!assert (strtok (" ","jklmnop "), ""(1:0)); -%!# test with TAB, LF, VT, FF, and CR +%% Test 'bad' string orientations +%!assert (strtok (" this ".'), "this".'); # delimiter at start and end +%!assert (strtok (" this ".',"jkl "), "this".'); + +%% Test with TAB, LF, VT, FF, and CR %!test %! for ch = "\t\n\v\f\r" %! [t, r] = strtok (cstrcat ("beg", ch, "end")); %! assert (t, "beg"); %! assert (r, cstrcat (ch, "end")) %! endfor + +%% Test input validation +%!error strtok () +%!error strtok ("a", "b", "c") +%!error <STR must be a string> strtok (1, "b") +%!error <STR cannot be a 2-D> strtok (char ("hello", "world"), "l") +
--- a/scripts/strings/strtrim.m +++ b/scripts/strings/strtrim.m @@ -18,20 +18,21 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} strtrim (@var{s}) -## Remove leading and trailing whitespace and nulls from @var{s}. If +## Remove leading and trailing whitespace from @var{s}. If ## @var{s} is a matrix, @var{strtrim} trims each row to the length of -## longest string. If @var{s} is a cell array, operate recursively on -## each element of the cell array. For example: +## longest string. If @var{s} is a cell array of strings, operate recursively +## on each string element. For example: ## ## @example ## @group ## strtrim (" abc ") -## @result{} "abc" +## @result{} "abc" ## ## strtrim ([" abc "; " def "]) -## @result{} ["abc "; " def"] +## @result{} ["abc " ; " def"] ## @end group ## @end example +## @seealso{deblank} ## @end deftypefn ## Author: John Swensen <jpswensen@jhu.edu> @@ -46,19 +47,28 @@ if (ischar (s)) - k = find (! isspace (s) & s != "\0"); + k = find (! isspace (s)); if (isempty (s) || isempty (k)) s = ""; else s = s(:, ceil (min (k) / rows (s)):ceil (max (k) / rows (s))); endif - elseif (iscell(s)) + elseif (iscell (s)) - s = regexprep (s, "^[\\s\v\\0]+|[\\s\v\\0]+$", ''); + char_idx = cellfun ("isclass", s, "char"); + cell_idx = cellfun ("isclass", s, "cell"); + if (! all (char_idx | cell_idx)) + error ("strtrim: S argument must be a string or cellstring"); + endif + + ## Divide work load. Recursive cellfun strtrim call is slow + ## and avoided where possible. + s(char_idx) = regexprep (s(char_idx), "^[\\s\v]+|[\\s\v]+$", ''); + s(cell_idx) = cellfun ("strtrim", s(cell_idx), "UniformOutput", false); else - error ("strtrim: S argument must be a string"); + error ("strtrim: S argument must be a string or cellstring"); endif endfunction @@ -69,8 +79,10 @@ %!assert (strtrim ("abc"), "abc"); %!assert (strtrim ([" abc "; " def "]), ["abc "; " def"]); %!assert (strtrim ({" abc "; " def "}), {"abc"; "def"}); +%!assert (strtrim ({" abc ", {" def "}}), {"abc", {"def"}}); %!error <Invalid call to strtrim> strtrim (); %!error <Invalid call to strtrim> strtrim ("abc", "def"); %!error <argument must be a string> strtrim (1); +%!error <argument must be a string> strtrim ({[]});
--- a/scripts/strings/strtrunc.m +++ b/scripts/strings/strtrunc.m @@ -19,10 +19,9 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} strtrunc (@var{s}, @var{n}) ## Truncate the character string @var{s} to length @var{n}. If @var{s} -## is a char matrix, then the number of columns is adjusted. -## +## is a character matrix, then the number of columns is adjusted. ## If @var{s} is a cell array of strings, then the operation is performed -## on its members and the new cell array is returned. +## on each cell element and the new cell array is returned. ## @end deftypefn function s = strtrunc (s, n) @@ -31,29 +30,49 @@ print_usage (); endif - if (ischar (s)) - s_was_char = true; - s = {s}; - else - s_was_char = false; + n = fix (n); + if (! isscalar (n) || n < 0) + error ("strtrunc: length N must be a positive integer (N >= 0)"); endif - if (iscellstr (s)) - for i = 1:(numel (s)) - s{i} = s{i}(:,1:(min (n, columns (s{i})))); - endfor + if (ischar (s)) + if (n < columns (s)) + s = s(:, 1:n); + endif + elseif (iscellstr (s)) + ## Convoluted approach converts cellstr to char matrix, trims the character + ## matrix using indexing, and then converts back to cellstr with mat2cell. + ## This approach is 24X faster than using cellfun with call to strtrunc + idx = cellfun ("size", s, 2) > n; + rows = cellfun ("size", s(idx), 1); + if (! isempty (rows)) + s(idx) = mat2cell (char (s(idx))(:, 1:n), rows); + endif else error ("strtrunc: S must be a character string or a cell array of strings"); endif - if (s_was_char) - s = s{:}; - endif - endfunction -%!error <Invalid call to strtrunc> strtrunc (); -%!error <S must be a character string or a cell array of strings> strtrunc (1, 1) + %!assert (strtrunc("abcdefg", 4), "abcd"); %!assert (strtrunc("abcdefg", 10), "abcdefg"); +%!assert (strtrunc(char ("abcdef", "fedcba"), 3), ["abc"; "fed"]); %!assert (strtrunc({"abcdef", "fedcba"}, 3), {"abc", "fed"}); +%!assert (strtrunc({"", "1", "21", "321"}, 1), {"", "1", "2", "3"}) +%!assert (strtrunc({"1", "", "2"}, 1), {"1", "", "2"}) +%!test +%! cstr = {"line1"; ["line2"; "line3"]; "line4"}; +%! y = strtrunc (cstr, 4); +%! assert (size (y), [3, 1]); +%! assert (size (y{2}), [2, 4]); +%! assert (y{2}, repmat ("line", 2, 1)); + +%% Test input validation +%!error strtrunc () +%!error strtrunc ("abcd") +%!error strtrunc ("abcd", 4, 5) +%!error <N must be a positive integer> strtrunc ("abcd", ones (2,2)) +%!error <N must be a positive integer> strtrunc ("abcd", -1) +%!error <S must be a character string or a cell array of strings> strtrunc (1, 1) +
--- a/scripts/strings/substr.m +++ b/scripts/strings/substr.m @@ -17,25 +17,32 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {} substr (@var{s}, @var{offset}, @var{len}) +## @deftypefn {Function File} {} substr (@var{s}, @var{offset}) +## @deftypefnx {Function File} {} substr (@var{s}, @var{offset}, @var{len}) ## Return the substring of @var{s} which starts at character number ## @var{offset} and is @var{len} characters long. ## -## If @var{offset} is negative, extraction starts that far from the end of -## the string. If @var{len} is omitted, the substring extends to the end -## of S. +## Position numbering for offsets begins with 1. If @var{offset} is negative, +## extraction starts that far from the end of the string. +## +## If @var{len} is omitted, the substring extends to the end of @var{S}. A +## negative value for @var{len} extracts to within @var{len} characters of +## the end of the string ## -## For example: +## Examples: ## ## @example ## @group ## substr ("This is a test string", 6, 9) ## @result{} "is a test" +## substr ("This is a test string", -11) +## @result{} "test string" +## substr ("This is a test string", -11, -7) +## @result{} "test" ## @end group ## @end example ## -## This function is patterned after AWK@. You can get the same result by -## @code{@var{s}(@var{offset} : (@var{offset} + @var{len} - 1))}. +## This function is patterned after the equivalent function in Perl. ## @end deftypefn ## Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> @@ -47,34 +54,60 @@ print_usage (); endif - if (ischar (s)) - nc = columns (s); - if (abs (offset) > 0 && abs (offset) <= nc) - if (offset <= 0) - offset += nc + 1; - endif - if (nargin == 2) - eos = nc; - else - eos = offset + len - 1; - endif - if (eos <= nc) - t = s (:, offset:eos); - else - error ("substr: length = %d out of range", len); - endif + if (! ischar (s)) + error ("substr: S must be a string or string array"); + elseif (! isscalar (offset) || (nargin == 3 && ! isscalar (len))) + error ("substr: OFFSET and LEN must be scalar integers"); + endif + + offset = fix (offset); + nc = columns (s); + if (abs (offset) > nc || offset == 0) + error ("substr: OFFSET = %d out of range", offset); + endif + + if (offset <= 0) + offset += nc + 1; + endif + + if (nargin == 2) + eos = nc; + else + len = fix (len); + if (len < 0) + eos = nc + len; else - error ("substr: OFFSET = %d out of range", offset); + eos = offset + len - 1; endif - else - error ("substr: expecting string argument"); endif + if (eos > nc) + error ("substr: length LEN = %d out of range", len); + elseif (offset > eos && len != 0) + error ("substr: No overlap with chosen values of OFFSET and LEN"); + endif + + t = s(:, offset:eos); + endfunction -%!assert(strcmp (substr ("This is a test string", 6, 9), "is a test")); + +%!assert (substr ("This is a test string", 6, 9), "is a test"); +%!assert (substr ("This is a test string", -11), "test string"); +%!assert (substr ("This is a test string", -11, 4), "test"); +%!assert (substr ("This is a test string", -11, -7), "test"); +%!assert (substr ("This is a test string", 1, -7), "This is a test"); +%!assert (isempty (substr ("This is a test string", 1, 0))); -%!error substr (); +%% Test input validation +%!error substr () +%!error substr ("foo", 2, 3, 4) +%!error substr (ones (5, 1), 1, 1) +%!error substr ("foo", ones(2,2)) +%!error substr ("foo", 1, ones(2,2)) +%!error substr ("foo", 0) +%!error substr ("foo", 5) +%!error substr ("foo", 1, 5) +%!error substr ("foo", -1, 5) +%!error substr ("foo", 2, -5) -%!error substr ("foo", 2, 3, 4); -
--- a/scripts/strings/untabify.m +++ b/scripts/strings/untabify.m @@ -52,64 +52,72 @@ function s = untabify (t, tw = 8, dblank = false) - if (nargin > 0 && nargin < 4 && (ischar (t) || iscellstr (t))) - if (ischar (t)) - s = replace_tabs (t, tw); - else - s = cellfun (@(str) replace_tabs (str, tw), t, "uniformoutput", false); - endif - if (dblank) - s = deblank (s); - endif - else - print_usage (); - endif + if (nargin < 1 || nargin > 3) + print_usage (); + elseif (! (ischar (t) || iscellstr (t))) + error ("untabify: T must be a string or cellstring"); + endif + + if (ischar (t)) + s = replace_tabs (t, tw); + else + s = cellfun (@(str) replace_tabs (str, tw), t, "uniformoutput", false); + endif + + if (dblank) + s = deblank (s); + endif endfunction function s = replace_tabs (t, tw) - if (ndims (t) == 2) - if (isempty (t)) - s = t; - else - nr = rows (t); - sc = cell (nr, 1); - for j = 1:nr - n = 1:numel(t(j,:)); - m = find (t(j,:) == "\t"); - t(j,m) = " "; - for i = 1:numel(m) - k = tw * ceil (n(m(i)) / tw); - dn = k - n(m(i)); - n(m(i):end) += dn; - endfor - sc{j} = blanks (n(end)); - sc{j}(n) = t(j,:); - endfor - s = char (sc); - endif - else - error ("untabify: character strings to untabify must have 2 dimensions"); - endif + + if (ndims (t) != 2) + error ("untabify: character strings to untabify must have 2 dimensions"); + endif + + if (isempty (t)) + s = t; + else + nr = rows (t); + sc = cell (nr, 1); + for j = 1:nr + n = 1:numel(t(j,:)); + m = find (t(j,:) == "\t"); + t(j,m) = " "; + for i = 1:numel(m) + k = tw * ceil (n(m(i)) / tw); + dn = k - n(m(i)); + n(m(i):end) += dn; + endfor + sc{j} = blanks (n(end)); + sc{j}(n) = t(j,:); + endfor + s = char (sc); + endif + endfunction + %!test %! s = untabify ("\thello\t"); -%! assert (isequal (s, horzcat (blanks(8), "hello "))) +%! assert (s, [blanks(8) "hello" blanks(3)]); + +%!test +%! s = untabify ("\thello\t", 2); +%! assert (s, [blanks(2) "hello" blanks(1)]); %!test %! s = untabify ("\thello\t", 4, true); -%! assert (isequal (s, horzcat (blanks(4), "hello"))) +%! assert (s, [blanks(4) "hello"]); -%!test -%! s = untabify ("\thello\t", 2, true); -%! assert (isequal (s, horzcat (blanks(2), "hello"))) +%!assert (isempty (untabify (""))) %!test -%! s = untabify (""); -%! assert (isempty (s)) +%! s = char (randi ([97 97+25], 3, 3)); +%! assert (untabify (s), char (untabify (cellstr (s)))); -%!test -%! s = char (fix (100 + 10*rand (3,3))); -%! assert (isequal (untabify (s), untabify ({s}){1})) +%!error untabify () +%!error untabify (1,2,3,4) +%!error <must be a string> untabify (1)
--- a/scripts/strings/validatestring.m +++ b/scripts/strings/validatestring.m @@ -21,18 +21,37 @@ ## @deftypefnx {Function File} {@var{validstr} =} validatestring (@var{str}, @var{strarray}, @var{funcname}) ## @deftypefnx {Function File} {@var{validstr} =} validatestring (@var{str}, @var{strarray}, @var{funcname}, @var{varname}) ## @deftypefnx {Function File} {@var{validstr} =} validatestring (@dots{}, @var{position}) -## Verify that @var{str} is a string or substring of an element of +## Verify that @var{str} is an element, or substring of an element, in ## @var{strarray}. ## -## @var{str} is a character string to be tested, and @var{strarray} is a -## cellstr of valid values. @var{validstr} will be the validated form +## When @var{str} is a character string to be tested, and @var{strarray} is a +## cellstr of valid values, then @var{validstr} will be the validated form ## of @var{str} where validation is defined as @var{str} being a member -## or substring of @var{validstr}. If @var{str} is a substring of -## @var{validstr} and there are multiple matches, the shortest match -## will be returned if all matches are substrings of each other, and an -## error will be raised if the matches are not substrings of each other. +## or substring of @var{validstr}. This is useful for both verifying +## and expanding short options, such as "r", to their longer forms, such as +## "red". If @var{str} is a substring of @var{validstr}, and there are +## multiple matches, the shortest match will be returned if all matches are +## substrings of each other. Otherwise, an error will be raised because the +## expansion of @var{str} is ambiguous. All comparisons are case insensitive. +## +## The additional inputs @var{funcname}, @var{varname}, and @var{position} +## are optional and will make any generated validation error message more +## specific. +## +## Examples: ## -## All comparisons are case insensitive. +## @example +## @group +## validatestring ("r", @{"red", "green", "blue"@}) +## @result{} "red" +## +## validatestring ("b", @{"red", "green", "blue", "black"@}) +## @result{} error: validatestring: multiple unique matches were found for 'b': +## blue, black +## @end group +## @end example +## +## ## @seealso{strcmp, strcmpi} ## @end deftypefn @@ -44,55 +63,40 @@ print_usage (); endif - ## set the defaults - funcname = ""; - varname = ""; position = 0; - ## set the actual values - if (! isempty (varargin)) - if (isnumeric (varargin{end})) - position = varargin{end}; - varargin(end) = []; - endif + ## Process input arguments + if (! isempty (varargin) && isnumeric (varargin{end})) + position = varargin{end}; + varargin(end) = []; endif - funcnameset = false; - varnameset = false; - for i = 1:numel (varargin) - if (ischar (varargin{i})) - if (varnameset) - error ("validatestring: invalid number of character inputs: %d", - numel (varargin)); - elseif (funcnameset) - varname = varargin{i}; - varnameset = true; - else - funcname = varargin{i}; - funcnameset = true; - endif - endif - endfor + + funcname = varname = ""; + char_idx = cellfun ("isclass", varargin, "char"); + n_chararg = sum (char_idx); + if (n_chararg > 2) + error ("validatestring: invalid number of character inputs (3)"); + elseif (n_chararg == 2) + [funcname, varname] = deal (varargin{char_idx}); + elseif (n_chararg == 1) + funcname = varargin{char_idx}; + endif ## Check the inputs if (! ischar (str)) error ("validatestring: STR must be a character string"); - elseif (rows (str) != 1) - error ("validatestring: STR must have only one row"); + elseif (! isrow (str)) + error ("validatestring: STR must be a single row vector"); elseif (! iscellstr (strarray)) error ("validatestring: STRARRAY must be a cellstr"); - elseif (! ischar (funcname)) - error ("validatestring: FUNCNAME must be a character string"); - elseif (! isempty (funcname) && (rows (funcname) != 1)) - error ("validatestring: FUNCNAME must be exactly one row"); - elseif (! ischar (varname)) - error ("validatestring: VARNAME must be a character string"); - elseif (! isempty (varname) && (rows (varname) != 1)) - error ("validatestring: VARNAME must be exactly one row"); + elseif (! isempty (funcname) && ! isrow (funcname)) + error ("validatestring: FUNCNAME must be a single row vector"); + elseif (! isempty (varname) && ! isrow (varname)) + error ("validatestring: VARNAME must be a single row vector"); elseif (position < 0) error ("validatestring: POSITION must be >= 0"); endif - ## make the part of the error that will use funcname, varname, and - ## position + ## Make static part of error string that uses funcname, varname, and position errstr = ""; if (! isempty (funcname)) errstr = sprintf ("Function: %s ", funcname); @@ -109,35 +113,51 @@ matches = strncmpi (str, strarray(:), numel (str)); nmatches = sum (matches); - if (nmatches == 1) + if (nmatches == 0) + error ("validatestring: %s'%s' does not match any of\n%s", errstr, str, + sprintf ("%s, ", strarray{:})(1:end-2)); + elseif (nmatches == 1) str = strarray{matches}; - elseif (nmatches == 0) - error ("validatestring: %s%s does not match any of\n%s", errstr, str, - sprintf ("%s, ", strarray{:})(1:end-1)); else - ## are the matches a substring of each other, if so, choose the - ## shortest. If not, raise an error. + ## Are the matches substrings of each other? + ## If true, choose the shortest. If not, raise an error. match_idx = find (matches); - match_l = cellfun (@length, strarray(match_idx)); - longest_idx = find (match_l == max (match_l), 1); - shortest_idx = find (match_l == min (match_l), 1); - longest = strarray(match_idx)(longest_idx); - for i = 1:numel(match_idx) - currentmatch = strarray(match_idx(i)); - if (! strncmpi (longest, currentmatch, length(currentmatch))) - error ("validatestring: %smultiple unique matches were found for %s:\n%s", - errstr, sprintf ("%s, ", strarray(match_idx))(1:end-2)); - endif - endfor - str = strarray{shortest_idx}; + match_len = cellfun ("length", strarray(match_idx)); + [min_len, min_idx] = min (match_len); + short_str = strarray{match_idx(min_idx)}; + submatch = strncmpi (short_str, strarray(match_idx), min_len); + if (all (submatch)) + str = short_str; + else + error ("validatestring: %smultiple unique matches were found for '%s':\n%s", + errstr, str, sprintf ("%s, ", strarray{match_idx})(1:end-2)); + endif endif endfunction -## Tests + %!shared strarray %! strarray = {"octave" "Oct" "octopus" "octaves"}; %!assert (validatestring ("octave", strarray), "octave") %!assert (validatestring ("oct", strarray), "Oct") -%!assert (validatestring ("octave", strarray), "octave") -%!assert (validatestring ("octav", strarray), "octave") +%!assert (validatestring ("octa", strarray), "octave") +%! strarray = {"abc1" "def" "abc2"}; +%!assert (validatestring ("d", strarray), "def") +%!error <'xyz' does not match any> validatestring ("xyz", strarray) +%!error <Function: DUMMY_TEST> validatestring ("xyz", strarray, "DUMMY_TEST") +%!error <Function: DUMMY_TEST Variable: DUMMY_VAR:> validatestring ("xyz", strarray, "DUMMY_TEST", "DUMMY_VAR") +%!error <Function: DUMMY_TEST Variable: DUMMY_VAR Argument position 5> validatestring ("xyz", strarray, "DUMMY_TEST", "DUMMY_VAR", 5) +%!error <multiple unique matches were found for 'abc'> validatestring ("abc", strarray) + +%% Test input validation +%!error validatestring ("xyz") +%!error validatestring ("xyz", {"xyz"}, "3", "4", 5, 6) +%!error <invalid number of character inputs> validatestring ("xyz", {"xyz"}, "3", "4", "5") +%!error <STR must be a character string> validatestring (1, {"xyz"}, "3", "4", 5) +%!error <STR must be a single row vector> validatestring ("xyz".', {"xyz"}, "3", "4", 5) +%!error <STRARRAY must be a cellstr> validatestring ("xyz", "xyz", "3", "4", 5) +%!error <FUNCNAME must be a single row vector> validatestring ("xyz", {"xyz"}, "33".', "4", 5) +%!error <VARNAME must be a single row vector> validatestring ("xyz", {"xyz"}, "3", "44".', 5) +%!error <POSITION must be> validatestring ("xyz", {"xyz"}, "3", "4", -5) +
--- a/scripts/testfun/demo.m +++ b/scripts/testfun/demo.m @@ -17,35 +17,39 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Command} {} demo @var{name} @var{n} +## @deftypefn {Command} {} demo @var{name} +## @deftypefnx {Command} {} demo @var{name} @var{n} +## @deftypefnx {Function File} {} demo ('@var{name}') ## @deftypefnx {Function File} {} demo ('@var{name}', @var{n}) ## -## Runs any examples associated with the function '@var{name}'. +## Run example code block @var{n} associated with the function @var{name}. +## If @var{n} is not specified, all examples are run. +## ## Examples are stored in the script file, or in a file with the same -## name but no extension somewhere on your path. To keep them separate -## from the usual script code, all lines are prefixed by @code{%!}. Each -## example is introduced by the keyword 'demo' flush left to the prefix, -## with no intervening spaces. The remainder of the example can contain -## arbitrary Octave code. For example: +## name but no extension located on Octave's load path. To keep examples +## separate from regular script code, all lines are prefixed by @code{%!}. Each +## example must also be introduced by the keyword 'demo' flush left to the +## prefix with no intervening spaces. The remainder of the example can +## contain arbitrary Octave code. For example: ## ## @example ## @group -## %!demo -## %! t=0:0.01:2*pi; x = sin(t); -## %! plot(t,x) -## %! %------------------------------------------------- -## %! % the figure window shows one cycle of a sine wave +## %!demo +## %! t=0:0.01:2*pi; x = sin(t); +## %! plot (t,x) +## %! %------------------------------------------------- +## %! % the figure window shows one cycle of a sine wave ## @end group ## @end example ## ## Note that the code is displayed before it is executed, so a simple -## comment at the end suffices. It is generally not necessary to use -## disp or printf within the demo. +## comment at the end suffices for labeling what is being shown. It is +## generally not necessary to use @code{disp} or @code{printf} within the demo. ## ## Demos are run in a function environment with no access to external -## variables. This means that all demos in your function must use -## separate initialization code. Alternatively, you can combine your -## demos into one huge demo, with the code: +## variables. This means that every demo must have separate initialization +## code. Alternatively, all demos can be combined into a single large demo +## with the code ## ## @example ## %! input("Press <enter> to continue: ","s"); @@ -53,11 +57,13 @@ ## ## @noindent ## between the sections, but this is discouraged. Other techniques -## include using multiple plots by saying figure between each, or -## using subplot to put multiple plots in the same window. +## to avoid multiple initialization blocks include using multiple plots +## with a new @code{figure} command between each plot, or using @code{subplot} +## to put multiple plots in the same window. ## -## Also, since demo evaluates inside a function context, you cannot -## define new functions inside a demo. Instead you will have to +## Also, because demo evaluates within a function context, you cannot +## define new functions inside a demo. If you must have function blocks, +## rather than just anonymous functions or inline functions, you will have to ## use @code{eval(example('function',n))} to see them. Because eval only ## evaluates one line, or one statement if the statement crosses ## multiple lines, you must wrap your demo in "if 1 <demo stuff> endif" @@ -73,6 +79,7 @@ ## %! endif ## @end group ## @end example +## ## @seealso{test, example} ## @end deftypefn @@ -88,20 +95,19 @@ if (nargin < 2) n = 0; - elseif (strcmp ("char", class (n))) + elseif (ischar (n)) n = str2double (n); - endif + endif [code, idx] = test (name, "grabdemo"); - if (length (idx) == 0) - warning ("demo not available for %s", name); + if (isempty (idx)) + warning ("no demo available for %s", name); return; elseif (n >= length (idx)) warning ("only %d demos available for %s", length (idx) - 1, name); return; endif - if (n > 0) doidx = n; else @@ -123,7 +129,7 @@ __demo__; catch ## Let the programmer know which demo failed. - printf ("%s example %d: failed\n%s\n", name, doidx(i), __error_text__); + printf ("%s example %d: failed\n%s\n", name, doidx(i), lasterr ()); end_try_catch clear __demo__; endfor @@ -132,6 +138,9 @@ %!demo %! t=0:0.01:2*pi; x = sin(t); -%! plot(t,x) +%! plot (t,x) %! %------------------------------------------------- %! % the figure window shows one cycle of a sine wave + +%!error demo (); +%!error demo (1, 2, 3);
--- a/scripts/testfun/example.m +++ b/scripts/testfun/example.m @@ -17,16 +17,18 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Command} {} example @var{name} @var{n} +## @deftypefn {Command} {} example @var{name} +## @deftypefnx {Command} {} example @var{name} @var{n} +## @deftypefnx {Function File} {} example ('@var{name}') ## @deftypefnx {Function File} {} example ('@var{name}', @var{n}) -## @deftypefnx {Function File} {[@var{x}, @var{idx}] =} example ('@var{name}', @var{n}) +## @deftypefnx {Function File} {[@var{s}, @var{idx}] =} example (@dots{}) ## -## Display the code for example @var{n} associated with the function -## '@var{name}', but do not run it. If @var{n} is not given, all examples +## Display the code for example @var{n} associated with the function +## '@var{name}', but do not run it. If @var{n} is not specified, all examples ## are displayed. ## -## Called with output arguments, the examples are returned in the form of -## a string @var{x}, with @var{idx} indicating the ending position of the +## When called with output arguments, the examples are returned in the form of +## a string @var{s}, with @var{idx} indicating the ending position of the ## various examples. ## ## See @code{demo} for a complete explanation. @@ -41,9 +43,9 @@ if (nargin < 2) n = 0; - elseif (strcmp ("char", class (n))) + elseif (ischar (n)) n = str2double (n); - endif + endif [code, idx] = test (name, "grabdemo"); if (nargout > 0) @@ -65,15 +67,16 @@ else doidx = 1:length(idx)-1; endif - if (length (idx) == 0) - warning ("example not available for %s", name); + if (isempty (idx)) + warning ("no example available for %s", name); + return; elseif (n >= length(idx)) warning ("only %d examples available for %s", length(idx)-1, name); - doidx = []; + return; endif for i = 1:length (doidx) - block = code (idx(doidx(i)):idx(doidx(i)+1)-1); + block = code(idx(doidx(i)):idx(doidx(i)+1)-1); printf ("%s example %d:%s\n\n", name, doidx(i), block); endfor endif @@ -82,17 +85,18 @@ %!## warning: don't modify the demos without modifying the tests! %!demo -%! example('example'); +%! example ('example'); %!demo -%! t=0:0.01:2*pi; x=sin(t); -%! plot(t,x) +%! t=0:0.01:2*pi; x = sin(t); +%! plot (t,x) -%!assert (example('example',1), "\n example('example');"); +%!assert (example('example',1), "\n example ('example');"); %!test -%! [code, idx] = example('example'); +%! [code, idx] = example ('example'); %! assert (code, ... -%! "\n example('example');\n t=0:0.01:2*pi; x=sin(t);\n plot(t,x)") -%! assert (idx, [1, 22, 59]); +%! "\n example ('example');\n t=0:0.01:2*pi; x = sin(t);\n plot (t,x)") +%! assert (idx, [1, 23, 63]); +%% Test input validation %!error example; -%!error example('example',3,5) +%!error example('example', 3, 5)
--- a/scripts/testfun/fail.m +++ b/scripts/testfun/fail.m @@ -129,15 +129,16 @@ endfunction -%!fail ('[1,2]*[2,3]','nonconformant') -%!fail ("fail('[1,2]*[2;3]','nonconformant')","expected error <nonconformant> but got none") -%!fail ("fail('[1,2]*[2,3]','usage:')","expected error <usage:>\nbut got.*nonconformant") -%!fail ("warning('test warning')",'warning','test warning'); + +%!fail ('[1,2]*[2,3]', 'nonconformant') +%!fail ("fail('[1,2]*[2;3]', 'nonconformant')", "expected error <nonconformant> but got none") +%!fail ("fail('[1,2]*[2,3]','usage:')", "expected error <usage:>\nbut got.*nonconformant") +%!fail ("warning('test warning')", 'warning','test warning'); -%!# fail ("warning('next test')",'warning','next test'); ## only allowed one warning test?!? +##% !fail ("warning('next test')",'warning','next test'); ## only allowed one warning test?!? -## Comment out the following tests if you don't want to see what -## errors look like -% !fail ('a*[2;3]', 'nonconformant') -% !fail ('a*[2,3]', 'usage:') -% !fail ("warning('warning failure')", 'warning', 'success') +%% Test that fail() itself will generate an error +%!error fail ("1"); +%!error <undefined> fail ('a*[2;3]', 'nonconformant') +%!error <expected error> fail ('a*[2,3]', 'usage:') +%!error <warning failure> fail ("warning('warning failure')", 'warning', 'success')
--- a/scripts/testfun/rundemos.m +++ b/scripts/testfun/rundemos.m @@ -35,6 +35,7 @@ if (is_absolute_filename (directory)) dirs = {directory}; else + directory = regexprep (directory, ['\',filesep(),'$'], ""); fullname = find_dir_in_path (directory); if (! isempty (fullname)) dirs = {fullname}; @@ -80,3 +81,5 @@ retval = findstr (str, "%!demo"); endif endfunction + +%!error rundemos ("foo", 1);
--- a/scripts/testfun/runtests.m +++ b/scripts/testfun/runtests.m @@ -35,6 +35,7 @@ if (is_absolute_filename (directory)) dirs = {directory}; else + directory = regexprep (directory, ['\',filesep(),'$'], ""); fullname = find_dir_in_path (directory); if (! isempty (fullname)) dirs = {fullname};
--- a/scripts/testfun/speed.m +++ b/scripts/testfun/speed.m @@ -25,14 +25,15 @@ ## each @var{n}, an initialization expression (@var{init}) is computed to ## create any data needed for the test. If a second expression (@var{f2}) is ## given then the execution times of the two expressions are compared. When -## called without output arguments the results are displayed graphically. +## called without output arguments the results are printed to stdout and +## displayed graphically. ## ## @table @code ## @item @var{f} -## The expression to evaluate. +## The code expression to evaluate. ## ## @item @var{max_n} -## The maximum test length to run. Default value is 100. Alternatively, +## The maximum test length to run. The default value is 100. Alternatively, ## use @code{[min_n, max_n]} or specify the @var{n} exactly with ## @code{[n1, n2, @dots{}, nk]}. ## @@ -59,7 +60,7 @@ ## is a structure with fields @code{a} and @code{p}. ## ## @item @var{n} -## The values @var{n} for which the expression was calculated AND +## The values @var{n} for which the expression was calculated @strong{AND} ## the execution time was greater than zero. ## ## @item @var{T_f} @@ -67,7 +68,7 @@ ## ## @item @var{T_f2} ## The nonzero execution times recorded for the expression @var{f2} in seconds. -## If required, the mean time ratio is simply @code{mean (T_f./T_f2)}. +## If required, the mean time ratio is simply @code{mean (T_f ./ T_f2)}. ## ## @end table ## @@ -115,8 +116,8 @@ ## ## @example ## @group -## speed ("v = sum (x)", "", [10000, 100000], ... -## "v = 0; for i = 1:length (x), v += x(i); end") +## speed ("sum (x)", "", [10000, 100000], ... +## "v = 0; for i = 1:length (x), v += x(i); endfor") ## @end group ## @end example ## @@ -127,47 +128,37 @@ ## ## @example ## @group -## speed ("v = xcorr (x, n)", "x = rand (128, 1);", 100, -## "v2 = xcorr_orig (x, n)", -100*eps) -## speed ("v = xcorr (x, 15)", "x = rand (20+n, 1);", 100, -## "v2 = xcorr_orig (x, n)", -100*eps) +## speed ("xcorr (x, n)", "x = rand (128, 1);", 100, +## "xcorr_orig (x, n)", -100*eps) +## speed ("xcorr (x, 15)", "x = rand (20+n, 1);", 100, +## "xcorr_orig (x, n)", -100*eps) ## @end group ## @end example ## ## Assuming one of the two versions is in xcorr_orig, this ## would compare their speed and their output values. Note that the -## FFT version is not exact, so we specify an acceptable tolerance on -## the comparison @code{100*eps}, and that the errors should be computed -## relatively, as @code{abs ((@var{x} - @var{y}) ./ @var{y})} rather than -## absolutely as @code{abs (@var{x} - @var{y})}. +## FFT version is not exact, so one must specify an acceptable tolerance on +## the comparison @code{100*eps}. In this case, the comparison should be +## computed relatively, as @code{abs ((@var{x} - @var{y}) ./ @var{y})} rather +## than absolutely as @code{abs (@var{x} - @var{y})}. ## -## Type @code{example('speed')} to see some real examples. Note that for -## obscure reasons, examples 1 and 2 can not be run directly using -## @code{demo('speed')}. Instead use, @code{eval ( example('speed', 1) )} -## or @code{eval ( example('speed', 2) )}. +## Type @kbd{example ("speed")} to see some real examples or +## @kbd{demo ("speed")} to run them. ## @end deftypefn ## FIXME: consider two dimensional speedup surfaces for functions like kron. -function [__order, __test_n, __tnew, __torig] = speed (__f1, __init, __max_n, __f2, __tol) +function [__order, __test_n, __tnew, __torig] = speed (__f1, __init, __max_n = 100, __f2 = "", __tol = eps) if (nargin < 1 || nargin > 6) print_usage (); endif if (nargin < 2 || isempty (__init)) - __init = "x = randn(n, 1);"; - endif - - if (nargin < 3 || isempty (__max_n)) - __max_n = 100; + __init = "x = randn (n, 1)"; endif - if (nargin < 4) - __f2 = []; - endif - - if (nargin < 5 || isempty (__tol)) - __tol = eps; + if (isempty (__max_n)) + __max_n = 100; endif __numtests = 15; @@ -178,11 +169,12 @@ assert (__max_n > __min_n); __test_n = logspace (0, log10 (__max_n), __numtests); elseif (length (__max_n) == 2) - __min_n = __max_n(1); - __max_n = __max_n(2); + [__min_n, __max_n] = deal (__max_n(1), __max_n(2)); assert (__min_n >= 1); + assert (__max_n > __min_n); __test_n = logspace (log10 (__min_n), log10 (__max_n), __numtests); else + assert (all (__max_n > 0)); __test_n = __max_n; endif ## Force n to be an integer. @@ -191,83 +183,116 @@ __torig = __tnew = zeros (size (__test_n)); - disp (cstrcat ("testing ", __f1, "\ninit: ", __init)); + ## Print and plot the data if no output is requested. + do_display = (nargout == 0); + + if (do_display) + disp (cstrcat ("testing ", __f1, "\ninit: ", __init)); + endif + + ## Add semicolon closure to all code fragments in case user has not done so. + __init = cstrcat (__init, ";"); + __f1 = cstrcat (__f1, ";"); + if (! isempty (__f2)) + __f2 = cstrcat (__f2, ";"); + endif ## Make sure the functions are freshly loaded by evaluating them at ## test_n(1); first have to initialize the args though. n = 1; k = 0; - eval (cstrcat (__init, ";")); + eval (__init); + eval (__f1); if (! isempty (__f2)) - eval (cstrcat (__f2, ";")); + eval (__f2); endif - eval (cstrcat (__f1, ";")); ## Run the tests. for k = 1:length (__test_n) n = __test_n(k); - eval (cstrcat (__init, ";")); + eval (__init); - printf ("n%i = %i ",k, n); - fflush (stdout); - eval (cstrcat ("__t = time();", __f1, "; __v1=ans; __t = time()-__t;")); + if (do_display) + printf ("n%i = %i ", k, n); + fflush (stdout); + endif + + eval (cstrcat ("__t = time();", __f1, "__v1=ans; __t = time()-__t;")); if (__t < 0.25) - eval (cstrcat ("__t2 = time();", __f1, "; __t2 = time()-__t2;")); - eval (cstrcat ("__t3 = time();", __f1, "; __t3 = time()-__t3;")); + eval (cstrcat ("__t2 = time();", __f1, "__t2 = time()-__t2;")); + eval (cstrcat ("__t3 = time();", __f1, "__t3 = time()-__t3;")); __t = min ([__t, __t2, __t3]); endif __tnew(k) = __t; if (! isempty (__f2)) - eval (cstrcat ("__t = time();", __f2, "; __v2=ans; __t = time()-__t;")); + eval (cstrcat ("__t = time();", __f2, "__v2=ans; __t = time()-__t;")); if (__t < 0.25) - eval (cstrcat ("__t2 = time();", __f2, "; __t2 = time()-__t2;")); - eval (cstrcat ("__t3 = time();", __f2, "; __t3 = time()-__t3;")); + eval (cstrcat ("__t2 = time();", __f2, "__t2 = time()-__t2;")); + eval (cstrcat ("__t3 = time();", __f2, "__t3 = time()-__t3;")); + __t = min ([__t, __t2, __t3]); endif __torig(k) = __t; if (! isinf(__tol)) assert (__v1, __v2, __tol); endif endif + endfor ## Drop times of zero. - if (! isempty (__f2)) - zidx = (__tnew < 100*eps | __torig < 100*eps); + if (isempty (__f2)) + zidx = (__tnew < 100*eps); + __test_n(zidx) = []; + __tnew(zidx) = []; + else + zidx = (__tnew < 100*eps | __torig < 100*eps); __test_n(zidx) = []; __tnew(zidx) = []; __torig(zidx) = []; - else - zidx = (__tnew < 100*eps); - __test_n(zidx) = []; - __tnew(zidx) = []; + endif + + if (isempty (__test_n)) + error (["speed: All running times were zero.\n", + "error: speed: Choose larger MAX_N or do more work per function evaluation"]); endif ## Approximate time complexity and return it if requested. - tailidx = ceil(length(__test_n)/2):length(__test_n); + tailidx = ceil (length (__test_n)/2):length (__test_n); p = polyfit (log (__test_n(tailidx)), log (__tnew(tailidx)), 1); if (nargout > 0) __order.p = p(1); __order.a = exp (p(2)); endif - ## Plot the data if no output is requested. - doplot = (nargout == 0); - - if (doplot) + if (do_display) figure; + ## Strip semicolon added to code fragments before displaying + __init(end) = ""; + __f1(end) = ""; + if (! isempty (__f2)) + __f2(end) = ""; + endif endif - if (doplot && ! isempty (__f2)) + if (do_display && isempty (__f2)) + + loglog (__test_n, __tnew*1000, "*-g;execution time;"); + xlabel ("test length"); + ylabel ("best execution time (ms)"); + title ({__f1, cstrcat("init: ", __init)}); + + elseif (do_display) + subplot (1, 2, 1); semilogx (__test_n, __torig./__tnew, - cstrcat ("-*r;", strrep (__f1, ";", "."), "/", - strrep (__f2, ";", "."), ";"), + cstrcat ("-*r;", strrep (__f1, ";", "."), " / ", + strrep (__f2, ";", "."), ";"), __test_n, __tnew./__torig, - cstrcat ("-*g;", strrep (__f2, ";", "."), "/", - strrep (__f1, ";", "."), ";")); + cstrcat ("-*g;", strrep (__f2, ";", "."), " / ", + strrep (__f1, ";", "."), ";")); + title ("Speedup Ratio"); xlabel ("test length"); - title (__f1); ylabel ("speedup ratio"); subplot (1, 2, 2); @@ -275,31 +300,32 @@ cstrcat ("*-g;", strrep (__f1, ";", "."), ";"), __test_n, __torig*1000, cstrcat ("*-r;", strrep (__f2,";","."), ";")); - + title ({"Execution Times", cstrcat("init: ", __init)}); xlabel ("test length"); ylabel ("best execution time (ms)"); - title (cstrcat ("init: ", __init)); ratio = mean (__torig ./ __tnew); printf ("\n\nMean runtime ratio = %.3g for '%s' vs '%s'\n", ratio, __f2, __f1); - elseif (doplot) - - loglog (__test_n, __tnew*1000, "*-g;execution time;"); - xlabel ("test length"); - ylabel ("best execution time (ms)"); - title (cstrcat (__f1, " init: ", __init)); - endif - if (doplot) + if (do_display) ## Plot time complexity approximation (using milliseconds). - order = sprintf ("O(n^%g)", round (10*p(1))/10); + figure; # Open second plot window + + order = round (10*p(1))/10; + if (order >= 0.1) + order = sprintf ("O(n^%g)", order); + else + order = "O(1)"; + endif v = polyval (p, log (__test_n(tailidx))); loglog (__test_n(tailidx), exp(v)*1000, sprintf ("b;%s;", order)); + title ({"Time Complexity", __f1}); + xlabel ("test length"); ## Get base time to 1 digit of accuracy. dt = exp (p(2)); @@ -323,58 +349,96 @@ endfunction -%!demo if 1 -%! function x = build_orig(n) -%! ## extend the target vector on the fly -%! for i=0:n-1, x([1:10]+i*10) = 1:10; endfor -%! endfunction -%! function x = build(n) -%! ## preallocate the target vector -%! x = zeros(1, n*10); -%! try -%! if (prefer_column_vectors), x = x.'; endif -%! catch -%! end -%! for i=0:n-1, x([1:10]+i*10) = 1:10; endfor -%! endfunction + +%% FIXME: Demos with declared functions do not work. See bug #31815. +%% A workaround has been hacked by not declaring the functions +%% but using eval to create them in the proper context. +%% Unfortunately, we can't remove them from the user's workspace +%% because of another bug (#34497). +%!demo +%! fstr_build_orig = cstrcat ( +%! "function x = build_orig (n)\n", +%! " ## extend the target vector on the fly\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); +%! fstr_build = cstrcat ( +%! "function x = build (n)\n", +%! " ## preallocate the target vector\n", +%! " x = zeros (1, n*100);\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); %! -%! disp("-----------------------"); -%! type build_orig; -%! disp("-----------------------"); -%! type build; -%! disp("-----------------------"); +%! disp ("-----------------------"); +%! disp (fstr_build_orig); +%! disp ("-----------------------"); +%! disp (fstr_build); +%! disp ("-----------------------"); %! -%! disp("Preallocated vector test.\nThis takes a little while..."); -%! speed('build(n)', '', 1000, 'build_orig(n)'); -%! clear build build_orig -%! disp("Note how much faster it is to pre-allocate a vector."); -%! disp("Notice the peak speedup ratio."); -%! endif +%! ## Eval functions strings to create them in the current context +%! eval (fstr_build_orig); +%! eval (fstr_build); +%! +%! disp ("Preallocated vector test.\nThis takes a little while..."); +%! speed("build (n)", "", 1000, "build_orig (n)"); +%! clear -f build build_orig +%! disp ("Note how much faster it is to pre-allocate a vector."); +%! disp ("Notice the peak speedup ratio."); -%!demo if 1 -%! function x = build_orig(n) -%! for i=0:n-1, x([1:10]+i*10) = 1:10; endfor -%! endfunction -%! function x = build(n) -%! idx = [1:10]'; -%! x = idx(:,ones(1,n)); -%! x = reshape(x, 1, n*10); -%! try -%! if (prefer_column_vectors), x = x.'; endif -%! catch -%! end -%! endfunction +%!demo +%! fstr_build_orig = cstrcat ( +%! "function x = build_orig (n)\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); +%! fstr_build = cstrcat ( +%! "function x = build (n)\n", +%! " idx = [1:100]';\n", +%! " x = idx(:,ones(1,n));\n", +%! " x = reshape (x, 1, n*100);\n", +%! "endfunction"); +%! +%! disp ("-----------------------"); +%! disp (fstr_build_orig); +%! disp ("-----------------------"); +%! disp (fstr_build); +%! disp ("-----------------------"); +%! +%! ## Eval functions strings to create them in the current context +%! eval (fstr_build_orig); +%! eval (fstr_build); %! -%! disp("-----------------------"); -%! type build_orig; -%! disp("-----------------------"); -%! type build; -%! disp("-----------------------"); -%! -%! disp("Vectorized test.\nThis takes a little while..."); -%! speed('build(n)', '', 1000, 'build_orig(n)'); -%! clear build build_orig -%! disp("-----------------------"); -%! disp("This time, the for loop is done away with entirely."); -%! disp("Notice how much bigger the speedup is than in example 1."); -%! endif +%! disp ("Vectorized test.\nThis takes a little while..."); +%! speed("build (n)", "", 1000, "build_orig (n)"); +%! clear -f build build_orig +%! disp ("-----------------------"); +%! disp ("This time, the for loop is done away with entirely."); +%! disp ("Notice how much bigger the speedup is than in example 1."); + +%!test +%! [order, n, T_f1, T_f2] = speed ("airy (x)", "x = rand (n, 10)", [100, 1000]); +%! assert (isstruct (order)); +%! assert (size (order), [1, 1]); +%! assert (fieldnames (order), {"p"; "a"}); +%! assert (isnumeric (n)); +%! assert (length (n) > 10); +%! assert (isnumeric (T_f1)); +%! assert (size (T_f1), size (n)); +%! assert (isnumeric (T_f2)); +%! assert (length (T_f2) > 10); + +%% This test is known to fail on operating systems with low resolution timers such as MinGW +%!xtest +%! [order, n, T_f1, T_f2] = speed ("sum (x)", "", [100, 1000], "v = 0; for i = 1:length (x), v += x(i); endfor"); +%! assert (isstruct (order)); +%! assert (size (order), [1, 1]); +%! assert (fieldnames (order), {"p"; "a"}); +%! assert (isnumeric (n)); +%! assert (length (n) > 10); +%! assert (isnumeric (T_f1)); +%! assert (size (T_f1), size (n)); +%! assert (isnumeric (T_f2)); +%! assert (length (T_f2) > 10); + +%% Test input validation +%!error speed (); +%!error speed (1, 2, 3, 4, 5, 6, 7); +
--- a/scripts/testfun/test.m +++ b/scripts/testfun/test.m @@ -132,7 +132,7 @@ __rundemo = 0; __verbose = 0; __demo_code = ""; - __demo_idx = 1; + __demo_idx = []; elseif (strcmp (__flag, "explain")) fprintf (__fid, "# %s new test file\n", __signal_file); fprintf (__fid, "# %s no tests in file\n", __signal_empty); @@ -286,7 +286,7 @@ input ("Press <enter> to continue: ", "s"); catch __success = 0; - __msg = sprintf ("%sdemo failed\n%s", __signal_fail, __error_text__); + __msg = sprintf ("%sdemo failed\n%s", __signal_fail, lasterr ()); end_try_catch clear __test__; @@ -359,11 +359,19 @@ catch __success = 0; __msg = sprintf ("%stest failed: syntax error\n%s", - __signal_fail, __error_text__); + __signal_fail, lasterr ()); end_try_catch endif __code = ""; +### ENDFUNCTION + + elseif (strcmp (__type, "endfunction")) + ## endfunction simply declares the end of a previous function block. + ## There is no processing to be done here, just skip to next block. + __istest = 0; + __code = ""; + ### ASSERT/FAIL elseif (strcmp (__type, "assert") || strcmp (__type, "fail")) @@ -389,7 +397,7 @@ catch __success = 0; __msg = sprintf ("%stest failed: syntax error\n%s", - __signal_fail, __error_text__); + __signal_fail, lasterr ()); end_try_catch if (__success) @@ -488,13 +496,13 @@ eval (sprintf ("%s__test__(%s);", __shared_r, __shared)); catch if (strcmp (__type, "xtest")) - __msg = sprintf ("%sknown failure\n%s", __signal_fail, __error_text__); + __msg = sprintf ("%sknown failure\n%s", __signal_fail, lasterr ()); __xfail++; else - __msg = sprintf ("%stest failed\n%s", __signal_fail, __error_text__); + __msg = sprintf ("%stest failed\n%s", __signal_fail, lasterr ()); __success = 0; endif - if (isempty (__error_text__)) + if (isempty (lasterr ())) error ("empty error text, probably Ctrl-C --- aborting"); endif end_try_catch @@ -761,16 +769,19 @@ %!function x = __test_a(y) %! x = 2*y; +%!endfunction %!assert(__test_a(2),4); # Test a test function %!function __test_a (y) %! x = 2*y; +%!endfunction %!test %! __test_a(2); # Test a test function with no return value %!function [x,z] = __test_a (y) %! x = 2*y; %! z = 3*y; +%!endfunction %!test # Test a test function with multiple returns %! [x,z] = __test_a(3); %! assert(x,6);
--- a/scripts/time/datenum.m +++ b/scripts/time/datenum.m @@ -50,7 +50,7 @@ ## Days can be fractional. ## @end itemize ## -## @strong{Warning:} this function does not attempt to handle Julian +## @strong{Caution:} this function does not attempt to handle Julian ## calendars so dates before Octave 15, 1582 are wrong by as much ## as eleven days. Also be aware that only Roman Catholic countries ## adopted the calendar in 1582. It took until 1924 for it to be
--- a/scripts/time/datetick.m +++ b/scripts/time/datetick.m @@ -67,6 +67,9 @@ %! datetick(2,'keepticks') %! set(ax,'ytick',12:16) +## Remove from test statistics. No real tests possible. +%!assert (1) + function __datetick__ (varargin) keeplimits = false;
--- a/scripts/time/now.m +++ b/scripts/time/now.m @@ -37,7 +37,11 @@ function t = now () - t = datenum (clock ()); + if (nargin == 0) + t = datenum (clock ()); + else + print_usage (); + endif ## The following doesn't work (e.g., one hour off on 2005-10-04): ## @@ -50,3 +54,8 @@ ## changing by an hour the offset from CUT for part of the year. endfunction + +%!error now (1); +%!assert (isnumeric (now ())); +%!assert (now () > 0); +%!assert (now () <= now ());
--- a/src/DLD-FUNCTIONS/__contourc__.cc +++ b/src/DLD-FUNCTIONS/__contourc__.cc @@ -333,3 +333,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__delaunayn__.cc +++ b/src/DLD-FUNCTIONS/__delaunayn__.cc @@ -62,8 +62,8 @@ DEFUN_DLD (__delaunayn__, args, , "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{T} =} __delaunayn__ (@var{P})\n\ -@deftypefnx {Loadable Function} {@var{T} =} __delaunayn__ (@var{P}, @var{opt})\n\ +@deftypefn {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{T} =} __delaunayn__ (@var{pts}, @var{options})\n\ Undocumented internal function.\n\ @end deftypefn") @@ -73,7 +73,6 @@ #ifdef HAVE_QHULL retval(0) = 0.0; - std::string options = ""; int nargin = args.length (); if (nargin < 1 || nargin > 2) @@ -86,67 +85,52 @@ const octave_idx_type dim = p.columns (); const octave_idx_type n = p.rows (); - // default options + // Default options + std::string options; if (dim <= 3) - options = "Qt Qbb Qc"; + options = "Qt Qbb Qc Qz"; else options = "Qt Qbb Qc Qx"; - if (nargin == 2) { - if (args(1).is_empty ()) - { - // keep default options - } - else if (args(1).is_string ()) - { - // option string is directly provided + if (args(1).is_string ()) options = args(1).string_value (); - } - else if (args(1).is_cell ()) - { - options = ""; - - Cell c = args(1).cell_value (); - for (octave_idx_type i = 0; i < c.numel (); i++) - { + else if (args(1).is_empty ()) + ; // Use default options + else if (args(1).is_cellstr ()) + { + options = ""; + Array<std::string> tmp = args(1).cellstr_value (); - if (! c.elem(i).is_string ()) - { - error ("__delaunayn__: all options must be strings"); - return retval; - } - - options = options + c.elem(i).string_value () + " "; - } - } - else - { - error ("__delaunayn__: OPT argument must be a string, cell array of strings, or empty"); - return retval; - } + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += tmp(i) + " "; + } + else + { + error ("__delaunayn__: OPTIONS argument must be a string, cell array of strings, or empty"); + return retval; + } } - //octave_stdout << "options " << options << std::endl; - if (n > dim + 1) { p = p.transpose (); double *pt_array = p.fortran_vec (); boolT ismalloc = false; - OCTAVE_LOCAL_BUFFER (char, flags, 250); + // Qhull flags argument is not const char* + OCTAVE_LOCAL_BUFFER (char, flags, 9 + options.length()); sprintf (flags, "qhull d %s", options.c_str ()); - // If you want some debugging information replace the 0 pointer - // with stdout or some other file open for writing. - + // Replace the 0 pointer with stdout for debugging information FILE *outfile = 0; FILE *errfile = stderr; - - if (! qh_new_qhull (dim, n, pt_array, ismalloc, flags, outfile, errfile)) + + int exitcode = qh_new_qhull (dim, n, pt_array, + ismalloc, flags, outfile, errfile); + if (! exitcode) { // triangulate non-simplicial facets qh_triangulate (); @@ -160,54 +144,48 @@ if (! facet->upperdelaunay) nf++; - // Double check + // Double check. Non-simplicial facets will cause segfault below if (! facet->simplicial) { error ("__delaunayn__: Qhull returned non-simplicial facets -- try delaunayn with different options"); + exitcode = 1; break; } } - Matrix simpl (nf, dim+1); - - FORALLfacets + if (! exitcode) { - if (! facet->upperdelaunay) - { - octave_idx_type j = 0; + Matrix simpl (nf, dim+1); - FOREACHvertex_ (facet->vertices) + FORALLfacets + { + if (! facet->upperdelaunay) { - // if delaunayn crashes, enable this check -#if 0 - if (j > dim) - { - error ("__delaunayn__: internal error. Qhull returned non-simplicial facets"); - return retval; - } -#endif + octave_idx_type j = 0; - simpl(i, j++) = 1 + qh_pointid(vertex->point); + FOREACHvertex_ (facet->vertices) + { + simpl(i, j++) = 1 + qh_pointid(vertex->point); + } + i++; } - i++; } - } - - retval(0) = simpl; - // free long memory - qh_freeqhull (! qh_ALL); - - // free short memory and memory allocator - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("__delaunay__: did not free %d bytes of long memory (%d pieces)", - totlong, curlong); + retval(0) = simpl; + } } else error ("__delaunayn__: qhull failed"); + + // Free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("__delaunay__: did not free %d bytes of long memory (%d pieces)", + totlong, curlong); } else if (n == dim + 1) { @@ -226,3 +204,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__dispatch__.cc +++ b/src/DLD-FUNCTIONS/__dispatch__.cc @@ -129,3 +129,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__dsearchn__.cc +++ b/src/DLD-FUNCTIONS/__dsearchn__.cc @@ -108,3 +108,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc +++ b/src/DLD-FUNCTIONS/__fltk_uigetfile__.cc @@ -26,6 +26,10 @@ #if defined (HAVE_FLTK) +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + #include <FL/Fl.H> #include <FL/Fl_File_Chooser.H> @@ -130,4 +134,11 @@ return retval; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #endif
--- a/src/DLD-FUNCTIONS/__glpk__.cc +++ b/src/DLD-FUNCTIONS/__glpk__.cc @@ -854,3 +854,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__init_fltk__.cc +++ b/src/DLD-FUNCTIONS/__init_fltk__.cc @@ -40,6 +40,10 @@ #include <sstream> #include <iostream> +#ifdef WIN32 +#define WIN32_LEAN_AND_MEAN +#endif + #include <FL/Fl.H> #include <FL/Fl_Box.H> #include <FL/Fl_Button.H> @@ -130,6 +134,19 @@ redraw (); } + bool renumber (double new_number) + { + bool retval = false; + + if (number != new_number) + { + number = new_number; + retval = true; + } + + return retval; + } + private: double number; opengl_renderer renderer; @@ -259,7 +276,7 @@ int n = 0; for (int t = 0; t < len; t++ ) { - const Fl_Menu_Item *m = static_cast<const Fl_Menu_Item*>(&(menubar->menu ()[t])); + const Fl_Menu_Item *m = static_cast<const Fl_Menu_Item*> (&(menubar->menu ()[t])); if ((m->label () != NULL) && m->visible ()) n++; } @@ -282,7 +299,7 @@ return menubar->visible (); } - int find_index_by_name (std::string findname) + int find_index_by_name (const std::string& findname) { // This function is derived from Greg Ercolano's function // int GetIndexByName(...), see: @@ -293,7 +310,7 @@ std::string menupath; for (int t = 0; t < menubar->size (); t++ ) { - Fl_Menu_Item *m = const_cast<Fl_Menu_Item*>(&(menubar->menu ()[t])); + Fl_Menu_Item *m = const_cast<Fl_Menu_Item*> (&(menubar->menu ()[t])); if (m->submenu ()) { // item has submenu @@ -354,7 +371,7 @@ { graphics_object kidgo = gh_manager::get_object (uimenu_childs (ii)); - if (kidgo.valid_object() && kidgo.isa ("uimenu")) + if (kidgo.valid_object () && kidgo.isa ("uimenu")) { uimenu_childs(k) = uimenu_childs(ii); pos(k++) = @@ -374,7 +391,7 @@ return retval; } - void delete_entry(uimenu::properties& uimenup) + void delete_entry (uimenu::properties& uimenup) { std::string fltk_label = uimenup.get_fltk_label (); int idx = find_index_by_name (fltk_label.c_str ()); @@ -388,7 +405,7 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { std::string acc = uimenup.get_accelerator (); @@ -406,14 +423,14 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { if (!uimenup.get_callback ().is_empty ()) - item->callback(static_cast<Fl_Callback*>(script_cb), //callback - static_cast<void*>(&uimenup)); //callback data + item->callback (static_cast<Fl_Callback*> (script_cb), + static_cast<void*> (&uimenup)); else - item->callback(NULL, static_cast<void*>(0)); + item->callback (NULL, static_cast<void*> (0)); } } } @@ -423,7 +440,7 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { if (uimenup.is_enable ()) @@ -439,7 +456,7 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { Matrix rgb = uimenup.get_foregroundcolor_rgb (); @@ -453,7 +470,7 @@ } } - void update_seperator (uimenu::properties& uimenup) + void update_seperator (const uimenu::properties& uimenup) { // Matlab places the separator before the current // menu entry, while fltk places it after. So we need to find @@ -462,17 +479,17 @@ if (!fltk_label.empty ()) { int itemflags = 0, idx; - int curr_idx = find_index_by_name(fltk_label.c_str ()); + int curr_idx = find_index_by_name (fltk_label.c_str ()); for (idx = curr_idx - 1; idx >= 0; idx--) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(&menubar->menu () [idx]); + Fl_Menu_Item* item = const_cast<Fl_Menu_Item*> (&menubar->menu () [idx]); itemflags = item->flags; if (item->label () != NULL) break; } - if ((idx >= 0) && (idx < menubar->size ())) + if (idx >= 0 && idx < menubar->size ()) { if (uimenup.is_separator ()) { @@ -490,7 +507,8 @@ std::string fltk_label = uimenup.get_fltk_label (); if (!fltk_label.empty ()) { - Fl_Menu_Item* item = const_cast<Fl_Menu_Item*>(menubar->find_item (fltk_label.c_str ())); + Fl_Menu_Item* item + = const_cast<Fl_Menu_Item*> (menubar->find_item (fltk_label.c_str ())); if (item != NULL) { if (uimenup.is_visible ()) @@ -511,7 +529,8 @@ bool item_added = false; do { - const Fl_Menu_Item* item = menubar->find_item(fltk_label.c_str ()); + const Fl_Menu_Item* item + = menubar->find_item (fltk_label.c_str ()); if (item == NULL) { @@ -520,9 +539,9 @@ int flags = 0; if (len > 0) flags = FL_SUBMENU; - if ((len == 0) && (uimenup.is_checked ())) + if (len == 0 && uimenup.is_checked ()) flags += FL_MENU_TOGGLE + FL_MENU_VALUE; - menubar->add(fltk_label.c_str (), 0, 0, 0, flags); + menubar->add (fltk_label.c_str (), 0, 0, 0, flags); item_added = true; } else @@ -535,9 +554,9 @@ if (len > 0) { std::string valstr = fltk_label.substr (idx1 + 1, len - 1); - fltk_label.erase(idx1, len + 1); + fltk_label.erase (idx1, len + 1); val = atoi (valstr.c_str ()); - if ((val > 0) && (val < 99)) + if (val > 0 && val < 99) val++; } std::ostringstream valstream; @@ -569,7 +588,7 @@ graphics_object kgo = gh_manager::get_object (kids (len - (ii + 1))); if (kgo.valid_object ()) { - uimenu::properties& kprop = dynamic_cast<uimenu::properties&>(kgo.get_properties ()); + uimenu::properties& kprop = dynamic_cast<uimenu::properties&> (kgo.get_properties ()); add_to_menu (kprop); } } @@ -586,7 +605,7 @@ if (kgo.valid_object ()) { - uimenu::properties& kprop = dynamic_cast<uimenu::properties&>(kgo.get_properties ()); + uimenu::properties& kprop = dynamic_cast<uimenu::properties&> (kgo.get_properties ()); add_to_menu (kprop); } } @@ -606,18 +625,18 @@ if (kgo.valid_object ()) { - uimenu::properties kprop = dynamic_cast<uimenu::properties&>(kgo.get_properties ()); + uimenu::properties kprop = dynamic_cast<uimenu::properties&> (kgo.get_properties ()); remove_from_menu (kprop); } } - if (type.compare("uimenu") == 0) - delete_entry(dynamic_cast<uimenu::properties&>(prop)); - else if (type.compare("figure") == 0) + if (type.compare ("uimenu") == 0) + delete_entry (dynamic_cast<uimenu::properties&> (prop)); + else if (type.compare ("figure") == 0) menubar->clear (); } - ~fltk_uimenu() + ~fltk_uimenu (void) { delete menubar; } @@ -648,75 +667,46 @@ begin (); { - uimenu = new - fltk_uimenu(0, 0, ww, menu_h); + canvas = new OpenGL_fltk (0, 0, ww, hh - status_h, number ()); + + uimenu = new fltk_uimenu (0, 0, ww, menu_h); uimenu->hide (); - canvas = new - OpenGL_fltk (0, 0, ww , hh - status_h, number ()); - - bottom = new - Fl_Box (0, - hh - status_h, - ww, - status_h); + bottom = new Fl_Box (0, hh - status_h, ww, status_h); bottom->box(FL_FLAT_BOX); ndim = calc_dimensions (gh_manager::get_object (fp.get___myhandle__ ())); - autoscale = new - Fl_Button (0, - hh - status_h, - status_h, - status_h, - "A"); + autoscale = new Fl_Button (0, hh - status_h, status_h, status_h, "A"); autoscale->callback (button_callback, static_cast<void*> (this)); autoscale->tooltip ("Autoscale"); - togglegrid = new - Fl_Button (status_h, - hh - status_h, - status_h, - status_h, - "G"); + togglegrid = new Fl_Button (status_h, hh - status_h, status_h, + status_h, "G"); togglegrid->callback (button_callback, static_cast<void*> (this)); togglegrid->tooltip ("Toggle Grid"); - panzoom = new - Fl_Button (2 * status_h, - hh - status_h, - status_h, - status_h, - "P"); + panzoom = new Fl_Button (2 * status_h, hh - status_h, status_h, + status_h, "P"); panzoom->callback (button_callback, static_cast<void*> (this)); panzoom->tooltip ("Mouse Pan/Zoom"); - rotate = new - Fl_Button (3 * status_h, - hh - status_h, - status_h, - status_h, - "R"); + rotate = new Fl_Button (3 * status_h, hh - status_h, status_h, + status_h, "R"); rotate->callback (button_callback, static_cast<void*> (this)); rotate->tooltip ("Mouse Rotate"); if (ndim == 2) rotate->deactivate (); - help = new - Fl_Button (4 * status_h, - hh - status_h, - status_h, - status_h, - "?"); + help = new Fl_Button (4 * status_h, hh - status_h, status_h, + status_h, "?"); help->callback (button_callback, static_cast<void*> (this)); help->tooltip ("Help"); - status = new - Fl_Output (5 * status_h, - hh - status_h, - ww > 2*status_h ? ww - status_h : 0, - status_h, ""); + status = new Fl_Output (5 * status_h, hh - status_h, + ww > 2*status_h ? ww - status_h : 0, + status_h, ""); status->textcolor (FL_BLACK); status->color (FL_GRAY); @@ -764,9 +754,19 @@ delete uimenu; } - // FIXME -- this could change. double number (void) { return fp.get___myhandle__ ().value (); } + void renumber (double new_number) + { + if (canvas) + { + if (canvas->renumber (new_number)) + mark_modified (); + } + else + error ("unable to renumber figure"); + } + void print (const std::string& cmd, const std::string& term) { canvas->print (cmd, term); @@ -803,7 +803,7 @@ } } - void uimenu_update(graphics_handle gh, int id) + void uimenu_update (const graphics_handle& gh, int id) { graphics_object uimenu_obj = gh_manager::get_object (gh); @@ -811,58 +811,70 @@ { uimenu::properties& uimenup = dynamic_cast<uimenu::properties&> (uimenu_obj.get_properties ()); - std::string fltk_label = uimenup.get_fltk_label(); - graphics_object fig = uimenu_obj.get_ancestor("figure"); + std::string fltk_label = uimenup.get_fltk_label (); + graphics_object fig = uimenu_obj.get_ancestor ("figure"); figure::properties& figp = dynamic_cast<figure::properties&> (fig.get_properties ()); - switch(id) + switch (id) { - case base_properties::ID_BEINGDELETED: - uimenu->remove_from_menu (uimenup); - break; - case base_properties::ID_VISIBLE: - uimenu->update_visible (uimenup); - break; - case uimenu::properties::ID_ACCELERATOR: - uimenu->update_accelerator (uimenup); - break; - case uimenu::properties::ID_CALLBACK: - uimenu->update_callback (uimenup); - break; - case uimenu::properties::ID_CHECKED: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - case uimenu::properties::ID_ENABLE: - uimenu->update_enable (uimenup); - break; - case uimenu::properties::ID_FOREGROUNDCOLOR: - uimenu->update_foregroundcolor (uimenup); - break; - case uimenu::properties::ID_LABEL: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - case uimenu::properties::ID_POSITION: - uimenu->add_to_menu (figp);//rebuilding entire menu - break; - case uimenu::properties::ID_SEPARATOR: - uimenu->update_seperator (uimenup); - break; + case base_properties::ID_BEINGDELETED: + uimenu->remove_from_menu (uimenup); + break; + + case base_properties::ID_VISIBLE: + uimenu->update_visible (uimenup); + break; + + case uimenu::properties::ID_ACCELERATOR: + uimenu->update_accelerator (uimenup); + break; + + case uimenu::properties::ID_CALLBACK: + uimenu->update_callback (uimenup); + break; + + case uimenu::properties::ID_CHECKED: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_ENABLE: + uimenu->update_enable (uimenup); + break; + + case uimenu::properties::ID_FOREGROUNDCOLOR: + uimenu->update_foregroundcolor (uimenup); + break; + + case uimenu::properties::ID_LABEL: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_POSITION: + uimenu->add_to_menu (figp);//rebuilding entire menu + break; + + case uimenu::properties::ID_SEPARATOR: + uimenu->update_seperator (uimenup); + break; } - if (uimenu->items_to_show ()) - show_menubar (); - else - hide_menubar (); + if (uimenu->items_to_show ()) + show_menubar (); + else + hide_menubar (); - mark_modified(); + mark_modified(); } } void show_canvas (void) { - canvas->show (); - canvas->make_current (); + if (fp.is_visible ()) + { + canvas->show (); + canvas->make_current (); + } } void hide_canvas (void) @@ -878,7 +890,7 @@ if (ndim == 3) rotate->activate (); - else if ((ndim == 2) && (gui_mode == rotate_zoom)) + else if (ndim == 2 && gui_mode == rotate_zoom) { rotate->deactivate (); gui_mode = pan_zoom; @@ -979,14 +991,14 @@ mark_modified (); } - void pixel2pos - (graphics_handle ax, int px, int py, double& xx, double& yy) const + void pixel2pos (const graphics_handle& ax, int px, int py, double& xx, + double& yy) const { pixel2pos ( gh_manager::get_object (ax), px, py, xx, yy); } - void pixel2pos - (graphics_object ax, int px, int py, double& xx, double& yy) const + void pixel2pos (graphics_object ax, int px, int py, double& xx, + double& yy) const { if (ax && ax.isa ("axes")) { @@ -1026,7 +1038,7 @@ return fp.get_currentaxes (); } - void pixel2status (graphics_handle ax, int px0, int py0, + void pixel2status (const graphics_handle& ax, int px0, int py0, int px1 = -1, int py1 = -1) { pixel2status (gh_manager::get_object (ax), px0, py0, px1, py1); @@ -1061,7 +1073,7 @@ cbuf.precision (4); cbuf.width (6); Matrix v (1,2,0); - v = ap.get("view").matrix_value(); + v = ap.get ("view").matrix_value (); cbuf << "[azimuth: " << v(0) << ", elevation: " << v(1) << "]"; status->value (cbuf.str ().c_str ()); @@ -1158,7 +1170,7 @@ void draw (void) { Matrix pos = fp.get_position ().matrix_value (); - Fl_Window::resize (pos(0), pos(1) , pos(2), pos(3) + status_h + menu_h); + Fl_Window::resize (pos(0), pos(1), pos(2), pos(3) + status_h + menu_h); return Fl_Window::draw (); } @@ -1174,7 +1186,7 @@ int retval = Fl_Window::handle (event); // We only handle events which are in the canvas area. - if (!Fl::event_inside(canvas)) + if (!Fl::event_inside (canvas)) return retval; if (!fp.is_beingdeleted ()) @@ -1356,9 +1368,9 @@ { axes::properties& ap = dynamic_cast<axes::properties&> (ax0.get_properties ()); - ap.set_xlimmode("auto"); - ap.set_ylimmode("auto"); - ap.set_zlimmode("auto"); + ap.set_xlimmode ("auto"); + ap.set_ylimmode ("auto"); + ap.set_zlimmode ("auto"); mark_modified (); } } @@ -1455,18 +1467,25 @@ instance->do_delete_window (idx); } - static void delete_window (std::string idx_str) + static void delete_window (const std::string& idx_str) { delete_window (str2idx (idx_str)); } + static void renumber_figure (const std::string& idx_str, double new_number) + { + if (instance_ok ()) + instance->do_renumber_figure (str2idx (idx_str), new_number); + } + static void toggle_window_visibility (int idx, bool is_visible) { if (instance_ok ()) instance->do_toggle_window_visibility (idx, is_visible); } - static void toggle_window_visibility (std::string idx_str, bool is_visible) + static void toggle_window_visibility (const std::string& idx_str, + bool is_visible) { toggle_window_visibility (str2idx (idx_str), is_visible); } @@ -1488,7 +1507,7 @@ instance->do_set_name (idx); } - static void set_name (std::string idx_str) + static void set_name (const std::string& idx_str) { set_name (str2idx (idx_str)); } @@ -1503,22 +1522,25 @@ return get_size (hnd2idx (gh)); } - static void print (const graphics_handle& gh , const std::string& cmd, const std::string& term) + static void print (const graphics_handle& gh, const std::string& cmd, + const std::string& term) { if (instance_ok ()) - instance->do_print (hnd2idx(gh), cmd, term); + instance->do_print (hnd2idx (gh), cmd, term); } - static void uimenu_update (const graphics_handle& figh, const graphics_handle& uimenuh, const int id) + static void uimenu_update (const graphics_handle& figh, + const graphics_handle& uimenuh, int id) { if (instance_ok ()) - instance->do_uimenu_update (hnd2idx(figh), uimenuh, id); + instance->do_uimenu_update (hnd2idx (figh), uimenuh, id); } - static void update_canvas (const graphics_handle& gh, const graphics_handle& ca) + static void update_canvas (const graphics_handle& gh, + const graphics_handle& ca) { if (instance_ok ()) - instance->do_update_canvas (hnd2idx(gh), ca); + instance->do_update_canvas (hnd2idx (gh), ca); } static void toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) @@ -1527,7 +1549,8 @@ instance->do_toggle_menubar_visibility (fig_idx, menubar_is_figure); } - static void toggle_menubar_visibility (std::string fig_idx_str, bool menubar_is_figure) + static void toggle_menubar_visibility (const std::string& fig_idx_str, + bool menubar_is_figure) { toggle_menubar_visibility (str2idx (fig_idx_str), menubar_is_figure); } @@ -1561,31 +1584,47 @@ void do_new_window (figure::properties& fp) { - int x, y, w, h; + int idx = figprops2idx (fp); - int idx = figprops2idx (fp); if (idx >= 0 && windows.find (idx) == windows.end ()) { - default_size (x, y, w, h); - idx2figprops (curr_index , fp); + Matrix pos = fp.get_boundingbox (true); + + int x = pos(0); + int y = pos(1); + int w = pos(2); + int h = pos(3); + + idx2figprops (curr_index, fp); + windows[curr_index++] = new plot_window (x, y, w, h, fp); } } void do_delete_window (int idx) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) { delete win->second; windows.erase (win); } } + void do_renumber_figure (int idx, double new_number) + { + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->renumber (new_number); + } + void do_toggle_window_visibility (int idx, bool is_visible) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) { if (is_visible) win->second->show (); @@ -1598,8 +1637,9 @@ void do_toggle_menubar_visibility (int fig_idx, bool menubar_is_figure) { - wm_iterator win; - if ((win = windows.find (fig_idx)) != windows.end ()) + wm_iterator win = windows.find (fig_idx); + + if (win != windows.end ()) { if (menubar_is_figure) win->second->show_menubar (); @@ -1612,28 +1652,27 @@ void do_mark_modified (int idx) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) - { - win->second->mark_modified (); - } + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->mark_modified (); } void do_set_name (int idx) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) - { - win->second->set_name (); - } + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->set_name (); } Matrix do_get_size (int idx) { Matrix sz (1, 2, 0.0); - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) { sz(0) = win->second->w (); sz(1) = win->second->h (); @@ -1644,26 +1683,25 @@ void do_print (int idx, const std::string& cmd, const std::string& term) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) - { - win->second->print (cmd, term); - } + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->print (cmd, term); } - void do_uimenu_update (int idx, graphics_handle gh, int id) + void do_uimenu_update (int idx, const graphics_handle& gh, int id) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) - { - win->second->uimenu_update (gh, id); - } + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) + win->second->uimenu_update (gh, id); } - void do_update_canvas (int idx, graphics_handle ca) + void do_update_canvas (int idx, const graphics_handle& ca) { - wm_iterator win; - if ((win = windows.find (idx)) != windows.end ()) + wm_iterator win = windows.find (idx); + + if (win != windows.end ()) { if (ca.ok ()) win->second->show_canvas (); @@ -1672,17 +1710,7 @@ } } - - // FIXME -- default size should be configurable. - void default_size (int& x, int& y, int& w, int& h) - { - x = 0; - y = 0; - w = 640; - h = 480; - } - - static int str2idx (const caseless_str clstr) + static int str2idx (const caseless_str& clstr) { int ind; if (clstr.find (fltk_idx_header,0) == 0) @@ -1716,7 +1744,7 @@ return -1; } - static int hnd2idx (const double h) + static int hnd2idx (double h) { graphics_object fobj = gh_manager::get_object (h); if (fobj && fobj.isa ("figure")) @@ -1725,7 +1753,7 @@ dynamic_cast<figure::properties&> (fobj.get_properties ()); return figprops2idx (fp); } - error ("figure_manager: H is not a figure"); + error ("figure_manager: H (= %g) is not a figure", h); return -1; } @@ -1786,6 +1814,9 @@ bool is_valid (void) const { return true; } + bool initialize (const graphics_object& go) + { return go.isa ("figure"); } + void finalize (const graphics_object& go) { if (go.isa ("figure")) @@ -1797,7 +1828,7 @@ } } - void uimenu_set_fltk_label(graphics_object uimenu_obj) + void uimenu_set_fltk_label (graphics_object uimenu_obj) { if (uimenu_obj.valid_object ()) { @@ -1807,14 +1838,14 @@ graphics_object go = gh_manager::get_object (uimenu_obj.get_parent ()); if (go.isa ("uimenu")) fltk_label = dynamic_cast<const uimenu::properties&> (go.get_properties ()).get_fltk_label () - + "/" - + fltk_label; + + "/" + + fltk_label; else if (go.isa ("figure")) ; else - error("unexpected parent object\n"); + error ("unexpected parent object\n"); - uimenup.set_fltk_label(fltk_label); + uimenup.set_fltk_label (fltk_label); } } @@ -1831,19 +1862,34 @@ switch (id) { - case base_properties::ID_VISIBLE: - figure_manager::toggle_window_visibility (ov.string_value (), fp.is_visible ()); - break; - case figure::properties::ID_MENUBAR: - figure_manager::toggle_menubar_visibility (ov.string_value (), fp.menubar_is("figure")); - break; - case figure::properties::ID_NAME: - case figure::properties::ID_CURRENTAXES: - figure_manager::update_canvas (go.get_handle (), fp.get_currentaxes ()); - break; - case figure::properties::ID_NUMBERTITLE: - figure_manager::set_name (ov.string_value ()); - break; + case base_properties::ID_VISIBLE: + figure_manager::toggle_window_visibility + (ov.string_value (), fp.is_visible ()); + break; + + case figure::properties::ID_MENUBAR: + figure_manager::toggle_menubar_visibility + (ov.string_value (), fp.menubar_is ("figure")); + break; + + case figure::properties::ID_CURRENTAXES: + figure_manager::update_canvas + (go.get_handle (), fp.get_currentaxes ()); + break; + + case figure::properties::ID_NAME: + case figure::properties::ID_NUMBERTITLE: + figure_manager::set_name (ov.string_value ()); + break; + + case figure::properties::ID_INTEGERHANDLE: + { + std::string tmp = ov.string_value (); + graphics_handle gh = fp.get___myhandle__ (); + figure_manager::renumber_figure (tmp, gh.value ()); + figure_manager::set_name (tmp); + } + break; } } } @@ -1949,8 +1995,7 @@ Fl::wait (fltk_maxtime); } - octave_value retval; - return retval; + return octave_value (); } DEFUN_DLD (__fltk_maxtime__, args, ,"") @@ -1968,13 +2013,12 @@ return retval; } -/* FIXME: This function should be abstracted and made potentially available - to all graphics toolkits. This suggests putting it in graphics.cc - as is done for drawnow() and having the master mouse_wheel_zoom - function call fltk_mouse_wheel_zoom. The same should be done for - gui_mode and fltk_gui_mode. For now (2011.01.30), just - changing function names and docstrings. -*/ +// FIXME -- This function should be abstracted and made potentially +// available to all graphics toolkits. This suggests putting it in +// graphics.cc as is done for drawnow() and having the master +// mouse_wheel_zoom function call fltk_mouse_wheel_zoom. The same +// should be done for gui_mode and fltk_gui_mode. For now (2011.01.30), +// just changing function names and docstrings. DEFUN_DLD (mouse_wheel_zoom, args, , "-*- texinfo -*-\n\ @@ -2029,7 +2073,6 @@ else mode_str = "none"; - bool failed = false; if (args.length () == 1) @@ -2054,9 +2097,7 @@ if (failed) error ("MODE must be one of the strings: \"2D\", \"3D\", or \"none\""); - - return octave_value(mode_str); + return octave_value (mode_str); } - #endif
--- a/src/DLD-FUNCTIONS/__lin_interpn__.cc +++ b/src/DLD-FUNCTIONS/__lin_interpn__.cc @@ -355,3 +355,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__magick_read__.cc +++ b/src/DLD-FUNCTIONS/__magick_read__.cc @@ -531,6 +531,13 @@ return output; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #ifdef HAVE_MAGICK static void @@ -916,6 +923,13 @@ return retval; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #ifdef HAVE_MAGICK template<class T> @@ -1134,6 +1148,13 @@ return retval; } +/* + +## No test needed for internal helper function. +%!assert (1) + +*/ + #undef GET_PARAM // Determine the file formats supported by GraphicsMagick. This is @@ -1193,3 +1214,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__pchip_deriv__.cc +++ b/src/DLD-FUNCTIONS/__pchip_deriv__.cc @@ -147,3 +147,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__qp__.cc +++ b/src/DLD-FUNCTIONS/__qp__.cc @@ -528,3 +528,10 @@ return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/__voronoi__.cc +++ b/src/DLD-FUNCTIONS/__voronoi__.cc @@ -53,10 +53,11 @@ #endif #endif -DEFUN_DLD (__voronoi__, args, , +DEFUN_DLD (__voronoi__, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{tri} =} __voronoi__ (@var{point})\n\ -@deftypefnx {Loadable Function} {@var{tri} =} __voronoi__ (@var{point}, @var{options})\n\ +@deftypefn {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{C}, @var{F} =} __voronoi__ (@var{pts}, @var{options})\n\ +@deftypefnx {Loadable Function} {@var{C}, @var{F}, @var{Inf_Pts} =} __voronoi__ (@dots{})\n\ Undocumented internal function.\n\ @end deftypefn") { @@ -73,52 +74,50 @@ return retval; } - const char *options; + std::string options = ""; if (nargin == 2) { - if (! args (1).is_string ()) + if (args(1).is_string ()) + options = args(1).string_value (); + else if (args(1).is_empty ()) + ; // Use default options + else if (args(1).is_cellstr ()) { - error ("__voronoi__: OPTIONS argument must be a string"); + options = ""; + Array<std::string> tmp = args(1).cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += tmp(i) + " "; + } + else + { + error ("__voronoi__: OPTIONS argument must be a string, cell array of strings, or empty"); return retval; } - - options = args (1).string_value().c_str (); } - else - options = ""; Matrix p (args(0).matrix_value ()); - const octave_idx_type dim = p.columns (); const octave_idx_type np = p.rows (); + p = p.transpose (); - double *pt_array = p.fortran_vec (); - //double pt_array[dim * np]; - //for (int i = 0; i < np; i++) - // { - // for (int j = 0; j < dim; j++) - // { - // pt_array[j+i*dim] = p(i,j); - // } - // } - boolT ismalloc = false; - OCTAVE_LOCAL_BUFFER (char, flags, 250); - - // hmm lot's of options for qhull here - sprintf (flags, "qhull v Fv T0 %s", options); - - // If you want some debugging information replace the 0 pointer - // with stdout or some other file open for writing. - + // Replace the 0 pointer with stdout for debugging information FILE *outfile = 0; FILE *errfile = stderr; - if (! qh_new_qhull (dim, np, pt_array, ismalloc, flags, outfile, errfile)) + // Qhull flags argument is not const char* + OCTAVE_LOCAL_BUFFER (char, flags, 12 + options.length ()); + + sprintf (flags, "qhull v FV %s", options.c_str ()); + + int exitcode = qh_new_qhull (dim, np, pt_array, + ismalloc, flags, outfile, errfile); + if (! exitcode) { facetT *facet; vertexT *vertex; @@ -129,6 +128,7 @@ for (i = 0; i < np; i++) ni[i] = 0; qh_setvoronoi_all (); + bool infinity_seen = false; facetT *neighbor, **neighborp; coordT *voronoi_vertex; @@ -142,6 +142,7 @@ { if (qh hull_dim == 3) qh_order_vertexneighbors (vertex); + infinity_seen = false; FOREACHneighbor_ (vertex) @@ -168,9 +169,7 @@ for (octave_idx_type d = 0; d < dim; d++) v(0,d) = octave_Inf; - boolMatrix AtInf (np, 1); - for (i = 0; i < np; i++) - AtInf(i) = false; + boolMatrix AtInf (np, 1, false); octave_value_list F (np, octave_value ()); k = 0; i = 0; @@ -184,6 +183,7 @@ { if (qh hull_dim == 3) qh_order_vertexneighbors(vertex); + infinity_seen = false; RowVector facet_list (ni[k++]); m = 0; @@ -224,27 +224,37 @@ for (i = 0; i < r; i++) C.elem (i) = F(i); - retval(0) = v; + if (nargout == 3) + { + AtInf.resize (r, 1); + retval(2) = AtInf; + } retval(1) = C; - AtInf.resize (r, 1); - retval(2) = AtInf; - - // free long memory - qh_freeqhull (! qh_ALL); - - // free short memory and memory allocator - int curlong, totlong; - qh_memfreeshort (&curlong, &totlong); - - if (curlong || totlong) - warning ("__voronoi__: did not free %d bytes of long memory (%d pieces)", totlong, curlong); + retval(0) = v; } else error ("__voronoi__: qhull failed"); + // free memory from Qhull + qh_freeqhull (! qh_ALL); + + int curlong, totlong; + qh_memfreeshort (&curlong, &totlong); + + if (curlong || totlong) + warning ("__voronoi__: did not free %d bytes of long memory (%d pieces)", + totlong, curlong); + #else error ("__voronoi__: not available in this version of Octave"); #endif return retval; } + +/* + +## No test needed for internal helper function. +%!assert (1) + +*/
--- a/src/DLD-FUNCTIONS/bsxfun.cc +++ b/src/DLD-FUNCTIONS/bsxfun.cc @@ -312,15 +312,18 @@ DEFUN_DLD (bsxfun, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} bsxfun (@var{f}, @var{A}, @var{B})\n\ -Apply a binary function @var{f} element-by-element to two matrix arguments\n\ -@var{A} and @var{B}. @var{f} is a function handle, inline function, or\n\ -string containing the name of the function to evaluate.\n\ -The function @var{f} must be capable of accepting two column-vector\n\ -arguments of equal length, or one column vector argument and a scalar.\n\ +The binary singleton expansion function applier does what its name\n\ +suggests: applies a binary function @var{f} element-by-element to two\n\ +array arguments @var{A} and @var{B}, and expands as necessary\n\ +singleton dimensions in either input argument. @var{f} is a function\n\ +handle, inline function, or string containing the name of the function\n\ +to evaluate. The function @var{f} must be capable of accepting two\n\ +column-vector arguments of equal length, or one column vector argument\n\ +and a scalar.\n\ \n\ -The dimensions of @var{A} and @var{B} must be equal or singleton. The\n\ -singleton dimensions of the matrices will be expanded to the same\n\ -dimensionality as the other matrix.\n\ +The dimensions of @var{A} and @var{B} must be equal or singleton. The\n\ +singleton dimensions of the arrays will be expanded to the same\n\ +dimensionality as the other array.\n\ @seealso{arrayfun, cellfun}\n\ @end deftypefn") { @@ -766,4 +769,45 @@ %!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 +% +%!test +%! funs = {@plus, @minus, @times, @rdivide, @ldivide, @power, @max, @min, \ +%! @rem, @mod, @atan2, @hypot, @eq, @ne, @lt, @le, @gt, @ge, \ +%! @and, @or, @xor }; +%! +%! float_types = {@single, @double}; +%! int_types = {@int8, @int16, @int32, @int64, \ +%! @uint8, @uint16, @uint32, @uint64}; +%! +%! x = rand (3)*10-5; +%! y = rand (3,1)*10-5; +%! +%! for i=1:length (funs) +%! for j = 1:length(float_types) +%! for k = 1:length(int_types) +%! +%! fun = funs{i}; +%! f_type = float_types{j}; +%! i_type = int_types{k}; +%! +%! assert (bsxfun (fun, f_type (x), i_type (y)), \ +%! fun (f_type(x), i_type (y))); +%! assert (bsxfun (fun, f_type (y), i_type (x)), \ +%! fun (f_type(y), i_type (x))); +%! +%! assert (bsxfun (fun, i_type (x), i_type (y)), \ +%! fun (i_type (x), i_type (y))); +%! assert (bsxfun (fun, i_type (y), i_type (x)), \ +%! fun (i_type (y), i_type (x))); +%! +%! assert (bsxfun (fun, f_type (x), f_type (y)), \ +%! fun (f_type (x), f_type (y))); +%! assert (bsxfun (fun, f_type(y), f_type(x)), \ +%! fun (f_type (y), f_type (x))); +%! endfor +%! endfor +%! endfor +%! */
--- a/src/DLD-FUNCTIONS/ccolamd.cc +++ b/src/DLD-FUNCTIONS/ccolamd.cc @@ -453,7 +453,7 @@ } } - octave_idx_type n_row, n_col, nnz; + octave_idx_type n_row, n_col; octave_idx_type *ridx, *cidx; SparseMatrix sm; SparseComplexMatrix scm; @@ -465,7 +465,6 @@ scm = args(0).sparse_complex_matrix_value (); n_row = scm.rows (); n_col = scm.cols (); - nnz = scm.nnz (); ridx = scm.xridx (); cidx = scm.xcidx (); } @@ -474,7 +473,6 @@ sm = args(0).sparse_matrix_value (); n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); } @@ -488,7 +486,6 @@ n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); }
--- a/src/DLD-FUNCTIONS/cellfun.cc +++ b/src/DLD-FUNCTIONS/cellfun.cc @@ -1,6 +1,7 @@ /* Copyright (C) 2005-2011 Mohamed Kamoun +Copyright (C) 2006-2011 Bill Denney Copyright (C) 2009 Jaroslav Hajek Copyright (C) 2010 VZLU Prague @@ -44,6 +45,7 @@ #include "gripes.h" #include "utils.h" +#include "ov-class.h" #include "ov-scalar.h" #include "ov-float.h" #include "ov-complex.h" @@ -58,6 +60,8 @@ #include "ov-uint32.h" #include "ov-uint64.h" +#include "ov-fcn-handle.h" + static octave_value_list get_output_list (octave_idx_type count, octave_idx_type nargout, const octave_value_list& inputlist, @@ -74,11 +78,16 @@ msg.assign ("identifier", last_error_id ()); msg.assign ("message", last_error_message ()); msg.assign ("index", static_cast<double> (count + static_cast<octave_idx_type>(1))); + octave_value_list errlist = inputlist; errlist.prepend (msg); + buffer_error_messages--; + error_state = 0; + tmp = error_handler.do_multi_index_op (nargout, errlist); + buffer_error_messages++; if (error_state) @@ -91,6 +100,155 @@ return tmp; } +static octave_value_list +try_cellfun_internal_ops (const octave_value_list& args, int nargin) +{ + octave_value_list retval; + + std::string name = args(0).string_value (); + + const Cell f_args = args(1).cell_value (); + + octave_idx_type k = f_args.numel (); + + if (name == "isempty") + { + boolNDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + result(count) = f_args.elem(count).is_empty (); + retval(0) = result; + } + else if (name == "islogical") + { + boolNDArray result (f_args.dims ()); + for (octave_idx_type count= 0; count < k; count++) + result(count) = f_args.elem(count).is_bool_type (); + retval(0) = result; + } + else if (name == "isreal") + { + boolNDArray result (f_args.dims ()); + for (octave_idx_type count= 0; count < k; count++) + result(count) = f_args.elem(count).is_real_type (); + retval(0) = result; + } + else if (name == "length") + { + NDArray result (f_args.dims ()); + for (octave_idx_type count= 0; count < k; count++) + result(count) = static_cast<double> (f_args.elem(count).length ()); + retval(0) = result; + } + else if (name == "ndims") + { + NDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + result(count) = static_cast<double> (f_args.elem(count).ndims ()); + retval(0) = result; + } + else if (name == "prodofsize" || name == "numel") + { + NDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + result(count) = static_cast<double> (f_args.elem(count).numel ()); + retval(0) = result; + } + else if (name == "size") + { + if (nargin == 3) + { + int d = args(2).nint_value () - 1; + + if (d < 0) + error ("cellfun: K must be a positive integer"); + + if (! error_state) + { + NDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + { + dim_vector dv = f_args.elem(count).dims (); + if (d < dv.length ()) + result(count) = static_cast<double> (dv(d)); + else + result(count) = 1.0; + } + retval(0) = result; + } + } + else + error ("cellfun: not enough arguments for \"size\""); + } + else if (name == "isclass") + { + if (nargin == 3) + { + std::string class_name = args(2).string_value(); + boolNDArray result (f_args.dims ()); + for (octave_idx_type count = 0; count < k; count++) + result(count) = (f_args.elem(count).class_name() == class_name); + + retval(0) = result; + } + else + error ("cellfun: not enough arguments for \"isclass\""); + } + + return retval; +} + +static void +get_mapper_fun_options (const octave_value_list& args, int& nargin, + bool& uniform_output, octave_value& error_handler) +{ + while (nargin > 3 && args(nargin-2).is_string ()) + { + std::string arg = args(nargin-2).string_value (); + + std::transform (arg.begin (), arg.end (), + arg.begin (), tolower); + + if (arg == "uniformoutput") + uniform_output = args(nargin-1).bool_value(); + else if (arg == "errorhandler") + { + if (args(nargin-1).is_function_handle () + || args(nargin-1).is_inline_function ()) + { + error_handler = args(nargin-1); + } + else if (args(nargin-1).is_string ()) + { + std::string err_name = args(nargin-1).string_value (); + + error_handler = symbol_table::find_function (err_name); + + if (error_handler.is_undefined ()) + { + error ("cellfun: invalid function NAME: %s", + err_name.c_str ()); + break; + } + } + else + { + error ("cellfun: invalid value for 'ErrorHandler' function"); + break; + } + } + else + { + error ("cellfun: unrecognized parameter %s", + arg.c_str()); + break; + } + + nargin -= 2; + } + + nargin -= 1; +} + DEFUN_DLD (cellfun, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} cellfun (@var{name}, @var{C})\n\ @@ -122,8 +280,10 @@ @item ndims\n\ Return the number of dimensions of each element.\n\ \n\ -@item prodofsize\n\ -Return the product of dimensions of each element.\n\ +@item numel\n\ +@itemx prodofsize\n\ +Return the number of elements contained within each cell element. The\n\ +number is the product of the dimensions of the object at each cell element.\n\ \n\ @item size\n\ Return the size along the @var{k}-th dimension.\n\ @@ -142,7 +302,7 @@ \n\ @example\n\ @group\n\ -cellfun (@@atan2, @{1, 0@}, @{0, 1@})\n\ +cellfun (\"atan2\", @{1, 0@}, @{0, 1@})\n\ @result{}ans = [1.57080 0.00000]\n\ @end group\n\ @end example\n\ @@ -177,7 +337,7 @@ \n\ @example\n\ @group\n\ -cellfun (\"tolower(x)\", @{\"Foo\", \"Bar\", \"FooBar\"@},\n\ +cellfun (\"tolower\", @{\"Foo\", \"Bar\", \"FooBar\"@},\n\ \"UniformOutput\",false)\n\ @result{} ans = @{\"foo\", \"bar\", \"foobar\"@}\n\ @end group\n\ @@ -200,7 +360,7 @@ @example\n\ @group\n\ function y = foo (s, x), y = NaN; endfunction\n\ -cellfun (@@factorial, @{-1,2@},'ErrorHandler',@@foo)\n\ +cellfun (\"factorial\", @{-1,2@}, 'ErrorHandler', @@foo)\n\ @result{} ans = [NaN 2]\n\ @end group\n\ @end example\n\ @@ -220,6 +380,7 @@ } octave_value func = args(0); + bool symbol_table_lookup = false; if (! args(1).is_cell ()) { @@ -230,172 +391,79 @@ if (func.is_string ()) { - const Cell f_args = args(1).cell_value (); + retval = try_cellfun_internal_ops (args, nargin); - octave_idx_type k = f_args.numel (); - - std::string name = func.string_value (); + if (error_state || ! retval.empty ()) + return retval; - if (name == "isempty") - { - boolNDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - result(count) = f_args.elem(count).is_empty (); - retval(0) = result; - } - else if (name == "islogical") - { - boolNDArray result (f_args.dims ()); - for (octave_idx_type count= 0; count < k ; count++) - result(count) = f_args.elem(count).is_bool_type (); - retval(0) = result; - } - else if (name == "isreal") - { - boolNDArray result (f_args.dims ()); - for (octave_idx_type count= 0; count < k ; count++) - result(count) = f_args.elem(count).is_real_type (); - retval(0) = result; - } - else if (name == "length") - { - NDArray result (f_args.dims ()); - for (octave_idx_type count= 0; count < k ; count++) - result(count) = static_cast<double> (f_args.elem(count).length ()); - retval(0) = result; - } - else if (name == "ndims") - { - NDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - result(count) = static_cast<double> (f_args.elem(count).ndims ()); - retval(0) = result; - } - else if (name == "prodofsize" || name == "numel") + // See if we can convert the string into a function. + + std::string name = args(0).string_value (); + + if (! valid_identifier (name)) { - NDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - result(count) = static_cast<double> (f_args.elem(count).numel ()); - retval(0) = result; - } - else if (name == "size") - { - if (nargin == 3) - { - int d = args(2).nint_value () - 1; - - if (d < 0) - error ("cellfun: K must be a positive integer"); + std::string fcn_name = unique_symbol_name ("__cellfun_fcn_"); + std::string fname = "function y = " + fcn_name + "(x) y = "; - if (! error_state) - { - NDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - { - dim_vector dv = f_args.elem(count).dims (); - if (d < dv.length ()) - result(count) = static_cast<double> (dv(d)); - else - result(count) = 1.0; - } - retval(0) = result; - } - } - else - error ("cellfun: not enough arguments for \"size\""); - } - else if (name == "isclass") - { - if (nargin == 3) - { - std::string class_name = args(2).string_value(); - boolNDArray result (f_args.dims ()); - for (octave_idx_type count = 0; count < k ; count++) - result(count) = (f_args.elem(count).class_name() == class_name); + octave_function *ptr_func + = extract_function (args(0), "cellfun", fcn_name, + fname, "; endfunction"); - retval(0) = result; - } - else - error ("cellfun: not enough arguments for \"isclass\""); + if (ptr_func && ! error_state) + func = octave_value (ptr_func, true); } else { - if (! valid_identifier (name)) - { + func = symbol_table::find_function (name); + + if (func.is_undefined ()) + error ("cellfun: invalid function NAME: %s", name.c_str ()); - std::string fcn_name = unique_symbol_name ("__cellfun_fcn_"); - std::string fname = "function y = "; - fname.append (fcn_name); - fname.append ("(x) y = "); - octave_function *ptr_func = extract_function (args(0), "cellfun", - fcn_name, fname, "; endfunction"); - if (ptr_func && ! error_state) - func = octave_value (ptr_func, true); - } - else - { - func = symbol_table::find_function (name); - if (func.is_undefined ()) - error ("cellfun: invalid function NAME: %s", name.c_str ()); - } + symbol_table_lookup = true; } + + if (error_state || ! retval.empty ()) + return retval; } - if (error_state || ! retval.empty ()) - return retval; - if (func.is_function_handle () || func.is_inline_function () || func.is_function ()) { - unwind_protect frame; - frame.protect_var (buffer_error_messages); + // The following is an optimisation because the symbol table can + // give a more specific function class, so this can result in + // fewer polymorphic function calls as the function gets called + // for each value of the array. + + if (! symbol_table_lookup ) + { + if (func.is_function_handle ()) + { + octave_fcn_handle* f = func.fcn_handle_value (); + + // Overloaded function handles need to check the type of + // the arguments for each element of the array, so they + // cannot be optimised this way. + + if (f -> is_overloaded ()) + goto nevermind; + } + octave_value f = symbol_table::find_function (func.function_value () + -> name ()); + if (f.is_defined ()) + func = f; + } + + nevermind: bool uniform_output = true; octave_value error_handler; - - while (nargin > 3 && args(nargin-2).is_string()) - { - std::string arg = args(nargin-2).string_value(); - - std::transform (arg.begin (), arg.end (), - arg.begin (), tolower); + + get_mapper_fun_options (args, nargin, uniform_output, error_handler); - if (arg == "uniformoutput") - uniform_output = args(nargin-1).bool_value(); - else if (arg == "errorhandler") - { - if (args(nargin-1).is_function_handle () || - args(nargin-1).is_inline_function ()) - { - error_handler = args(nargin-1); - } - else if (args(nargin-1).is_string ()) - { - std::string err_name = args(nargin-1).string_value (); - error_handler = symbol_table::find_function (err_name); - if (error_handler.is_undefined ()) - { - error ("cellfun: invalid function NAME: %s", err_name.c_str ()); - break; - } - } - else - { - error ("cellfun: invalid value for 'ErrorHandler' function"); - break; - } - } - else - { - error ("cellfun: unrecognized parameter %s", - arg.c_str()); - break; - } + if (error_state) + return octave_value_list (); - nargin -= 2; - } - - nargin -= 1; + // Extract cell arguments. octave_value_list inputlist (nargin, octave_value ()); @@ -409,8 +477,8 @@ dim_vector fdims (1, 1); - if (error_state) - return octave_value_list (); + // Collect arguments. Pre-fill scalar elements of inputlist + // array. for (int j = 0; j < nargin; j++) { @@ -444,9 +512,14 @@ } } + unwind_protect frame; + frame.protect_var (buffer_error_messages); + if (error_handler.is_defined ()) buffer_error_messages++; + // Apply functions. + if (uniform_output) { std::list<octave_value_list> idx_list (1); @@ -455,7 +528,7 @@ OCTAVE_LOCAL_BUFFER (octave_value, retv, nargout1); - for (octave_idx_type count = 0; count < k ; count++) + for (octave_idx_type count = 0; count < k; count++) { for (int j = 0; j < nargin; j++) { @@ -463,59 +536,71 @@ inputlist.xelem (j) = cinputs[j](count); } - const octave_value_list tmp = get_output_list (count, nargout, inputlist, - func, error_handler); + const octave_value_list tmp + = get_output_list (count, nargout, inputlist, func, + error_handler); if (error_state) return retval; - if (tmp.length () < nargout1) + if (nargout > 0 && tmp.length () < nargout) { - if (tmp.length () < nargout) - { - error ("cellfun: too many output arguments"); - return octave_value_list (); - } - else - nargout1 = 0; + error ("cellfun: function returned fewer than nargout values"); + return retval; } - if (count == 0) + if (nargout > 0 + || (nargout == 0 + && tmp.length () > 0 && tmp(0).is_defined ())) { - for (int j = 0; j < nargout1; j++) - { - octave_value val = tmp(j); + int num_to_copy = tmp.length (); + + if (num_to_copy > nargout1) + num_to_copy = nargout1; - if (val.numel () == 1) - retv[j] = val.resize (fdims); - else + if (count == 0) + { + for (int j = 0; j < num_to_copy; j++) { - error ("cellfun: all values must be scalars when UniformOutput = true"); - break; + if (tmp(j).is_defined ()) + { + octave_value val = tmp(j); + + if (val.numel () == 1) + retv[j] = val.resize (fdims); + else + { + error ("cellfun: all values must be scalars when UniformOutput = true"); + break; + } + } } } - } - else - { - for (int j = 0; j < nargout1; j++) + else { - octave_value val = tmp(j); - - if (! retv[j].fast_elem_insert (count, val)) + for (int j = 0; j < num_to_copy; j++) { - if (val.numel () == 1) + if (tmp(j).is_defined ()) { - idx_list.front ()(0) = count + 1.0; - retv[j].assign (octave_value::op_asn_eq, - idx_type, idx_list, val); + octave_value val = tmp(j); + + if (! retv[j].fast_elem_insert (count, val)) + { + if (val.numel () == 1) + { + idx_list.front ()(0) = count + 1.0; + retv[j].assign (octave_value::op_asn_eq, + idx_type, idx_list, val); - if (error_state) - break; - } - else - { - error ("cellfun: all values must be scalars when UniformOutput = true"); - break; + if (error_state) + break; + } + else + { + error ("cellfun: all values must be scalars when UniformOutput = true"); + break; + } + } } } } @@ -526,6 +611,7 @@ } retval.resize (nargout1); + for (int j = 0; j < nargout1; j++) { if (nargout > 0 && retv[j].is_undefined ()) @@ -537,10 +623,13 @@ else { OCTAVE_LOCAL_BUFFER (Cell, results, nargout1); + for (int j = 0; j < nargout1; j++) - results[j].resize (fdims); + results[j].resize (fdims, Matrix ()); - for (octave_idx_type count = 0; count < k ; count++) + bool have_some_output = false; + + for (octave_idx_type count = 0; count < k; count++) { for (int j = 0; j < nargin; j++) { @@ -548,31 +637,43 @@ inputlist.xelem (j) = cinputs[j](count); } - const octave_value_list tmp = get_output_list (count, nargout, inputlist, - func, error_handler); + const octave_value_list tmp + = get_output_list (count, nargout, inputlist, func, + error_handler); if (error_state) return retval; - if (tmp.length () < nargout1) + if (nargout > 0 && tmp.length () < nargout) { - if (tmp.length () < nargout) - { - error ("cellfun: too many output arguments"); - return octave_value_list (); - } - else - nargout1 = 0; + error ("cellfun: function returned fewer than nargout values"); + return retval; } + if (nargout > 0 + || (nargout == 0 + && tmp.length () > 0 && tmp(0).is_defined ())) + { + int num_to_copy = tmp.length (); + + if (num_to_copy > nargout1) + num_to_copy = nargout1; + + if (num_to_copy > 0) + have_some_output = true; + + for (int j = 0; j < num_to_copy; j++) + results[j](count) = tmp(j); + } + } + + if (have_some_output || fdims.any_zero ()) + { + retval.resize (nargout1); for (int j = 0; j < nargout1; j++) - results[j](count) = tmp(j); + retval(j) = results[j]; } - - retval.resize(nargout1); - for (int j = 0; j < nargout1; j++) - retval(j) = results[j]; } } else @@ -583,6 +684,35 @@ /* +%!function r = f11 (x) +%! global __cellfun_test_num_outputs__ +%! __cellfun_test_num_outputs__ = nargout; +%! r = x; +%! endfunction + +%!function f01 (x) +%! global __cellfun_test_num_outputs__ +%! __cellfun_test_num_outputs__ = nargout; +%! endfunction + +%!test +%! global __cellfun_test_num_outputs__ +%! cellfun (@f11, {1}); +%! assert (__cellfun_test_num_outputs__, 0) +%! x = cellfun (@f11, {1}); +%! assert (__cellfun_test_num_outputs__, 1) + +%!test +%! global __cellfun_test_num_outputs__ +%! cellfun (@f01, {1}); +%! 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}) + %!test %! [a,b] = cellfun (@(x) x, cell (2, 0)); %! assert (a, zeros (2, 0)); @@ -852,6 +982,643 @@ */ +// Arrayfun was originally a .m file written by Bill Denney and Jaroslav +// Hajek. It was converted to C++ by jwe so that it could properly +// handle the nargout = 0 case. + +DEFUN_DLD (arrayfun, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} {} arrayfun (@var{func}, @var{A})\n\ +@deftypefnx {Function File} {@var{x} =} arrayfun (@var{func}, @var{A})\n\ +@deftypefnx {Function File} {@var{x} =} arrayfun (@var{func}, @var{A}, @var{b}, @dots{})\n\ +@deftypefnx {Function File} {[@var{x}, @var{y}, @dots{}] =} arrayfun (@var{func}, @var{A}, @dots{})\n\ +@deftypefnx {Function File} {} arrayfun (@dots{}, \"UniformOutput\", @var{val})\n\ +@deftypefnx {Function File} {} arrayfun (@dots{}, \"ErrorHandler\", @var{errfunc})\n\ +\n\ +Execute a function on each element of an array. This is useful for\n\ +functions that do not accept array arguments. If the function does\n\ +accept array arguments it is better to call the function directly.\n\ +\n\ +The first input argument @var{func} can be a string, a function\n\ +handle, an inline function, or an anonymous function. The input\n\ +argument @var{A} can be a logic array, a numeric array, a string\n\ +array, a structure array, or a cell array. By a call of the function\n\ +@command{arrayfun} all elements of @var{A} are passed on to the named\n\ +function @var{func} individually.\n\ +\n\ +The named function can also take more than two input arguments, with\n\ +the input arguments given as third input argument @var{b}, fourth\n\ +input argument @var{c}, @dots{} If given more than one array input\n\ +argument then all input arguments must have the same sizes, for\n\ +example:\n\ +\n\ +@example\n\ +@group\n\ +arrayfun (@@atan2, [1, 0], [0, 1])\n\ +@result{} ans = [1.5708 0.0000]\n\ +@end group\n\ +@end example\n\ +\n\ +If the parameter @var{val} after a further string input argument\n\ +\"UniformOutput\" is set @code{true} (the default), then the named\n\ +function @var{func} must return a single element which then will be\n\ +concatenated into the return value and is of type matrix. Otherwise,\n\ +if that parameter is set to @code{false}, then the outputs are\n\ +concatenated in a cell array. For example:\n\ +\n\ +@example\n\ +@group\n\ +arrayfun (@@(x,y) x:y, \"abc\", \"def\", \"UniformOutput\", false)\n\ +@result{} ans =\n\ +@{\n\ + [1,1] = abcd\n\ + [1,2] = bcde\n\ + [1,3] = cdef\n\ +@}\n\ +@end group\n\ +@end example\n\ +\n\ +If more than one output arguments are given then the named function\n\ +must return the number of return values that also are expected, for\n\ +example:\n\ +\n\ +@example\n\ +@group\n\ +[A, B, C] = arrayfun (@@find, [10; 0], \"UniformOutput\", false)\n\ +@result{}\n\ +A =\n\ +@{\n\ + [1,1] = 1\n\ + [2,1] = [](0x0)\n\ +@}\n\ +B =\n\ +@{\n\ + [1,1] = 1\n\ + [2,1] = [](0x0)\n\ +@}\n\ +C =\n\ +@{\n\ + [1,1] = 10\n\ + [2,1] = [](0x0)\n\ +@}\n\ +@end group\n\ +@end example\n\ +\n\ +If the parameter @var{errfunc} after a further string input argument\n\ +\"ErrorHandler\" is another string, a function handle, an inline\n\ +function, or an anonymous function, then @var{errfunc} defines a\n\ +function to call in the case that @var{func} generates an error.\n\ +The definition of the function must be of the form\n\ +\n\ +@example\n\ +function [@dots{}] = errfunc (@var{s}, @dots{})\n\ +@end example\n\ +\n\ +@noindent\n\ +where there is an additional input argument to @var{errfunc}\n\ +relative to @var{func}, given by @var{s}. This is a structure with\n\ +the elements \"identifier\", \"message\", and \"index\" giving,\n\ +respectively, the error identifier, the error message, and the index of\n\ +the array elements that caused the error. The size of the output\n\ +argument of @var{errfunc} must have the same size as the output\n\ +argument of @var{func}, otherwise a real error is thrown. For\n\ +example:\n\ +\n\ +@example\n\ +@group\n\ +function y = ferr (s, x), y = \"MyString\"; endfunction\n\ +arrayfun (@@str2num, [1234], \\n\ + \"UniformOutput\", false, \"ErrorHandler\", @@ferr)\n\ +@result{} ans =\n\ +@{\n\ + [1,1] = MyString\n\ +@}\n\ +@end group\n\ +@end example\n\ +\n\ +@seealso{spfun, cellfun, structfun}\n\ +@end deftypefn") +{ + octave_value_list retval; + int nargin = args.length (); + int nargout1 = (nargout < 1 ? 1 : nargout); + + if (nargin < 2) + { + error ("arrayfun: function requires at least 2 arguments"); + print_usage (); + return retval; + } + + octave_value func = args(0); + bool symbol_table_lookup = false; + + if (func.is_string ()) + { + // See if we can convert the string into a function. + + std::string name = args(0).string_value (); + + if (! valid_identifier (name)) + { + std::string fcn_name = unique_symbol_name ("__arrayfun_fcn_"); + std::string fname = "function y = " + fcn_name + "(x) y = "; + + octave_function *ptr_func + = extract_function (args(0), "arrayfun", fcn_name, + fname, "; endfunction"); + + if (ptr_func && ! error_state) + func = octave_value (ptr_func, true); + } + else + { + func = symbol_table::find_function (name); + + if (func.is_undefined ()) + error ("arrayfun: invalid function NAME: %s", name.c_str ()); + + symbol_table_lookup = true; + } + + if (error_state) + return retval; + } + + if (func.is_function_handle () || func.is_inline_function () + || func.is_function ()) + { + // The following is an optimisation because the symbol table can + // give a more specific function class, so this can result in + // fewer polymorphic function calls as the function gets called + // for each value of the array. + + if (! symbol_table_lookup ) + { + if (func.is_function_handle ()) + { + octave_fcn_handle* f = func.fcn_handle_value (); + + // Overloaded function handles need to check the type of + // the arguments for each element of the array, so they + // cannot be optimised this way. + + if (f -> is_overloaded ()) + goto nevermind; + } + octave_value f = symbol_table::find_function (func.function_value () + -> name ()); + if (f.is_defined ()) + func = f; + } + + nevermind: + + bool uniform_output = true; + octave_value error_handler; + + get_mapper_fun_options (args, nargin, uniform_output, error_handler); + + if (error_state) + return octave_value_list (); + + octave_value_list inputlist (nargin, octave_value ()); + + OCTAVE_LOCAL_BUFFER (octave_value, inputs, nargin); + OCTAVE_LOCAL_BUFFER (bool, mask, nargin); + + octave_idx_type k = 1; + + dim_vector fdims (1, 1); + + // Collect arguments. Pre-fill scalar elements of inputlist + // array. + + for (int j = 0; j < nargin; j++) + { + inputs[j] = args(j+1); + mask[j] = inputs[j].numel () != 1; + + if (! mask[j]) + inputlist(j) = inputs[j]; + } + + for (int j = 0; j < nargin; j++) + { + if (mask[j]) + { + fdims = inputs[j].dims (); + k = inputs[j].numel (); + + for (int i = j+1; i < nargin; i++) + { + if (mask[i] && inputs[i].dims () != fdims) + { + error ("arrayfun: dimensions mismatch"); + return retval; + } + } + break; + } + } + + + unwind_protect frame; + frame.protect_var (buffer_error_messages); + + if (error_handler.is_defined ()) + buffer_error_messages++; + + // Apply functions. + + if (uniform_output) + { + std::list<octave_value_list> idx_list (1); + idx_list.front ().resize (1); + std::string idx_type = "("; + + OCTAVE_LOCAL_BUFFER (octave_value, retv, nargout1); + + for (octave_idx_type count = 0; count < k; count++) + { + idx_list.front ()(0) = count + 1.0; + + for (int j = 0; j < nargin; j++) + { + if (mask[j]) + inputlist.xelem (j) = inputs[j].do_index_op (idx_list); + + if (error_state) + return retval; + } + + const octave_value_list tmp + = get_output_list (count, nargout, inputlist, func, + error_handler); + + if (error_state) + return retval; + + if (nargout > 0 && tmp.length () < nargout) + { + error ("arrayfun: function returned fewer than nargout values"); + return retval; + } + + if (nargout > 0 + || (nargout == 0 + && tmp.length () > 0 && tmp(0).is_defined ())) + { + int num_to_copy = tmp.length (); + + if (num_to_copy > nargout1) + num_to_copy = nargout1; + + if (count == 0) + { + for (int j = 0; j < num_to_copy; j++) + { + if (tmp(j).is_defined ()) + { + octave_value val = tmp(j); + + if (val.numel () == 1) + retv[j] = val.resize (fdims); + else + { + error ("arrayfun: all values must be scalars when UniformOutput = true"); + break; + } + } + } + } + else + { + for (int j = 0; j < num_to_copy; j++) + { + if (tmp(j).is_defined ()) + { + octave_value val = tmp(j); + + if (! retv[j].fast_elem_insert (count, val)) + { + if (val.numel () == 1) + { + idx_list.front ()(0) = count + 1.0; + retv[j].assign (octave_value::op_asn_eq, + idx_type, idx_list, val); + + if (error_state) + break; + } + else + { + error ("arrayfun: all values must be scalars when UniformOutput = true"); + break; + } + } + } + } + } + } + + if (error_state) + break; + } + + retval.resize (nargout1); + + for (int j = 0; j < nargout1; j++) + { + if (nargout > 0 && retv[j].is_undefined ()) + retval(j) = NDArray (fdims); + else + retval(j) = retv[j]; + } + } + else + { + std::list<octave_value_list> idx_list (1); + idx_list.front ().resize (1); + std::string idx_type = "("; + + OCTAVE_LOCAL_BUFFER (Cell, results, nargout1); + + for (int j = 0; j < nargout1; j++) + results[j].resize (fdims, Matrix ()); + + bool have_some_output = false; + + for (octave_idx_type count = 0; count < k; count++) + { + idx_list.front ()(0) = count + 1.0; + + for (int j = 0; j < nargin; j++) + { + if (mask[j]) + inputlist.xelem (j) = inputs[j].do_index_op (idx_list); + + if (error_state) + return retval; + } + + const octave_value_list tmp + = get_output_list (count, nargout, inputlist, func, + error_handler); + + if (error_state) + return retval; + + if (nargout > 0 && tmp.length () < nargout) + { + error ("arrayfun: function returned fewer than nargout values"); + return retval; + } + + if (nargout > 0 + || (nargout == 0 + && tmp.length () > 0 && tmp(0).is_defined ())) + { + int num_to_copy = tmp.length (); + + if (num_to_copy > nargout1) + num_to_copy = nargout1; + + if (num_to_copy > 0) + have_some_output = true; + + for (int j = 0; j < num_to_copy; j++) + results[j](count) = tmp(j); + } + } + + if (have_some_output || fdims.any_zero ()) + { + retval.resize (nargout1); + + for (int j = 0; j < nargout1; j++) + retval(j) = results[j]; + } + } + } + else + error ("arrayfun: argument NAME must be a string or function handle"); + + return retval; +} + +/* +%!function r = f11 (x) +%! global __arrayfun_test_num_outputs__ +%! __arrayfun_test_num_outputs__ = nargout; +%! r = x; +%! endfunction + +%!function f01 (x) +%! global __arrayfun_test_num_outputs__ +%! __arrayfun_test_num_outputs__ = nargout; +%! endfunction + +%!test +%! global __arrayfun_test_num_outputs__ +%! arrayfun (@f11, {1}); +%! assert (__arrayfun_test_num_outputs__, 0) +%! x = arrayfun (@f11, {1}); +%! assert (__arrayfun_test_num_outputs__, 1) + +%!test +%! global __arrayfun_test_num_outputs__ +%! arrayfun (@f01, {1}); +%! 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 (@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; +%! 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 +%!error +%! arrayfun (@isequal); %% One or less input arguments +%!test +%! 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]); +%!test +%! 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]); + +%% Number of input and output arguments may be greater than one +%#!test +%! 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); +%!test %% Two input arguments of different types +%! 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); +%!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})); + +%% Input arguments can be of type logical +%!test +%! 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]); +%!test +%! 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})); +%!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); +%!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); + +%% 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]); +%!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]); +%!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])); +%!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})); +%!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]); +%!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]); + +%% 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]); +%!test +%! 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); + +%% 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); +%!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); +%!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]})); +%!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); +%!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); + +%% 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]); +%!test +%! 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}); +%!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]); +%!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]); +*/ + static void do_num2cell_helper (const dim_vector& dv, const Array<int>& dimv, @@ -945,6 +1712,66 @@ } } +// FIXME -- this is a mess, but if a size method for the object exists, +// we have to call it to get the size of the object instead of using the +// internal dims method. + +static dim_vector +get_object_dims (octave_value& obj) +{ + dim_vector retval; + + Matrix m = obj.size (); + + int n = m.numel (); + + retval.resize (n); + + for (int i = 0; i < n; i++) + retval(i) = m(i); + + return retval; +} + +static Cell +do_object2cell (const octave_value& obj, const Array<int>& dimv) +{ + Cell retval; + + // FIXME -- this copy is only needed because the octave_value::size + // method is not const. + octave_value array = obj; + + if (dimv.is_empty ()) + { + dim_vector dv = get_object_dims (array); + + if (! error_state) + { + retval.resize (dv); + + octave_value_list idx (1); + + for (octave_idx_type i = 0; i < dv.numel (); i++) + { + octave_quit (); + + idx(0) = double (i+1); + + retval.xelem(i) = array.single_subsref ("(", idx); + + if (error_state) + break; + } + } + } + else + { + error ("num2cell (A, dim) not implemented for class objects"); + } + + return retval; +} DEFUN_DLD (num2cell, args, , "-*- texinfo -*-\n\ @@ -1034,10 +1861,14 @@ retval = do_num2cell (array.array_value (), dimv); } } + else if (array.is_object ()) + retval = do_object2cell (array, dimv); else if (array.is_map ()) retval = do_num2cell (array.map_value (), dimv); else if (array.is_cell ()) retval = do_num2cell (array.cell_value (), dimv); + else if (array.is_object ()) + retval = do_num2cell (array.cell_value (), dimv); else gripe_wrong_type_arg ("num2cell", array); }
--- a/src/DLD-FUNCTIONS/chol.cc +++ b/src/DLD-FUNCTIONS/chol.cc @@ -493,9 +493,6 @@ %!testif HAVE_CHOLMOD %! Ainv3 = cholinv(sparse(A)); %! assert (norm(Ainv-Ainv3),0,1e-10) -%!testif HAVE_CHOLMOD -%! Ainv4 = spcholinv(sparse(A)); -%! assert (norm(Ainv-Ainv4),0,1e-10) */
--- a/src/DLD-FUNCTIONS/colamd.cc +++ b/src/DLD-FUNCTIONS/colamd.cc @@ -544,7 +544,7 @@ octave_stdout << "symamd: dense row/col fraction: " << knobs [COLAMD_DENSE_ROW] << std::endl; - octave_idx_type n_row, n_col, nnz; + octave_idx_type n_row, n_col; octave_idx_type *ridx, *cidx; SparseMatrix sm; SparseComplexMatrix scm; @@ -556,7 +556,6 @@ scm = args(0).sparse_complex_matrix_value (); n_row = scm.rows (); n_col = scm.cols (); - nnz = scm.nnz (); ridx = scm.xridx (); cidx = scm.xcidx (); } @@ -565,7 +564,6 @@ sm = args(0).sparse_matrix_value (); n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); } @@ -579,7 +577,6 @@ n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); } @@ -668,7 +665,7 @@ print_usage (); else { - octave_idx_type n_row, n_col, nnz; + octave_idx_type n_row, n_col; octave_idx_type *ridx, *cidx; bool is_sym = true; SparseMatrix sm; @@ -681,7 +678,6 @@ scm = args(0).sparse_complex_matrix_value (); n_row = scm.rows (); n_col = scm.cols (); - nnz = scm.nnz (); ridx = scm.xridx (); cidx = scm.xcidx (); } @@ -690,7 +686,6 @@ sm = args(0).sparse_matrix_value (); n_row = sm.rows (); n_col = sm.cols (); - nnz = sm.nnz (); ridx = sm.xridx (); cidx = sm.xcidx (); }
--- a/src/DLD-FUNCTIONS/config-module.awk +++ b/src/DLD-FUNCTIONS/config-module.awk @@ -1,4 +1,7 @@ BEGIN { + FS = "|"; + nfiles = 0; + print "## DO NOT EDIT -- generated from module-files by config-module.awk"; print "" print "EXTRA_DIST += \\" @@ -6,9 +9,14 @@ print " DLD-FUNCTIONS/config-module.awk \\" print " DLD-FUNCTIONS/module-files" print "" - nfiles = 0; -} { - files[++nfiles] = $1; +} +/^#.*/ { next; } +{ + nfiles++; + files[nfiles] = $1; + cppflags[nfiles] = $2; + ldflags[nfiles] = $3; + libraries[nfiles] = $4; } END { sep = " \\\n"; print "DLD_FUNCTIONS_SRC = \\"; @@ -22,9 +30,9 @@ sep = " \\\n"; print "DLD_FUNCTIONS_LIBS = $(DLD_FUNCTIONS_SRC:.cc=.la)"; print ""; - print "octlib_LTLIBRARIES += $(DLD_FUNCTIONS_LIBS)"; + print "if AMCOND_ENABLE_DYNAMIC_LINKING"; print ""; - print "if AMCOND_ENABLE_DYNAMIC_LINKING"; + print "octlib_LTLIBRARIES += $(DLD_FUNCTIONS_LIBS)"; print ""; print "## Use stamp files to avoid problems with checking timestamps"; print "## of symbolic links"; @@ -41,18 +49,28 @@ print "\t touch $(@F)"; print ""; } + print "else"; + print ""; + print "noinst_LTLIBRARIES = $(DLD_FUNCTIONS_LIBS)"; + print ""; print "endif"; - print ""; for (i = 1; i <= nfiles; i++) { basename = files[i]; sub (/\.cc$/, "", basename); + print ""; printf ("DLD_FUNCTIONS_%s_la_SOURCES = DLD-FUNCTIONS/%s\n", basename, files[i]); - printf ("DLD_FUNCTIONS_%s_la_LDFLAGS = @NO_UNDEFINED_LDFLAG@ -module\n", - basename); - printf ("DLD_FUNCTIONS_%s_la_LIBADD = $(OCT_LINK_DEPS)\n", basename); + if (cppflags[i]) + { + printf ("DLD-FUNCTIONS/%s.df: CPPFLAGS += %s\n", + basename, cppflags[i]); + printf ("DLD_FUNCTIONS_%s_la_CPPFLAGS = $(AM_CPPFLAGS) %s\n", + basename, cppflags[i]); + } + printf ("DLD_FUNCTIONS_%s_la_LDFLAGS = -avoid-version -module $(NO_UNDEFINED_LDFLAG) %s $(OCT_LINK_OPTS)\n", + basename, ldflags[i]); + printf ("DLD_FUNCTIONS_%s_la_LIBADD = liboctinterp.la ../liboctave/liboctave.la ../libcruft/libcruft.la %s $(OCT_LINK_DEPS)\n", + basename, libraries[i]); } - print ""; - }
--- a/src/DLD-FUNCTIONS/conv2.cc +++ b/src/DLD-FUNCTIONS/conv2.cc @@ -262,7 +262,6 @@ octave_value tmp; int nargin = args.length (); std::string shape = "full"; //default - bool separable = false; convn_type ct; if (nargin < 2 || nargin > 3) @@ -274,8 +273,6 @@ { if (args(2).is_string ()) shape = args(2).string_value (); - else - separable = true; } if (shape == "full")
--- a/src/DLD-FUNCTIONS/convhulln.cc +++ b/src/DLD-FUNCTIONS/convhulln.cc @@ -53,24 +53,39 @@ DEFUN_DLD (convhulln, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {@var{h} =} convhulln (@var{p})\n\ -@deftypefnx {Loadable Function} {@var{h} =} convhulln (@var{p}, @var{opt})\n\ +@deftypefn {Loadable Function} {@var{h} =} convhulln (@var{pts})\n\ +@deftypefnx {Loadable Function} {@var{h} =} convhulln (@var{pts}, @var{options})\n\ @deftypefnx {Loadable Function} {[@var{h}, @var{v}] =} convhulln (@dots{})\n\ -Return an index vector to the points of the enclosing convex hull.\n\ -The input matrix of size [n, dim] contains n points of dimension dim.\n\n\ -If a second optional argument is given, it must be a string or cell array\n\ -of strings containing options for the underlying qhull command. (See\n\ -the Qhull documentation for the available options.) The default options\n\ -are \"s Qci Tcv\".\n\ -If the second output @var{v} is requested the volume of the convex hull is\n\ -calculated.\n\n\ -@seealso{convhull, delaunayn}\n\ +Compute the convex hull of the set of points @var{pts} which is a matrix\n\ +of size [n, dim] containing n points in a space of dimension dim.\n\ +The hull @var{h} is an index vector into the set of points and specifies\n\ +which points form the enclosing hull.\n\ +\n\ +An optional second argument, which must be a string or cell array of strings,\n\ +contains options passed to the underlying qhull command.\n\ +See the documentation for the Qhull library for details\n\ +@url{http://www.qhull.org/html/qh-quick.htm#options}.\n\ +The default options depend on the dimension of the input:\n\ +\n\ +@itemize\n\ +@item 2D, 3D, 4D: @var{options} = @code{@{\"Qt\"@}}\n\ +\n\ +@item 5D and higher: @var{options} = @code{@{\"Qt\", \"Qx\"@}}\n\ +@end itemize\n\ +\n\ +If @var{options} is not present or @code{[]} then the default arguments are\n\ +used. Otherwise, @var{options} replaces the default argument list.\n\ +To append user options to the defaults it is necessary to repeat the\n\ +default arguments in @var{options}. Use a null string to pass no arguments.\n\ +\n\ +If the second output @var{v} is requested the volume of the enclosing\n\ +convex hull is calculated.\n\n\ +@seealso{convhull, delaunayn, voronoin}\n\ @end deftypefn") { octave_value_list retval; #ifdef HAVE_QHULL - std::string options; int nargin = args.length (); if (nargin < 1 || nargin > 2) @@ -79,85 +94,88 @@ return retval; } + Matrix p (args(0).matrix_value ()); + const octave_idx_type dim = p.columns (); + const octave_idx_type n = p.rows (); + + // Default options + std::string options; + if (dim <= 4) + options = "Qt"; + else + options = "Qt Qx"; + if (nargin == 2) { - if (args (1).is_string ()) + if (args(1).is_string ()) options = args(1).string_value (); - else if (args(1).is_cell ()) + else if (args(1).is_empty ()) + ; // Use default options + else if (args(1).is_cellstr ()) { - Cell c = args(1).cell_value (); options = ""; - for (octave_idx_type i = 0; i < c.numel (); i++) - { - if (! c.elem(i).is_string ()) - { - error ("convhulln: OPT must be a string or cell array of strings"); - return retval; - } + Array<std::string> tmp = args(1).cellstr_value (); - options = options + c.elem(i).string_value() + " "; - } + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += tmp(i) + " "; } else { - error ("convhulln: OPT must be a string or cell array of strings"); + error ("convhulln: OPTIONS must be a string, cell array of strings, or empty"); return retval; } - } - else - // turn on some consistency checks - options = "s Qci Tcv"; + } - Matrix p (args(0).matrix_value ()); - const octave_idx_type dim = p.columns (); - const octave_idx_type n = p.rows (); p = p.transpose (); - double *pt_array = p.fortran_vec (); - - boolT ismalloc = False; - - std::ostringstream buf; + boolT ismalloc = false; - buf << "qhull QJ " << options; - - std::string buf_string = buf.str (); + // FIXME: we can't just pass options.c_str () to qh_new_qhull + // because the argument is not declared const. Ugh. Unless qh_new_qhull + // really needs to modify this argument, someone should fix QHULL. + OCTAVE_LOCAL_BUFFER (char, flags, 7 + options.length ()); - // FIXME -- we can't just pass buf_string.c_str () to qh_new_qhull - // because the argument is not declared const. Ugh. Unless - // qh_new_qhull really needs to modify this argument, someone should - // fix QHULL. + sprintf (flags, "qhull %s", options.c_str ()); - OCTAVE_LOCAL_BUFFER (char, flags, buf_string.length () + 1); - - strcpy (flags, buf_string.c_str ()); - - if (! qh_new_qhull (dim, n, pt_array, ismalloc, flags, 0, stderr)) + // Replace the 0 pointer with stdout for debugging information + FILE *outfile = 0; + FILE *errfile = stderr; + + int exitcode = qh_new_qhull (dim, n, pt_array, + ismalloc, flags, outfile, errfile); + if (! exitcode) { - // If you want some debugging information replace the NULL - // pointer with stdout - vertexT *vertex, **vertexp; facetT *facet; setT *vertices; - unsigned int nf = qh num_facets; + bool nonsimp_seen = false; + octave_idx_type nf = qh num_facets; - Matrix idx (nf, dim); + Matrix idx (nf, dim + 1); - octave_idx_type j, i = 0; + octave_idx_type i = 0, j; FORALLfacets { j = 0; - if (! facet->simplicial) - // should never happen with QJ - error ("convhulln: non-simplicial facet"); + + if (! nonsimp_seen && ! facet->simplicial) + { + nonsimp_seen = true; + if (options.find ("QJ") != std::string::npos) + { + // should never happen with QJ + error ("convhulln: qhull failed. Option 'QJ' returned non-simplicial facet"); + break; + } + } if (dim == 3) { vertices = qh_facet3vertex (facet); FOREACHvertex_ (vertices) idx(i, j++) = 1 + qh_pointid(vertex->point); + qh_settempfree (&vertices); } else @@ -174,11 +192,15 @@ } } if (j < dim) - // likewise but less fatal warning ("facet %d only has %d vertices", i, j); + i++; } + // Remove extra dimension if all facets were simplicial + if (! nonsimp_seen) + idx.resize (nf, dim, 0.0); + if (nargout == 2) // calculate volume of convex hull // taken from qhull src/geom2.c @@ -213,19 +235,21 @@ retval(1) = octave_value (qh totvol); } - retval(0) = octave_value (idx); + retval(0) = idx; } + else + error ("convhulln: qhull failed"); - // free long memory + // free memory from Qhull qh_freeqhull (! qh_ALL); - // free short memory and memory allocator int curlong, totlong; qh_memfreeshort (&curlong, &totlong); if (curlong || totlong) warning ("convhulln: did not free %d bytes of long memory (%d pieces)", - totlong, curlong); + totlong, curlong); + #else error ("convhulln: not available in this version of Octave"); #endif @@ -236,10 +260,23 @@ /* %!testif HAVE_QHULL %! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; -%! [h, v] = convhulln(cube,'Pp'); +%! [h, v] = convhulln (cube); +%! assert (size (h), [6 4]); +%! h = sortrows (sort (h, 2), [1:4]); +%! assert (h, [1 2 3 4; 1 2 5 6; 1 4 5 8; 2 3 6 7; 3 4 7 8; 5 6 7 8]); +%! assert (v, 1, 10*eps); + +%!testif HAVE_QHULL +%! cube = [0 0 0;1 0 0;1 1 0;0 1 0;0 0 1;1 0 1;1 1 1;0 1 1]; +%! [h, v] = convhulln (cube, "QJ"); +%! assert (size (h), [12 3]); +%! assert (sortrows (sort (h, 2), [1:3]), [1 2 4; 1 2 5; 1 4 5; 2 3 4; 2 3 6; 2 5 6; 3 4 8; 3 6 7; 3 7 8; 4 5 8; 5 6 8; 6 7 8]); %! assert (v, 1.0, 1e6*eps); + %!testif HAVE_QHULL %! tetrahedron = [1 1 1;-1 -1 1;-1 1 -1;1 -1 -1]; -%! [h, v] = convhulln(tetrahedron,'Pp'); -%! assert (v, 8/3, 1e6*eps); +%! [h, v] = convhulln (tetrahedron); +%! h = sortrows (sort (h, 2), [1 2 3]); +%! assert (h, [1 2 3;1 2 4; 1 3 4; 2 3 4]); +%! assert (v, 8/3, 10*eps); */
--- a/src/DLD-FUNCTIONS/dot.cc +++ b/src/DLD-FUNCTIONS/dot.cc @@ -238,6 +238,17 @@ /* +%! assert(dot ([1, 2], [2, 3]), 11); + +%!test +%! x = [2, 1; 2, 1]; +%! y = [-0.5, 2; 0.5, -2]; +%! assert(dot (x, y), [0 0]); + +%!test +%! x = [ 1+i, 3-i; 1-i, 3-i]; +%! assert(dot (x, x), [4, 20]); + */ DEFUN_DLD (blkmm, args, , @@ -344,3 +355,14 @@ return retval; } + +/* + +%!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); + +*/
--- a/src/DLD-FUNCTIONS/eigs.cc +++ b/src/DLD-FUNCTIONS/eigs.cc @@ -323,6 +323,7 @@ bool a_is_complex = false; bool b_is_complex = false; bool symmetric = false; + bool sym_tested = false; bool cholB = false; bool a_is_sparse = false; ColumnVector permB; @@ -334,7 +335,6 @@ ColumnVector resid; ComplexColumnVector cresid; octave_idx_type info = 1; - char bmat = 'I'; warned_imaginary = false; @@ -399,7 +399,8 @@ else acm = (args(0).complex_matrix_value()); a_is_complex = true; - symmetric = false; // ARAPACK doesn't special case complex symmetric + symmetric = false; // ARPACK doesn't special case complex symmetric + sym_tested = true; } else { @@ -407,19 +408,17 @@ { asmm = (args(0).sparse_matrix_value()); a_is_sparse = true; - symmetric = asmm.is_symmetric(); } else { amm = (args(0).matrix_value()); - symmetric = amm.is_symmetric(); } } } // Note hold off reading B till later to avoid issues of double - // copies of the matrix if B is full/real while A is complex.. + // copies of the matrix if B is full/real while A is complex. if (!error_state && nargin > 1 + arg_offset && !(args(1 + arg_offset).is_real_scalar ())) { @@ -427,7 +426,6 @@ { b_arg = 1+arg_offset; have_b = true; - bmat = 'G'; b_is_complex = true; arg_offset++; } @@ -435,7 +433,6 @@ { b_arg = 1+arg_offset; have_b = true; - bmat = 'G'; arg_offset++; } } @@ -481,10 +478,13 @@ { octave_value tmp; - // issym is ignored if A is not a function + // issym is ignored for complex matrix inputs tmp = map.getfield ("issym"); - if (tmp.is_defined () && have_a_fun) - symmetric = tmp.double_value () != 0.; + if (tmp.is_defined () && !sym_tested) + { + symmetric = tmp.double_value () != 0.; + sym_tested = true; + } // isreal is ignored if A is not a function tmp = map.getfield ("isreal"); @@ -543,6 +543,15 @@ return retval; } + // Test undeclared (no issym) matrix inputs for symmetry + if (!sym_tested && !have_a_fun) + { + if (a_is_sparse) + symmetric = asmm.is_symmetric(); + else + symmetric = amm.is_symmetric(); + } + if (have_b) { if (a_is_complex || b_is_complex)
--- a/src/DLD-FUNCTIONS/filter.cc +++ b/src/DLD-FUNCTIONS/filter.cc @@ -104,16 +104,17 @@ return y; } - octave_idx_type si_dim = 0; - for (octave_idx_type i = 0; i < x_dims.length (); i++) + for (octave_idx_type i = 1; i < dim; i++) { - if (i == dim) - continue; - - if (x_dims(i) == 1) - continue; - - if (si_dims(++si_dim) != x_dims(i)) + if (si_dims(i) != x_dims(i-1)) + { + error ("filter: dimensionality of SI and X must agree"); + return y; + } + } + for (octave_idx_type i = dim+1; i < x_dims.length (); i++) + { + if (si_dims(i) != x_dims(i)) { error ("filter: dimensionality of SI and X must agree"); return y; @@ -456,19 +457,10 @@ } else { - dim_vector si_dims = args (3).dims (); - bool si_is_vector = true; - for (int i = 0; i < si_dims.length (); i++) - if (si_dims(i) != 1 && si_dims(i) < si_dims.numel ()) - { - si_is_vector = false; - break; - } - si = args(3).float_complex_array_value (); - if (si_is_vector) - si = si.reshape (dim_vector (1, si.numel ())); + if (si.is_vector () && x.is_vector ()) + si = si.reshape (dim_vector (si.numel (), 1)); } if (! error_state) @@ -513,19 +505,10 @@ } else { - dim_vector si_dims = args (3).dims (); - bool si_is_vector = true; - for (int i = 0; i < si_dims.length (); i++) - if (si_dims(i) != 1 && si_dims(i) < si_dims.numel ()) - { - si_is_vector = false; - break; - } - si = args(3).complex_array_value (); - if (si_is_vector) - si = si.reshape (dim_vector (1, si.numel ())); + if (si.is_vector () && x.is_vector ()) + si = si.reshape (dim_vector (si.numel (), 1)); } if (! error_state) @@ -573,19 +556,10 @@ } else { - dim_vector si_dims = args (3).dims (); - bool si_is_vector = true; - for (int i = 0; i < si_dims.length (); i++) - if (si_dims(i) != 1 && si_dims(i) < si_dims.numel ()) - { - si_is_vector = false; - break; - } - si = args(3).float_array_value (); - if (si_is_vector) - si = si.reshape (dim_vector (1, si.numel ())); + if (si.is_vector () && x.is_vector ()) + si = si.reshape (dim_vector (si.numel (), 1)); } if (! error_state) @@ -630,19 +604,10 @@ } else { - dim_vector si_dims = args (3).dims (); - bool si_is_vector = true; - for (int i = 0; i < si_dims.length (); i++) - if (si_dims(i) != 1 && si_dims(i) < si_dims.numel ()) - { - si_is_vector = false; - break; - } - si = args(3).array_value (); - if (si_is_vector) - si = si.reshape (dim_vector (1, si.numel ())); + if (si.is_vector () && x.is_vector ()) + si = si.reshape (dim_vector (si.numel (), 1)); } if (! error_state) @@ -749,8 +714,20 @@ %! %!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]); -%!assert(filter (1, ones(10,1)/10, single (1:5)), repmat (single (10), 1, 5)); -%% Should put some tests of the "DIM" parameter in here. +%!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); +%! assert (y, y0); */
--- a/src/DLD-FUNCTIONS/find.cc +++ b/src/DLD-FUNCTIONS/find.cc @@ -232,26 +232,23 @@ octave_value_list retval ((nargout == 0 ? 1 : nargout), Matrix ()); octave_idx_type nc = v.cols(); - octave_idx_type start_nc, end_nc, count; + octave_idx_type start_nc, count; // Determine the range to search. if (n_to_find < 0 || n_to_find >= nc) { start_nc = 0; - end_nc = nc; n_to_find = nc; count = nc; } else if (direction > 0) { start_nc = 0; - end_nc = n_to_find; count = n_to_find; } else { start_nc = nc - n_to_find; - end_nc = nc; count = n_to_find; }
--- a/src/DLD-FUNCTIONS/givens.cc +++ b/src/DLD-FUNCTIONS/givens.cc @@ -203,3 +203,13 @@ return retval; } + +/* + +%!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() + +*/
--- a/src/DLD-FUNCTIONS/hex2num.cc +++ b/src/DLD-FUNCTIONS/hex2num.cc @@ -76,6 +76,8 @@ double dval; } num; + num.ival = 0; + for (octave_idx_type j = 0; j < nc; j++) { unsigned char ch = cmat.elem (i, j);
--- a/src/DLD-FUNCTIONS/kron.cc +++ b/src/DLD-FUNCTIONS/kron.cc @@ -172,12 +172,77 @@ return octave_value (kron (am, bm)); } -#define ALL_TYPES(AMT, BMT) \ - } while (0) \ +octave_value +dispatch_kron (const octave_value& a, const octave_value& b) +{ + octave_value retval; + if (a.is_perm_matrix () && b.is_perm_matrix ()) + retval = do_kron<PermMatrix, PermMatrix> (a, b); + else if (a.is_diag_matrix ()) + { + 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 (); + } + else if (a.is_single_type () || b.is_single_type ()) + { + if (a.is_complex_type ()) + retval = do_kron<FloatComplexDiagMatrix, FloatComplexMatrix> (a, b); + else if (b.is_complex_type ()) + retval = do_kron<FloatDiagMatrix, FloatComplexMatrix> (a, b); + else + retval = do_kron<FloatDiagMatrix, FloatMatrix> (a, b); + } + else + { + if (a.is_complex_type ()) + retval = do_kron<ComplexDiagMatrix, ComplexMatrix> (a, b); + else if (b.is_complex_type ()) + retval = do_kron<DiagMatrix, ComplexMatrix> (a, b); + else + retval = do_kron<DiagMatrix, Matrix> (a, b); + } + } + else if (a.is_sparse_type () || b.is_sparse_type ()) + { + if (a.is_complex_type () || b.is_complex_type ()) + retval = do_kron<SparseComplexMatrix, SparseComplexMatrix> (a, b); + else + retval = do_kron<SparseMatrix, SparseMatrix> (a, b); + } + else if (a.is_single_type () || b.is_single_type ()) + { + if (a.is_complex_type ()) + retval = do_kron<FloatComplexMatrix, FloatComplexMatrix> (a, b); + else if (b.is_complex_type ()) + retval = do_kron<FloatMatrix, FloatComplexMatrix> (a, b); + else + retval = do_kron<FloatMatrix, FloatMatrix> (a, b); + } + else + { + if (a.is_complex_type ()) + retval = do_kron<ComplexMatrix, ComplexMatrix> (a, b); + else if (b.is_complex_type ()) + retval = do_kron<Matrix, ComplexMatrix> (a, b); + else + retval = do_kron<Matrix, Matrix> (a, b); + } + return retval; +} + DEFUN_DLD (kron, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} kron (@var{A}, @var{B})\n\ -Form the Kronecker product of two matrices, defined block by block as\n\ +@deftypefnx {Loadable Function} {} kron (@var{A1}, @var{A2}, @dots{})\n\ +Form the Kronecker product of two or more matrices, defined block by \n\ +block as\n\ \n\ @example\n\ x = [a(i, j) b]\n\ @@ -193,74 +258,48 @@ 1 2 3 4\n\ @end group\n\ @end example\n\ +\n\ +If there are more than two input arguments @var{A1}, @var{A2}, @dots{}, \n\ +@var{An} the Kronecker product is computed as\n\ +\n\ +@example\n\ +kron (kron (@var{A1}, @var{A2}), @dots{}, @var{An})\n\ +@end example\n\ +\n\ +@noindent\n\ +Since the Kronecker product is associative, this is well-defined.\n\ @end deftypefn") { octave_value retval; int nargin = args.length (); - if (nargin == 2) + if (nargin >= 2) { octave_value a = args(0), b = args(1); - if (a.is_perm_matrix () && b.is_perm_matrix ()) - retval = do_kron<PermMatrix, PermMatrix> (a, b); - else if (a.is_diag_matrix ()) - { - 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 = Fkron (tmp, 1); - if (tmp.length () == 1) - retval = tmp(0).diag (); - } - else if (a.is_single_type () || b.is_single_type ()) - { - if (a.is_complex_type ()) - return do_kron<FloatComplexDiagMatrix, FloatComplexMatrix> (a, b); - else if (b.is_complex_type ()) - return do_kron<FloatDiagMatrix, FloatComplexMatrix> (a, b); - else - return do_kron<FloatDiagMatrix, FloatMatrix> (a, b); - } - else - { - if (a.is_complex_type ()) - return do_kron<ComplexDiagMatrix, ComplexMatrix> (a, b); - else if (b.is_complex_type ()) - return do_kron<DiagMatrix, ComplexMatrix> (a, b); - else - return do_kron<DiagMatrix, Matrix> (a, b); - } - } - else if (a.is_sparse_type () || b.is_sparse_type ()) - { - if (args(0).is_complex_type () || args(1).is_complex_type ()) - return do_kron<SparseComplexMatrix, SparseComplexMatrix> (a, b); - else - return do_kron<SparseMatrix, SparseMatrix> (a, b); - } - else if (a.is_single_type () || b.is_single_type ()) - { - if (a.is_complex_type ()) - return do_kron<FloatComplexMatrix, FloatComplexMatrix> (a, b); - else if (b.is_complex_type ()) - return do_kron<FloatMatrix, FloatComplexMatrix> (a, b); - else - return do_kron<FloatMatrix, FloatMatrix> (a, b); - } - else - { - if (a.is_complex_type ()) - return do_kron<ComplexMatrix, ComplexMatrix> (a, b); - else if (b.is_complex_type ()) - return do_kron<Matrix, ComplexMatrix> (a, b); - else - return do_kron<Matrix, Matrix> (a, b); - } + retval = dispatch_kron (a, b); + for (octave_idx_type i = 2; i < nargin; i++) + retval = dispatch_kron (retval, args(i)); } + else + print_usage (); return retval; } + + +/* + +%!test +%! x = ones(2); +%! assert( kron (x, x), ones (4)); + +%!shared x, y, z +%! x = [1, 2]; +%! y = [-1, -2]; +%! z = [1, 2, 3, 4; 1, 2, 3, 4; 1, 2, 3, 4]; +%!assert (kron (1:4, ones (3, 1)), z) +%!assert (kron (x, y, z), kron (kron (x, y), z)) +%!assert (kron (x, y, z), kron (x, kron (y, z))) + +*/
--- a/src/DLD-FUNCTIONS/lu.cc +++ b/src/DLD-FUNCTIONS/lu.cc @@ -616,7 +616,7 @@ @end example\n\ \n\ @noindent\n\ -then a factorization of @code{@var{A}+@var{x}*@var{y}.'} can be obtained\n\ +then a factorization of @xcode{@var{A}+@var{x}*@var{y}.'} can be obtained\n\ either as\n\ \n\ @example\n\
--- a/src/DLD-FUNCTIONS/luinc.cc +++ b/src/DLD-FUNCTIONS/luinc.cc @@ -110,7 +110,7 @@ bool udiag = false; Matrix thresh; double droptol = -1.; - bool vecout; + bool vecout = false; if (args(1).is_string ()) { @@ -236,7 +236,7 @@ if (vecout) retval(2) = fact.Pr_vec (); else - retval(2) = fact.Pr (); + retval(2) = fact.Pr_mat (); retval(1) = octave_value (fact.U (), MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), @@ -260,8 +260,8 @@ } else { - retval(3) = fact.Pc (); - retval(2) = fact.Pr (); + retval(3) = fact.Pc_mat (); + retval(2) = fact.Pr_mat (); } retval(1) = octave_value (fact.U (), MatrixType (MatrixType::Upper)); @@ -319,7 +319,7 @@ if (vecout) retval(2) = fact.Pr_vec (); else - retval(2) = fact.Pr (); + retval(2) = fact.Pr_mat (); retval(1) = octave_value (fact.U (), MatrixType (MatrixType::Upper)); retval(0) = octave_value (fact.L (), @@ -343,8 +343,8 @@ } else { - retval(3) = fact.Pc (); - retval(2) = fact.Pr (); + retval(3) = fact.Pc_mat (); + retval(2) = fact.Pr_mat (); } retval(1) = octave_value (fact.U (), MatrixType (MatrixType::Upper));
--- a/src/DLD-FUNCTIONS/max.cc +++ b/src/DLD-FUNCTIONS/max.cc @@ -309,11 +309,13 @@ "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} min (@var{x})\n\ @deftypefnx {Loadable Function} {} min (@var{x}, @var{y})\n\ +@deftypefnx {Loadable Function} {} min (@var{x}, [], @var{dim})\n\ @deftypefnx {Loadable Function} {} min (@var{x}, @var{y}, @var{dim})\n\ @deftypefnx {Loadable Function} {[@var{w}, @var{iw}] =} min (@var{x})\n\ For a vector argument, return the minimum value. For a matrix\n\ argument, return the minimum value from each column, as a row\n\ -vector, or over the dimension @var{dim} if defined. For two matrices\n\ +vector, or over the dimension @var{dim} if defined, in which case @var{y} \n\ +should be set to the empty matrix (it's ignored otherwise). For two matrices\n\ (or a matrix and scalar), return the pair-wise minimum.\n\ Thus,\n\ \n\ @@ -386,11 +388,13 @@ "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} max (@var{x})\n\ @deftypefnx {Loadable Function} {} max (@var{x}, @var{y})\n\ +@deftypefnx {Loadable Function} {} max (@var{x}, [], @var{dim})\n\ @deftypefnx {Loadable Function} {} max (@var{x}, @var{y}, @var{dim})\n\ @deftypefnx {Loadable Function} {[@var{w}, @var{iw}] =} max (@var{x})\n\ For a vector argument, return the maximum value. For a matrix\n\ argument, return the maximum value from each column, as a row\n\ -vector, or over the dimension @var{dim} if defined. For two matrices\n\ +vector, or over the dimension @var{dim} if defined, in which case @var{y} \n\ +should be set to the empty matrix (it's ignored otherwise). For two matrices\n\ (or a matrix and scalar), return the pair-wise maximum.\n\ Thus,\n\ \n\
--- a/src/DLD-FUNCTIONS/mgorth.cc +++ b/src/DLD-FUNCTIONS/mgorth.cc @@ -31,8 +31,8 @@ #include "gripes.h" template <class ColumnVector, class Matrix, class RowVector> -static void -do_mgorth (ColumnVector& x, const Matrix& V, RowVector& h) +static void +do_mgorth (ColumnVector& x, const Matrix& V, RowVector& h) { octave_idx_type Vc = V.columns (); h = RowVector (Vc + 1); @@ -71,7 +71,7 @@ if (nargin != 2 || nargout > 2) { - print_usage (); + print_usage (); return retval; } @@ -90,7 +90,7 @@ { error ("mgorth: X and V must be numeric"); } - + bool iscomplex = (arg_x.is_complex_type () || arg_v.is_complex_type ()); if (arg_x.is_single_type () || arg_v.is_single_type ()) { @@ -139,7 +139,7 @@ } /* - + %!test %! for ii=1:100; assert (abs (mgorth (randn (5, 1), eye (5, 4))), [0 0 0 0 1]', eps); endfor
--- a/src/DLD-FUNCTIONS/module-files +++ b/src/DLD-FUNCTIONS/module-files @@ -1,40 +1,41 @@ +# FILE|CPPFLAGS|LDFLAGS|LIBRARIES __contourc__.cc -__delaunayn__.cc +__delaunayn__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) __dispatch__.cc __dsearchn__.cc -__fltk_uigetfile__.cc -__glpk__.cc -__init_fltk__.cc +__fltk_uigetfile__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) +__glpk__.cc|$(GLPK_CPPFLAGS)|$(GLPK_LDFLAGS)|$(GLPK_LIBS) +__init_fltk__.cc|$(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS)|$(GRAPHICS_LDFLAGS) $(FT2_LDFLAGS)|$(GRAPHICS_LIBS) $(FT2_LIBS) __lin_interpn__.cc -__magick_read__.cc +__magick_read__.cc|$(MAGICK_CPPFLAGS)|$(MAGICK_LDFLAGS)|$(MAGICK_LIBS) __pchip_deriv__.cc __qp__.cc -__voronoi__.cc -amd.cc +__voronoi__.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) +amd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) balance.cc besselj.cc betainc.cc bsxfun.cc -ccolamd.cc +ccolamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) cellfun.cc -chol.cc -colamd.cc +chol.cc|$(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(QRUPDATE_LDFLAGS) $(SPARSE_XLDFLAGS)|$(QRUPDATE_LIBS) $(SPARSE_XLIBS) +colamd.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) colloc.cc conv2.cc -convhulln.cc +convhulln.cc|$(QHULL_CPPFLAGS)|$(QHULL_LDFLAGS)|$(QHULL_LIBS) daspk.cc dasrt.cc dassl.cc det.cc dlmread.cc -dmperm.cc +dmperm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) dot.cc eig.cc -eigs.cc -fft.cc -fft2.cc -fftn.cc -fftw.cc +eigs.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) +fft.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) +fft2.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) +fftn.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) +fftw.cc|$(FFTW_XCPPFLAGS)|$(FFTW_XLDFLAGS)|$(FFTW_XLIBS) filter.cc find.cc gammainc.cc @@ -58,13 +59,13 @@ nproc.cc onCleanup.cc pinv.cc -qr.cc +qr.cc|$(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS)|$(QRUPDATE_LDFLAGS) $(SPARSE_XLDFLAGS)|$(QRUPDATE_LIBS) $(SPARSE_XLIBS) quad.cc quadcc.cc -qz.cc +qz.cc|||$(LAPACK_LIBS) $(BLAS_LIBS) rand.cc rcond.cc -regexp.cc +regexp.cc|$(REGEX_CPPFLAGS)|$(REGEX_LDFLAGS)|$(REGEX_LIBS) schur.cc spparms.cc sqrtm.cc @@ -73,10 +74,10 @@ sub2ind.cc svd.cc syl.cc -symbfact.cc -symrcm.cc +symbfact.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) +symrcm.cc|$(SPARSE_XCPPFLAGS)|$(SPARSE_XLDFLAGS)|$(SPARSE_XLIBS) time.cc tril.cc tsearch.cc typecast.cc -urlwrite.cc +urlwrite.cc|$(CURL_CPPFLAGS)|$(CURL_LDFLAGS)|$(CURL_LIBS)
--- a/src/DLD-FUNCTIONS/onCleanup.cc +++ b/src/DLD-FUNCTIONS/onCleanup.cc @@ -274,3 +274,19 @@ return retval; } + +/* + +%!test +%! old_wstate = warning ("query"); +%! unwind_protect +%! trigger = onCleanup (@() warning ("on", "__MY_WARNING__")); +%! warning ("off", "__MY_WARNING__"); +%! assert ((warning ("query", "__MY_WARNING__")).state, "off"); +%! clear trigger +%! assert ((warning ("query", "__MY_WARNING__")).state, "on"); +%! unwind_protect_cleanup +%! warning (old_wstate); +%! end_unwind_protect + +*/
--- a/src/DLD-FUNCTIONS/pinv.cc +++ b/src/DLD-FUNCTIONS/pinv.cc @@ -169,3 +169,23 @@ return retval; } + +/* +%!shared a, b, tol, hitol, d, u, x, y +%! a = reshape (rand*[1:16], 4, 4); ## Rank 2 matrix +%! b = pinv (a); +%! tol = 1e-14; +%! hitol = 15*sqrt(eps); +%! d = diag ([rand, rand, hitol, hitol]); +%! u = rand (4); ## Could be singular by freak accident +%! x = inv (u)*d*u; +%! y = pinv (x, sqrt(eps)); +%!assert(a*b*a, a, tol); +%!assert(b*a*b, b, tol); +%!assert((b*a)', b*a, tol); +%!assert((a*b)', a*b, tol); +%!assert(x*y*x, x, -hitol); +%!assert(y*x*y, y, -hitol); +%!assert((x*y)', x*y, hitol); +%!assert((y*x)', y*x, hitol); +*/
--- a/src/DLD-FUNCTIONS/qr.cc +++ b/src/DLD-FUNCTIONS/qr.cc @@ -76,6 +76,8 @@ "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A})\n\ @deftypefnx {Loadable Function} {[@var{Q}, @var{R}, @var{P}] =} qr (@var{A}, '0')\n\ +@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B})\n\ +@deftypefnx {Loadable Function} {[@var{C}, @var{R}] =} qr (@var{A}, @var{B}, '0')\n\ @cindex QR factorization\n\ Compute the QR@tie{}factorization of @var{A}, using standard @sc{lapack}\n\ subroutines. For example, given the matrix @code{@var{A} = [1, 2; 3, 4]},\n\ @@ -188,7 +190,7 @@ \n\ @example\n\ @group\n\ -[@var{C},@var{R}] = spqr (@var{A},@var{B})\n\ +[@var{C}, @var{R}] = qr (@var{A}, @var{B})\n\ x = @var{R} \\ @var{C}\n\ @end group\n\ @end example\n\
--- a/src/DLD-FUNCTIONS/quadcc.cc +++ b/src/DLD-FUNCTIONS/quadcc.cc @@ -50,8 +50,7 @@ int depth, rdepth, ndiv; } cquad_ival; -/* Some constants and matrices that we'll need. - */ +/* Some constants and matrices that we'll need. */ static const double xi[33] = { -1., -0.99518472667219688624, -0.98078528040323044912, @@ -1473,9 +1472,7 @@ } - -/* The actual integration routine. - */ +/* The actual integration routine. */ DEFUN_DLD (quadcc, args, nargout, "-*- texinfo -*-\n\ @@ -1545,6 +1542,7 @@ @seealso{quad, quadv, quadl, quadgk, trapz, dblquad, triplequad}\n\ @end deftypefn") { + octave_value_list retval; /* Some constants that we will need. */ static const int n[4] = { 4, 8, 16, 32 }; @@ -1563,15 +1561,15 @@ double a, b, tol, iivals[cquad_heapsize], *sing; /* Variables needed for transforming the integrand. */ - int wrap = 0; + bool wrap = false; double xw; /* Stuff we will need to call the integrand. */ - octave_value_list fargs, retval; + octave_value_list fargs, fvals; /* Actual variables (as opposed to constants above). */ double m, h, ml, hl, mr, hr, temp; - double igral, err, igral_final, err_final, err_excess; + double igral, err, igral_final, err_final; int nivals, neval = 0; int i, j, d, split, t; int nnans, nans[33]; @@ -1580,48 +1578,49 @@ /* Parse the input arguments. */ - if (nargin < 1) + if (nargin < 3) { - error - ("quadcc: first argument (integrand) of type function handle required"); - return octave_value_list (); + print_usage (); + return retval; } + + if (args(0).is_function_handle () || args(0).is_inline_function ()) + fcn = args(0).function_value (); else { - if (args (0).is_function_handle () || args (0).is_inline_function ()) - fcn = args (0).function_value (); - else - { - error ("quadcc: first argument (integrand) must be a function handle or an inline function"); - return octave_value_list(); - } + std::string fcn_name = unique_symbol_name ("__quadcc_fcn_"); + std::string fname = "function y = "; + fname.append (fcn_name); + fname.append ("(x) y = "); + fcn = extract_function (args(0), "quadcc", fcn_name, fname, + "; endfunction"); } - if (nargin < 2 || !args (1).is_real_scalar ()) + if (!args(1).is_real_scalar ()) { - error ("quadcc: second argument (left interval edge) must be a single real scalar"); - return octave_value_list (); + error ("quadcc: lower limit of integration (A) must be a single real scalar"); + return retval; } else - a = args (1).double_value (); + a = args(1).double_value (); - if (nargin < 3 || !args (2).is_real_scalar ()) + if (!args(2).is_real_scalar ()) { - error ("quadcc: third argument (right interval edge) must be a single real scalar"); - return octave_value_list (); + error ("quadcc: upper limit of integration (B) must be a single real scalar"); + return retval; } else - b = args (2).double_value (); + b = args(2).double_value (); - if (nargin < 4) + if (nargin < 4 || args(3).is_empty ()) tol = 1.0e-6; - else if (!args (3).is_real_scalar ()) + else if (!args(3).is_real_scalar () || args(3).double_value () <= 0) { - error ("quadcc: fourth argument (tolerance) must be a single real scalar"); - return octave_value_list (); + error ("quadcc: tolerance (TOL) must be a single real scalar > 0"); + return retval; } else - tol = args (3).double_value (); + tol = args(3).double_value (); if (nargin < 5) { @@ -1629,20 +1628,21 @@ iivals[0] = a; iivals[1] = b; } - else if (!(args (4).is_real_scalar () || args (4).is_real_matrix ())) + else if (!(args(4).is_real_scalar () || args(4).is_real_matrix ())) { - error ("quadcc: fifth argument (singularities) must be a vector of real values"); - return octave_value_list (); + error ("quadcc: list of singularities (SING) must be a vector of real values"); + return retval; } else { - nivals = 1 + args (4).length (); - if ( nivals > cquad_heapsize ) { - error ("quadcc: maximum number of singular points is limited to %i", - cquad_heapsize-1); - return octave_value_list(); + nivals = 1 + args(4).length (); + if (nivals > cquad_heapsize) + { + error ("quadcc: maximum number of singular points is limited to %i", + cquad_heapsize-1); + return retval; } - sing = args (4).array_value ().fortran_vec (); + sing = args(4).array_value ().fortran_vec (); iivals[0] = a; for (i = 0; i < nivals - 2; i++) iivals[i + 1] = sing[i]; @@ -1652,7 +1652,7 @@ /* If a or b are +/-Inf, transform the integral. */ if (xisinf (a) || xisinf (b)) { - wrap = 1; + wrap = true; for (i = 0; i <= nivals; i++) if (xisinf (iivals[i])) iivals[i] = copysign (1.0, iivals[i]); @@ -1688,19 +1688,18 @@ for (i = 0; i <= n[3]; i++) ex (i) = m + xi[i] * h; } - fargs (0) = ex; - retval = feval (fcn, fargs, 1); - if (retval.length () != 1 || !retval (0).is_real_matrix ()) + fargs(0) = ex; + fvals = feval (fcn, fargs, 1); + if (fvals.length () != 1 || !fvals(0).is_real_matrix ()) { - error - ("quadcc: integrand must return a single, real-valued vector"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector"); + return retval; } - Matrix effex = retval (0).matrix_value (); + Matrix effex = fvals(0).matrix_value (); if (effex.length () != ex.length ()) { - error ("quadcc: integrand must return a single, real-valued vector of the same size as the input"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector of the same size as the input"); + return retval; } for (i = 0; i <= n[3]; i++) { @@ -1767,7 +1766,6 @@ /* Initialize some global values. */ igral_final = 0.0; err_final = 0.0; - err_excess = 0.0; /* Main loop. */ @@ -1809,18 +1807,18 @@ for (i = 0; i < n[d] / 2; i++) ex (i) = m + xi[(2 * i + 1) * skip[d]] * h; } - fargs (0) = ex; - retval = feval (fcn, fargs, 1); - if (retval.length () != 1 || !retval (0).is_real_matrix ()) + fargs(0) = ex; + fvals = feval (fcn, fargs, 1); + if (fvals.length () != 1 || !fvals(0).is_real_matrix ()) { - error ("quadcc: integrand must return a single, real-valued vector"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector"); + return retval; } - Matrix effex = retval (0).matrix_value (); + Matrix effex = fvals(0).matrix_value (); if (effex.length () != ex.length ()) { - error ("quadcc: integrand must return a single, real-valued vector of the same size as the input"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector of the same size as the input"); + return retval; } neval += effex.length (); for (i = 0; i < n[d] / 2; i++) @@ -1957,18 +1955,18 @@ for (i = 0; i < n[0] - 1; i++) ex (i) = ml + xi[(i + 1) * skip[0]] * hl; } - fargs (0) = ex; - retval = feval (fcn, fargs, 1); - if (retval.length () != 1 || !retval (0).is_real_matrix ()) + fargs(0) = ex; + fvals = feval (fcn, fargs, 1); + if (fvals.length () != 1 || !fvals(0).is_real_matrix ()) { - error ("quadcc: integrand must return a single, real-valued vector"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector"); + return retval; } - Matrix effex = retval (0).matrix_value (); + Matrix effex = fvals(0).matrix_value (); if (effex.length () != ex.length ()) { - error ("quadcc: integrand must return a single, real-valued vector of the same size as the input"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector of the same size as the input"); + return retval; } neval += effex.length (); for (i = 0; i < n[0] - 1; i++) @@ -2053,18 +2051,18 @@ for (i = 0; i < n[0] - 1; i++) ex (i) = mr + xi[(i + 1) * skip[0]] * hr; } - fargs (0) = ex; - retval = feval (fcn, fargs, 1); - if (retval.length () != 1 || !retval (0).is_real_matrix ()) + fargs(0) = ex; + fvals = feval (fcn, fargs, 1); + if (fvals.length () != 1 || !fvals(0).is_real_matrix ()) { - error ("quadcc: integrand must return a single, real-valued vector"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector"); + return retval; } - Matrix effex = retval (0).matrix_value (); + Matrix effex = fvals(0).matrix_value (); if (effex.length () != ex.length ()) { - error ("quadcc: integrand must return a single, real-valued vector of the same size as the input"); - return octave_value_list (); + error ("quadcc: integrand F must return a single, real-valued vector of the same size as the input"); + return retval; } neval += effex.length (); for (i = 0; i < n[0] - 1; i++) @@ -2234,11 +2232,39 @@ } */ /* Clean up and present the results. */ - retval (0) = igral; + if (nargout > 2) + retval(2) = neval; if (nargout > 1) - retval (1) = err; - if (nargout > 2) - retval (2) = neval; + retval(1) = err; + retval(0) = igral; /* All is well that ends well. */ return retval; } + + +/* + +%!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 (@(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, -i, pi)) +%!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 ])) + +*/
--- a/src/DLD-FUNCTIONS/qz.cc +++ b/src/DLD-FUNCTIONS/qz.cc @@ -287,6 +287,9 @@ return (fabs (p) >= 1 ? 1 : -1); } + +//FIXME: Matlab does not produce lambda as the first output argument. +// Compatibility problem? DEFUN_DLD (qz, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {@var{lambda} =} qz (@var{A}, @var{B})\n\ @@ -1236,3 +1239,30 @@ return retval; } + +/* +%!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))); + +%% 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); +%! [aa, bb, q, z, v, w, lambda] = qz (a, b); +%! 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 + +*/
--- a/src/DLD-FUNCTIONS/rand.cc +++ b/src/DLD-FUNCTIONS/rand.cc @@ -26,7 +26,11 @@ #endif #include <ctime> - +#if defined (HAVE_UNORDERED_MAP) +#include <unordered_map> +#elif defined (HAVE_TR1_UNORDERED_MAP) +#include <tr1/unordered_map> +#endif #include <string> #include "f77-fcn.h" @@ -177,20 +181,17 @@ octave_idx_type base = NINTbig (r.base ()); octave_idx_type incr = NINTbig (r.inc ()); - octave_idx_type lim = NINTbig (r.limit ()); - if (base < 0 || lim < 0) - error ("%s: all dimensions must be positive", fcn); - else + for (octave_idx_type i = 0; i < n; i++) { - for (octave_idx_type i = 0; i < n; i++) - { - dims(i) = base; - base += incr; - } + //Negative dimensions are treated as zero for Matlab + //compatibility + dims(i) = base >= 0 ? base : 0; + base += incr; + } - goto gen_matrix; - } + goto gen_matrix; + } else error ("%s: all elements of range must be integers", @@ -208,15 +209,10 @@ for (octave_idx_type i = 0; i < len; i++) { + //Negative dimensions are treated as zero for Matlab + //compatibility octave_idx_type elt = iv(i); - - if (elt < 0) - { - error ("%s: all dimensions must be positive", fcn); - goto done; - } - - dims(i) = iv(i); + dims(i) = elt >=0 ? elt : 0; } goto gen_matrix; @@ -278,13 +274,14 @@ for (int i = 0; i < nargin; i++) { - dims(i) = args(idx+i).int_value (); - + octave_idx_type elt = args(idx+i).int_value (); if (error_state) { error ("%s: expecting integer arguments", fcn); goto done; } + //Negative is zero for Matlab compatibility + dims(i) = elt >= 0 ? elt : 0; } goto gen_matrix; @@ -1026,13 +1023,21 @@ @deftypefn {Loadable Function} {} randperm (@var{n})\n\ @deftypefnx {Loadable Function} {} randperm (@var{n}, @var{m})\n\ Return a row vector containing a random permutation of @code{1:@var{n}}.\n\ -If @var{m} is supplied, return @var{m} permutations,\n\ -one in each row of an @nospell{MxN} matrix. The complexity is O(M*N) in both\n\ -time and memory. The randomization is performed using rand().\n\ -All permutations are equally likely.\n\ +If @var{m} is supplied, return @var{m} unique entries, sampled without\n\ +replacement from @code{1:@var{n}}. The complexity is O(@var{n}) in\n\ +memory and O(@var{m}) in time, unless @var{m} < @var{n}/5, in which case\n\ +O(@var{m}) memory is used as well. The randomization is performed using\n\ +rand(). All permutations are equally likely.\n\ @seealso{perms}\n\ @end deftypefn") { + +#ifdef USE_UNORDERED_MAP_WITH_TR1 +using std::tr1::unordered_map; +#else +using std::unordered_map; +#endif + int nargin = args.length (); octave_value retval; @@ -1040,54 +1045,75 @@ { octave_idx_type n, m; + n = args(0).idx_type_value (true); + if (nargin == 2) m = args(1).idx_type_value (true); else - m = 1; - - n = args(0).idx_type_value (true); + m = n; if (m < 0 || n < 0) error ("randperm: M and N must be non-negative"); + if (m > n) + error ("randperm: M must be less than or equal to N"); + + // Quick and dirty heuristic to decide if we allocate or not the + // whole vector for tracking the truncated shuffle. + bool short_shuffle = m < n/5 && m < 1e5; + if (! error_state) { // Generate random numbers. - NDArray r = octave_rand::nd_array (dim_vector (m, n)); - - // Create transposed to allow faster access. - Array<octave_idx_type> idx (dim_vector (n, m)); - + NDArray r = octave_rand::nd_array (dim_vector (1, m)); double *rvec = r.fortran_vec (); + octave_idx_type idx_len = short_shuffle ? m : n; + Array<octave_idx_type> idx (dim_vector (1, idx_len)); octave_idx_type *ivec = idx.fortran_vec (); - // Perform the Knuth shuffle. - for (octave_idx_type j = 0; j < m; j++) + for (octave_idx_type i = 0; i < idx_len; i++) + ivec[i] = i; + + if (short_shuffle) { - for (octave_idx_type i = 0; i < n; i++) - ivec[i] = i; + unordered_map<octave_idx_type, octave_idx_type> map (m); + + // Perform the Knuth shuffle only keeping track of moved + // entries in the map + for (octave_idx_type i = 0; i < m; i++) + { + octave_idx_type k = i + + gnulib::floor (rvec[i] * (n - i)); - for (octave_idx_type i = 0; i < n; i++) + if (map.find(k) == map.end()) + { + map[k] = ivec[i]; + ivec[i] = k; + } + else + std::swap (ivec[i], map[k]); + + } + } + else + { + + // Perform the Knuth shuffle of the first m entries + for (octave_idx_type i = 0; i < m; i++) { - octave_idx_type k = i + gnulib::floor (rvec[i] * (n - i)); + octave_idx_type k = i + + gnulib::floor (rvec[i] * (n - i)); std::swap (ivec[i], ivec[k]); } - - ivec += n; - rvec += n; } - // Transpose. - idx = idx.transpose (); + // Convert to doubles, reusing r. + for (octave_idx_type i = 0; i < m; i++) + rvec[i] = ivec[i] + 1; - // Re-fetch the pointers. - ivec = idx.fortran_vec (); - rvec = r.fortran_vec (); - - // Convert to doubles, reusing r. - for (octave_idx_type i = 0, l = m*n; i < l; i++) - rvec[i] = ivec[i] + 1; + if (m < n) + idx.resize (dim_vector (1, m)); // Now create an array object with a cached idx_vector. retval = new octave_matrix (r, idx_vector (idx)); @@ -1100,6 +1126,6 @@ } /* -%!assert(sort(randperm(20)),1:20) -%!assert(sort(randperm(20,50),2),repmat(1:20,50,1)) +%!assert(sort (randperm (20)),1:20) +%!assert(length (randperm (20,10)), 10) */
--- a/src/DLD-FUNCTIONS/rcond.cc +++ b/src/DLD-FUNCTIONS/rcond.cc @@ -85,3 +85,12 @@ return retval; } + +/* + +%!assert( rcond (eye (2)), 1) +%!assert( rcond (ones (2)), 0) +%!assert( rcond ([1 1; 2 1]), 1/9) +%!assert( rcond (magic (4)), 0, eps) + +*/
--- a/src/DLD-FUNCTIONS/regexp.cc +++ b/src/DLD-FUNCTIONS/regexp.cc @@ -85,7 +85,7 @@ { int sz = 0; - int nargin = args.length(); + int nargin = args.length (); bool lineanchors = false; bool dotexceptnewline = false; bool freespacing = false; @@ -99,77 +99,80 @@ if (error_state) { - gripe_wrong_type_arg (nm.c_str(), args(0)); + gripe_wrong_type_arg (nm.c_str (), args(0)); return 0; } std::string pattern = args(1).string_value (); + if (error_state) { - gripe_wrong_type_arg (nm.c_str(), args(1)); + gripe_wrong_type_arg (nm.c_str (), args(1)); return 0; } for (int i = 2; i < nargin; i++) { - std::string str = args(i).string_value(); + std::string str = args(i).string_value (); + if (error_state) { - error ("%s: optional arguments must be strings", nm.c_str()); + error ("%s: optional arguments must be strings", nm.c_str ()); break; } + std::transform (str.begin (), str.end (), str.begin (), tolower); - if (str.find("once", 0) == 0) + + if (str.find ("once", 0) == 0) { once = true; nopts--; } - else if (str.find("matchcase", 0) == 0) + else if (str.find ("matchcase", 0) == 0) { case_insensitive = false; nopts--; } - else if (str.find("ignorecase", 0) == 0) + else if (str.find ("ignorecase", 0) == 0) { case_insensitive = true; nopts--; } - else if (str.find("dotall", 0) == 0) + else if (str.find ("dotall", 0) == 0) { dotexceptnewline = false; nopts--; } - else if (str.find("stringanchors", 0) == 0) + else if (str.find ("stringanchors", 0) == 0) { lineanchors = false; nopts--; } - else if (str.find("literalspacing", 0) == 0) + else if (str.find ("literalspacing", 0) == 0) { freespacing = false; nopts--; } - - // Only accept these options with pcre - else if (str.find("dotexceptnewline", 0) == 0) + else if (str.find ("dotexceptnewline", 0) == 0) { dotexceptnewline = true; nopts--; } - else if (str.find("lineanchors", 0) == 0) + else if (str.find ("lineanchors", 0) == 0) { lineanchors = true; nopts--; } - else if (str.find("freespacing", 0) == 0) + else if (str.find ("freespacing", 0) == 0) { freespacing = true; nopts--; } - else if (str.find("start", 0) && str.find("end", 0) && - str.find("tokenextents", 0) && str.find("match", 0) && - str.find("tokens", 0) && str.find("names", 0)) - error ("%s: unrecognized option", nm.c_str()); + else if (str.find ("start", 0) && str.find ("end", 0) + && str.find ("tokenextents", 0) && str.find ("match", 0) + && str.find ("tokens", 0) && str.find ("names", 0) + && str.find ("split", 0)) + error ("%s: unrecognized option", nm.c_str ()); } if (!error_state) @@ -187,11 +190,11 @@ std::ostringstream buf; Array<int> named_idx; - while ((new_pos = pattern.find ("(?",pos)) != std::string::npos) + while ((new_pos = pattern.find ("(?", pos)) != std::string::npos) { - if (pattern.at (new_pos + 2) == '<' && - !(pattern.at (new_pos + 3) == '=' || - pattern.at (new_pos + 3) == '!')) + if (pattern.at (new_pos + 2) == '<' + && !(pattern.at (new_pos + 3) == '=' + || pattern.at (new_pos + 3) == '!')) { // The syntax of named tokens in pcre is "(?P<name>...)" while // we need a syntax "(?<name>...)", so fix that here. Also an @@ -202,7 +205,7 @@ // that here by replacing name tokens by dummy names, and dealing // with the dummy names later. - size_t tmp_pos = pattern.find_first_of ('>',new_pos); + size_t tmp_pos = pattern.find_first_of ('>', new_pos); if (tmp_pos == std::string::npos) { @@ -211,33 +214,38 @@ } std::string tmp_name = - pattern.substr(new_pos+3,tmp_pos-new_pos-3); + pattern.substr (new_pos+3, tmp_pos-new_pos-3); + bool found = false; for (int i = 0; i < nnames; i++) - if (named(i) == tmp_name) - { - named_idx.resize (dim_vector (inames+1, 1)); - named_idx(inames) = i; - found = true; - break; - } + { + if (named(i) == tmp_name) + { + named_idx.resize (dim_vector (inames+1, 1)); + named_idx(inames) = i; + found = true; + break; + } + } + if (! found) { named_idx.resize (dim_vector (inames+1, 1)); named_idx(inames) = nnames; - named.append(tmp_name); + named.append (tmp_name); nnames++; } if (new_pos - pos > 0) - buf << pattern.substr(pos,new_pos-pos); + buf << pattern.substr (pos, new_pos-pos); if (inames < 10) buf << "(?P<n00" << inames++; else if (inames < 100) buf << "(?P<n0" << inames++; else buf << "(?P<n" << inames++; + pos = tmp_pos; } else if (pattern.at (new_pos + 2) == '<') @@ -251,9 +259,11 @@ int brackets = 1; size_t tmp_pos1 = new_pos + 2; size_t tmp_pos2 = tmp_pos1; + while (tmp_pos1 <= pattern.length () && brackets > 0) { char ch = pattern.at (tmp_pos1); + if (ch == '(') brackets++; else if (ch == ')') @@ -263,6 +273,7 @@ brackets--; } + tmp_pos1++; } @@ -274,17 +285,20 @@ else { size_t tmp_pos3 = pattern.find_first_of ("*+", tmp_pos2); + if (tmp_pos3 != std::string::npos && tmp_pos3 < tmp_pos1) { if (!lookbehind_warned) { lookbehind_warned = true; - warning ("%s: arbitrary length lookbehind patterns are only supported up to length %d", nm.c_str(), MAXLOOKBEHIND); + warning ("%s: arbitrary length lookbehind patterns are only supported up to length %d", + nm.c_str (), MAXLOOKBEHIND); } buf << pattern.substr (pos, new_pos - pos) << "("; size_t i; + if (pattern.at (tmp_pos3) == '*') i = 0; else @@ -292,10 +306,10 @@ for (; i < max_length + 1; i++) { - buf << pattern.substr(new_pos, tmp_pos3 - new_pos) + buf << pattern.substr (new_pos, tmp_pos3 - new_pos) << "{" << i << "}"; - buf << pattern.substr(tmp_pos3 + 1, - tmp_pos1 - tmp_pos3 - 1); + buf << pattern.substr (tmp_pos3 + 1, + tmp_pos1 - tmp_pos3 - 1); if (i != max_length) buf << "|"; } @@ -303,6 +317,7 @@ } else buf << pattern.substr (pos, tmp_pos1 - pos); + pos = tmp_pos1; } } @@ -314,27 +329,27 @@ } - buf << pattern.substr(pos); + buf << pattern.substr (pos); if (error_state) return 0; // Compile expression - pcre *re; const char *err; int erroffset; std::string buf_str = buf.str (); - re = pcre_compile (buf_str.c_str (), - (case_insensitive ? PCRE_CASELESS : 0) | - (dotexceptnewline ? 0 : PCRE_DOTALL) | - (lineanchors ? PCRE_MULTILINE : 0) | - (freespacing ? PCRE_EXTENDED : 0), - &err, &erroffset, 0); + + pcre *re = pcre_compile (buf_str.c_str (), + ((case_insensitive ? PCRE_CASELESS : 0) + | (dotexceptnewline ? 0 : PCRE_DOTALL) + | (lineanchors ? PCRE_MULTILINE : 0) + | (freespacing ? PCRE_EXTENDED : 0)), + &err, &erroffset, 0); if (re == 0) { - error("%s: %s at position %d of expression", nm.c_str(), - err, erroffset); + error ("%s: %s at position %d of expression", nm.c_str (), + err, erroffset); return 0; } @@ -344,123 +359,137 @@ char *nametable; int idx = 0; - pcre_fullinfo(re, 0, PCRE_INFO_CAPTURECOUNT, &subpatterns); - pcre_fullinfo(re, 0, PCRE_INFO_NAMECOUNT, &namecount); - pcre_fullinfo(re, 0, PCRE_INFO_NAMEENTRYSIZE, &nameentrysize); - pcre_fullinfo(re, 0, PCRE_INFO_NAMETABLE, &nametable); + pcre_fullinfo (re, 0, PCRE_INFO_CAPTURECOUNT, &subpatterns); + pcre_fullinfo (re, 0, PCRE_INFO_NAMECOUNT, &namecount); + pcre_fullinfo (re, 0, PCRE_INFO_NAMEENTRYSIZE, &nameentrysize); + pcre_fullinfo (re, 0, PCRE_INFO_NAMETABLE, &nametable); - OCTAVE_LOCAL_BUFFER(int, ovector, (subpatterns+1)*3); - OCTAVE_LOCAL_BUFFER(int, nidx, namecount); + OCTAVE_LOCAL_BUFFER (int, ovector, (subpatterns+1)*3); + OCTAVE_LOCAL_BUFFER (int, nidx, namecount); for (int i = 0; i < namecount; i++) { // Index of subpattern in first two bytes MSB first of name. // Extract index. - nidx[i] = (static_cast<int>(nametable[i*nameentrysize])) << 8 | - static_cast<int>(nametable[i*nameentrysize+1]); + nidx[i] = (static_cast<int> (nametable[i*nameentrysize])) << 8 + | static_cast<int> (nametable[i*nameentrysize+1]); } - while(true) + while (true) { OCTAVE_QUIT; - int matches = pcre_exec(re, 0, buffer.c_str(), - buffer.length(), idx, - (idx ? PCRE_NOTBOL : 0), - ovector, (subpatterns+1)*3); + int matches = pcre_exec (re, 0, buffer.c_str (), + buffer.length (), idx, + (idx ? PCRE_NOTBOL : 0), + ovector, (subpatterns+1)*3); if (matches == PCRE_ERROR_MATCHLIMIT) { - // try harder; start with default value for MATCH_LIMIT and increase it + // Try harder; start with default value for MATCH_LIMIT + // and increase it. warning ("your pattern caused PCRE to hit its MATCH_LIMIT; trying harder now, but this will be slow"); + pcre_extra pe; - pcre_config(PCRE_CONFIG_MATCH_LIMIT, static_cast <void *> (&pe.match_limit)); + + pcre_config (PCRE_CONFIG_MATCH_LIMIT, + static_cast <void *> (&pe.match_limit)); + pe.flags = PCRE_EXTRA_MATCH_LIMIT; int i = 0; - while (matches == PCRE_ERROR_MATCHLIMIT && - i++ < PCRE_MATCHLIMIT_MAX) + while (matches == PCRE_ERROR_MATCHLIMIT + && i++ < PCRE_MATCHLIMIT_MAX) { OCTAVE_QUIT; pe.match_limit *= 10; - matches = pcre_exec(re, &pe, buffer.c_str(), - buffer.length(), idx, - (idx ? PCRE_NOTBOL : 0), - ovector, (subpatterns+1)*3); + matches = pcre_exec (re, &pe, buffer.c_str (), + buffer.length (), idx, + (idx ? PCRE_NOTBOL : 0), + ovector, (subpatterns+1)*3); } } if (matches < 0 && matches != PCRE_ERROR_NOMATCH) { error ("%s: internal error calling pcre_exec; error code from pcre_exec is %i", - nm.c_str(), matches); - pcre_free(re); + nm.c_str (), matches); + pcre_free (re); return 0; } else if (matches == PCRE_ERROR_NOMATCH) break; else if (ovector[1] <= ovector[0]) { - // FIXME: Zero sized match!! Is this the right thing to do? + // Zero sized match. Skip to next char. idx = ovector[0] + 1; - continue; + if (idx < buffer.length ()) + continue; + else + break; } else { int pos_match = 0; - Matrix te(matches-1,2); + Matrix te (matches-1, 2); + for (int i = 1; i < matches; i++) - if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) - if (i == 1 || ovector[2*i] != ovector[2*i-2] - || ovector[2*i-1] != ovector[2*i+1]) + { + if (ovector[2*i] >= 0 && ovector[2*i+1] > 0 + && (i == 1 || ovector[2*i] != ovector[2*i-2] + || ovector[2*i-1] != ovector[2*i+1]) + && ovector[2*i] >= 0 && ovector[2*i+1] > 0) { - if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) - { - te(pos_match,0) = double (ovector[2*i]+1); - te(pos_match++,1) = double (ovector[2*i+1]); - } + te(pos_match,0) = double (ovector[2*i]+1); + te(pos_match++,1) = double (ovector[2*i+1]); } - te.resize(pos_match,2); + } + + te.resize (pos_match, 2); + s = double (ovector[0]+1); e = double (ovector[1]); const char **listptr; - int status = pcre_get_substring_list(buffer.c_str(), ovector, + int status = pcre_get_substring_list (buffer.c_str (), ovector, matches, &listptr); if (status == PCRE_ERROR_NOMEMORY) { - error("%s: cannot allocate memory in pcre_get_substring_list", - nm.c_str()); - pcre_free(re); + error ("%s: cannot allocate memory in pcre_get_substring_list", + nm.c_str ()); + pcre_free (re); return 0; } - Cell cell_t (dim_vector(1,pos_match)); - string_vector named_tokens(nnames); + Cell cell_t (dim_vector (1, pos_match)); + string_vector named_tokens (nnames); int pos_offset = 0; pos_match = 0; + for (int i = 1; i < matches; i++) - if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) - { - if (i == 1 || ovector[2*i] != ovector[2*i-2] - || ovector[2*i-1] != ovector[2*i+1]) - { - if (namecount > 0) - named_tokens(named_idx(i-pos_offset-1)) = - std::string(*(listptr+nidx[i-pos_offset-1])); - cell_t(pos_match++) = - std::string(*(listptr+i)); - } - else - pos_offset++; + { + if (ovector[2*i] >= 0 && ovector[2*i+1] > 0) + { + if (i == 1 || ovector[2*i] != ovector[2*i-2] + || ovector[2*i-1] != ovector[2*i+1]) + { + if (namecount > 0) + named_tokens(named_idx(i-pos_offset-1)) = + std::string (*(listptr+nidx[i-pos_offset-1])); + cell_t(pos_match++) = + std::string (*(listptr+i)); + } + else + pos_offset++; + } } - m = std::string(*listptr); + m = std::string (*listptr); t = cell_t; - pcre_free_substring_list(listptr); + pcre_free_substring_list (listptr); regexp_elem new_elem (named_tokens, t, m, te, s, e); lst.push_back (new_elem); @@ -473,7 +502,7 @@ } } - pcre_free(re); + pcre_free (re); } return sz; @@ -484,11 +513,12 @@ bool case_insensitive) { octave_value_list retval; - int nargin = args.length(); + int nargin = args.length (); std::list<regexp_elem> lst; string_vector named; int nopts; bool once; + int sz = octregexp_list (args, nm, case_insensitive, lst, named, nopts, once); if (! error_state) @@ -498,88 +528,89 @@ octave_idx_type i = 0; octave_scalar_map nmap; + retval.resize (7); + if (sz == 1) { - for (int j = 0; j < named.length(); j++) - nmap.assign (named(j), lst.begin()->named_token(j)); + for (int j = 0; j < named.length (); j++) + nmap.assign (named(j), lst.begin()->named_token (j)); + retval(5) = nmap; } else { for (int j = 0; j < named.length (); j++) { + Cell tmp (dim_vector (1, sz)); + i = 0; - Cell tmp(dim_vector (1, sz)); - for (const_iterator p = lst.begin(); p != lst.end(); p++) - tmp(i++) = p->named_token(j); + for (const_iterator p = lst.begin (); p != lst.end (); p++) + tmp(i++) = p->named_token (j); + nmap.assign (named(j), octave_value (tmp)); } + retval(5) = nmap; } - if (once) - retval(4) = sz ? lst.front ().t : Cell(); - else - { - Cell t (dim_vector(1, sz)); - i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - t(i++) = p->t; - retval(4) = t; - } - - if (once) - retval(3) = sz ? lst.front ().m : std::string(); - else - { - Cell m (dim_vector(1, sz)); - i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - m(i++) = p->m; - retval(3) = m; - } - - if (once) - retval(2) = sz ? lst.front ().te : Matrix(); - else - { - Cell te (dim_vector(1, sz)); - i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - te(i++) = p->te; - retval(2) = te; - } + std::string buffer = args(0).string_value (); if (once) { + retval(4) = sz ? lst.front ().t : Cell (); + retval(3) = sz ? lst.front ().m : std::string (); + retval(2) = sz ? lst.front ().te : Matrix (); + if (sz) - retval(1) = lst.front ().e; + { + double e = lst.front ().e; + double s = lst.front ().s; + + Cell sp (dim_vector (1, 2)); + sp(0) = buffer.substr (0, s-1); + sp(1) = buffer.substr (e); + + retval(6) = sp; + retval(1) = e; + retval(0) = s; + } else - retval(1) = Matrix(); + { + retval(6) = buffer; + retval(1) = Matrix (); + retval(0) = Matrix (); + } } else { - NDArray e (dim_vector(1, sz)); - i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - e(i++) = p->e; - retval(1) = e; - } - - if (once) - { - if (sz) - retval(0) = lst.front ().s; - else - retval(0) = Matrix(); - } - else - { - NDArray s (dim_vector(1, sz)); + Cell t (dim_vector (1, sz)); + Cell m (dim_vector (1, sz)); + Cell te (dim_vector (1, sz)); + NDArray e (dim_vector (1, sz)); + NDArray s (dim_vector (1, sz)); + Cell sp (dim_vector (1, sz+1)); + size_t sp_start = 0; i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) - s(i++) = p->s; + for (const_iterator p = lst.begin (); p != lst.end (); p++) + { + t(i) = p->t; + m(i) = p->m; + te(i) = p->te; + e(i) = p->e; + s(i) = p->s; + sp(i) = buffer.substr (sp_start, p->s-sp_start-1); + sp_start = p->e; + i++; + } + + sp(i) = buffer.substr (sp_start); + + retval(6) = sp; + retval(4) = t; + retval(3) = m; + retval(2) = te; + retval(1) = e; retval(0) = s; } @@ -588,7 +619,7 @@ { int n = 0; octave_value_list new_retval; - new_retval.resize(nargout); + new_retval.resize (nargout); OCTAVE_LOCAL_BUFFER (int, arg_used, 6); for (int j = 0; j < 6; j++) @@ -597,31 +628,33 @@ for (int j = 2; j < nargin; j++) { int k = 0; - std::string str = args(j).string_value(); + std::string str = args(j).string_value (); std::transform (str.begin (), str.end (), str.begin (), tolower); - if (str.find("once", 0) == 0 - || str.find("stringanchors", 0) == 0 - || str.find("lineanchors", 0) == 0 - || str.find("matchcase", 0) == 0 - || str.find("ignorecase", 0) == 0 - || str.find("dotall", 0) == 0 - || str.find("dotexceptnewline", 0) == 0 - || str.find("literalspacing", 0) == 0 - || str.find("freespacing", 0) == 0 - ) + + if (str.find ("once", 0) == 0 + || str.find ("stringanchors", 0) == 0 + || str.find ("lineanchors", 0) == 0 + || str.find ("matchcase", 0) == 0 + || str.find ("ignorecase", 0) == 0 + || str.find ("dotall", 0) == 0 + || str.find ("dotexceptnewline", 0) == 0 + || str.find ("literalspacing", 0) == 0 + || str.find ("freespacing", 0) == 0) continue; - else if (str.find("start", 0) == 0) + else if (str.find ("start", 0) == 0) k = 0; - else if (str.find("end", 0) == 0) + else if (str.find ("end", 0) == 0) k = 1; - else if (str.find("tokenextents", 0) == 0) + else if (str.find ("tokenextents", 0) == 0) k = 2; - else if (str.find("match", 0) == 0) + else if (str.find ("match", 0) == 0) k = 3; - else if (str.find("tokens", 0) == 0) + else if (str.find ("tokens", 0) == 0) k = 4; - else if (str.find("names", 0) == 0) + else if (str.find ("names", 0) == 0) k = 5; + else if (str.find ("split", 0) == 0) + k = 6; new_retval(n++) = retval(k); arg_used[k] = true; @@ -648,24 +681,24 @@ } static octave_value_list -octcellregexp (const octave_value_list &args, int nargout, const std::string &nm, - bool case_insensitive) +octcellregexp (const octave_value_list &args, int nargout, + const std::string &nm, bool case_insensitive) { octave_value_list retval; - if (args(0).is_cell()) + if (args(0).is_cell ()) { OCTAVE_LOCAL_BUFFER (Cell, newretval, nargout); octave_value_list new_args = args; - Cell cellstr = args(0).cell_value(); - if (args(1).is_cell()) + Cell cellstr = args(0).cell_value (); + if (args(1).is_cell ()) { - Cell cellpat = args(1).cell_value(); + Cell cellpat = args(1).cell_value (); - if (cellpat.numel() == 1) + if (cellpat.numel () == 1) { for (int j = 0; j < nargout; j++) - newretval[j].resize(cellstr.dims()); + newretval[j].resize (cellstr.dims ()); new_args(1) = cellpat(0); @@ -682,10 +715,10 @@ newretval[j](i) = tmp(j); } } - else if (cellstr.numel() == 1) + else if (cellstr.numel () == 1) { for (int j = 0; j < nargout; j++) - newretval[j].resize(cellpat.dims()); + newretval[j].resize (cellpat.dims ()); new_args(0) = cellstr(0); @@ -702,15 +735,15 @@ newretval[j](i) = tmp(j); } } - else if (cellstr.numel() == cellpat.numel()) + else if (cellstr.numel () == cellpat.numel ()) { - if (cellstr.dims() != cellpat.dims()) - error ("%s: Inconsistent cell array dimensions", nm.c_str()); + if (cellstr.dims () != cellpat.dims ()) + error ("%s: Inconsistent cell array dimensions", nm.c_str ()); else { for (int j = 0; j < nargout; j++) - newretval[j].resize(cellstr.dims()); + newretval[j].resize (cellstr.dims ()); for (octave_idx_type i = 0; i < cellstr.numel (); i++) { @@ -734,12 +767,13 @@ else { for (int j = 0; j < nargout; j++) - newretval[j].resize(cellstr.dims()); + newretval[j].resize (cellstr.dims ()); for (octave_idx_type i = 0; i < cellstr.numel (); i++) { new_args(0) = cellstr(i); - octave_value_list tmp = octregexp (new_args, nargout, nm, case_insensitive); + octave_value_list tmp = octregexp (new_args, nargout, nm, + case_insensitive); if (error_state) break; @@ -753,19 +787,20 @@ for (int j = 0; j < nargout; j++) retval(j) = octave_value (newretval[j]); } - else if (args(1).is_cell()) + else if (args(1).is_cell ()) { OCTAVE_LOCAL_BUFFER (Cell, newretval, nargout); octave_value_list new_args = args; - Cell cellpat = args(1).cell_value(); + Cell cellpat = args(1).cell_value (); for (int j = 0; j < nargout; j++) - newretval[j].resize(cellpat.dims()); + newretval[j].resize(cellpat.dims ()); for (octave_idx_type i = 0; i < cellpat.numel (); i++) { new_args(1) = cellpat(i); - octave_value_list tmp = octregexp (new_args, nargout, nm, case_insensitive); + octave_value_list tmp = octregexp (new_args, nargout, nm, + case_insensitive); if (error_state) break; @@ -775,8 +810,10 @@ } if (!error_state) - for (int j = 0; j < nargout; j++) - retval(j) = octave_value (newretval[j]); + { + for (int j = 0; j < nargout; j++) + retval(j) = octave_value (newretval[j]); + } } else retval = octregexp (args, nargout, nm, case_insensitive); @@ -904,6 +941,8 @@ A structure containing the text of each matched named token, with the name\n\ being used as the fieldname. A named token is denoted by\n\ @code{(?<name>@dots{})}.\n\ +@item sp\n\ +A cell array of the text not returned by match.\n\ @end table\n\ \n\ Particular output arguments, or the order of the output arguments, can be\n\ @@ -918,6 +957,7 @@ @item @tab 'match' @tab @var{m} @tab\n\ @item @tab 'tokens' @tab @var{t} @tab\n\ @item @tab 'names' @tab @var{nm} @tab\n\ +@item @tab 'split' @tab @var{sp} @tab\n\ @end multitable\n\ \n\ Additional arguments are summarized below.\n\ @@ -975,11 +1015,12 @@ @end deftypefn") { octave_value_list retval; - int nargin = args.length(); + + int nargin = args.length (); if (nargin < 2) print_usage (); - else if (args(0).is_cell() || args(1).is_cell()) + else if (args(0).is_cell () || args(1).is_cell ()) retval = octcellregexp (args, nargout, "regexp", false); else retval = octregexp (args, nargout, "regexp", false); @@ -1002,6 +1043,8 @@ ## seg-fault test %!assert(regexp("abcde","."),[1,2,3,4,5]) +## Infinite loop test +%!assert (isempty (regexp("abcde", ""))) ## Check that anchoring of pattern works correctly %!assert(regexp('abcabc','^abc'),1); @@ -1156,6 +1199,45 @@ %! assert(regexp("qit",'q(?=u*)','match'), {'q'}) %! assert(regexp('thingamabob','(?<=a)b'), 9) +## Tests for split option. +%!shared str +%! str = "foo bar foo"; +%!test +%! [a, b] = regexp (str, "f..", "match", "split"); +%! assert (a, {"foo", "foo"}); +%! assert (b, {"", " bar ", ""}); +%!test +%! [a, b] = regexp (str, "f..", "match", "split", "once"); +%! assert (a, "foo"); +%! assert (b, {"", " bar foo"}); +%!test +%! [a, b] = regexp (str, "fx.", "match", "split"); +%! assert (a, cell (1, 0)); +%! assert (b, {"foo bar foo"}); +%!test +%! [a, b] = regexp (str, "fx.", "match", "split", "once"); +%! assert (a, ""); +%! assert (b, "foo bar foo") + +%!shared str +%! str = "foo bar"; +%!test +%! [a, b] = regexp (str, "f..", "match", "split"); +%! assert (a, {"foo"}); +%! assert (b, {"", " bar"}); +%!test +%! [a, b] = regexp (str, "b..", "match", "split"); +%! assert (a, {"bar"}); +%! assert (b, {"foo ", ""}); +%!test +%! [a, b] = regexp (str, "x", "match", "split"); +%! assert (a, cell (1, 0)); +%! assert (b, {"foo bar"}); +%!test +%! [a, b] = regexp (str, "[o]+", "match", "split"); +%! assert (a, {"oo"}); +%! assert (b, {"f", " bar"}); + */ DEFUN_DLD (regexpi, args, nargout, @@ -1171,11 +1253,12 @@ @end deftypefn") { octave_value_list retval; - int nargin = args.length(); + + int nargin = args.length (); if (nargin < 2) print_usage (); - else if (args(0).is_cell() || args(1).is_cell()) + else if (args(0).is_cell () || args(1).is_cell ()) retval = octcellregexp (args, nargout, "regexpi", true); else retval = octregexp (args, nargout, "regexpi", true); @@ -1321,50 +1404,60 @@ octregexprep (const octave_value_list &args, const std::string &nm) { octave_value retval; - int nargin = args.length(); - // Make sure we have string,pattern,replacement + int nargin = args.length (); + + // Make sure we have string, pattern, replacement const std::string buffer = args(0).string_value (); - if (error_state) return retval; + if (error_state) + return retval; + const std::string pattern = args(1).string_value (); - if (error_state) return retval; + if (error_state) + return retval; + const std::string replacement = args(2).string_value (); - if (error_state) return retval; + if (error_state) + return retval; // Pack options excluding 'tokenize' and various output // reordering strings into regexp arg list - octave_value_list regexpargs(nargin-1,octave_value()); - regexpargs(0) = args(0); - regexpargs(1) = args(1); - int len=2; + octave_value_list regexpargs (nargin-1, octave_value ()); + + regexpargs(0) = args (0); + regexpargs(1) = args (1); + + int len = 2; for (int i = 3; i < nargin; i++) { - const std::string opt = args(i).string_value(); + const std::string opt = args(i).string_value (); if (opt != "tokenize" && opt != "start" && opt != "end" && opt != "tokenextents" && opt != "match" && opt != "tokens" - && opt != "names" && opt != "warnings") + && opt != "names" && opt != "split" && opt != "warnings") { regexpargs(len++) = args(i); } } - regexpargs.resize(len); + regexpargs.resize (len); // Identify replacement tokens; build a vector of group numbers in // the replacement string so that we can quickly calculate the size // of the replacement. int tokens = 0; - for (size_t i=1; i < replacement.size(); i++) + for (size_t i=1; i < replacement.size (); i++) { - if (replacement[i-1]=='$' && isdigit(replacement[i])) + if (replacement[i-1]=='$' && isdigit (replacement[i])) { - tokens++, i++; + tokens++; + i++; } } - std::vector<int> token(tokens); + std::vector<int> token (tokens); + int kk = 0; - for (size_t i = 1; i < replacement.size(); i++) + for (size_t i = 1; i < replacement.size (); i++) { - if (replacement[i-1]=='$' && isdigit(replacement[i])) + if (replacement[i-1]=='$' && isdigit (replacement[i])) { token[kk++] = replacement[i]-'0'; i++; @@ -1373,6 +1466,7 @@ // Perform replacement std::string rep; + if (tokens > 0) { std::list<regexp_elem> lst; @@ -1390,56 +1484,56 @@ } // Determine replacement length - const size_t replen = replacement.size() - 2*tokens; + const size_t replen = replacement.size () - 2*tokens; int delta = 0; - const_iterator p = lst.begin(); + const_iterator p = lst.begin (); for (int i = 0; i < sz; i++) { OCTAVE_QUIT; - const Matrix pairs(p->te); + const Matrix pairs (p->te); size_t pairlen = 0; for (int j = 0; j < tokens; j++) { if (token[j] == 0) - pairlen += static_cast<size_t>(p->e - p->s) + 1; - else if (token[j] <= pairs.rows()) - pairlen += static_cast<size_t>(pairs(token[j]-1,1) - - pairs(token[j]-1,0)) + 1; + pairlen += static_cast<size_t> (p->e - p->s) + 1; + else if (token[j] <= pairs.rows ()) + pairlen += static_cast<size_t> (pairs(token[j]-1,1) + - pairs(token[j]-1,0)) + 1; } - delta += static_cast<int>(replen + pairlen) - - static_cast<int>(p->e - p->s + 1); + delta += static_cast<int> (replen + pairlen) + - static_cast<int> (p->e - p->s + 1); p++; } // Build replacement string - rep.reserve(buffer.size()+delta); + rep.reserve (buffer.size () + delta); size_t from = 0; - p = lst.begin(); - for (int i=0; i < sz; i++) + p = lst.begin (); + for (int i = 0; i < sz; i++) { OCTAVE_QUIT; - const Matrix pairs(p->te); - rep.append(&buffer[from], static_cast<size_t>(p->s - 1) - from); - from = static_cast<size_t>(p->e - 1) + 1; - for (size_t j = 1; j < replacement.size(); j++) + const Matrix pairs (p->te); + rep.append (&buffer[from], static_cast<size_t> (p->s - 1) - from); + from = static_cast<size_t> (p->e - 1) + 1; + for (size_t j = 1; j < replacement.size (); j++) { - if (replacement[j-1]=='$' && isdigit(replacement[j])) + if (replacement[j-1]=='$' && isdigit (replacement[j])) { int k = replacement[j]-'0'; if (k == 0) { // replace with entire match - rep.append(&buffer[static_cast<size_t>(p->e - 1)], - static_cast<size_t>(p->e - p->s) + 1); + rep.append (&buffer[static_cast<size_t> (p->e - 1)], + static_cast<size_t> (p->e - p->s) + 1); } - else if (k <= pairs.rows()) + else if (k <= pairs.rows ()) { // replace with group capture - rep.append(&buffer[static_cast<size_t>(pairs(k-1,0)-1)], - static_cast<size_t>(pairs(k-1,1) - - pairs(k-1,0))+1); + rep.append (&buffer[static_cast<size_t> (pairs(k-1,0)-1)], + static_cast<size_t> (pairs(k-1,1) + - pairs(k-1,0)) + 1); } else { @@ -1449,16 +1543,16 @@ } else { - rep.append(1,replacement[j-1]); + rep.append (1, replacement[j-1]); } - if (j+1 == replacement.size()) + if (j+1 == replacement.size ()) { - rep.append(1,replacement[j]); + rep.append (1, replacement[j]); } } p++; } - rep.append(&buffer[from],buffer.size()-from); + rep.append (&buffer[from], buffer.size () - from); } else { @@ -1472,35 +1566,35 @@ return retval; if (sz == 0) { - retval = args(0); + retval = args (0); return retval; } // Determine replacement length - const size_t replen = replacement.size(); + const size_t replen = replacement.size (); int delta = 0; - const_iterator p = lst.begin(); + const_iterator p = lst.begin (); for (int i = 0; i < sz; i++) { OCTAVE_QUIT; - delta += static_cast<int>(replen) - - static_cast<int>(p->e - p->s + 1); + delta += static_cast<int> (replen) + - static_cast<int> (p->e - p->s + 1); p++; } // Build replacement string - rep.reserve(buffer.size()+delta); + rep.reserve (buffer.size () + delta); size_t from = 0; - p = lst.begin(); - for (int i=0; i < sz; i++) + p = lst.begin (); + for (int i = 0; i < sz; i++) { OCTAVE_QUIT; - rep.append(&buffer[from], static_cast<size_t>(p->s - 1) - from); - from = static_cast<size_t>(p->e - 1) + 1; - rep.append(replacement); + rep.append (&buffer[from], static_cast<size_t> (p->s - 1) - from); + from = static_cast<size_t> (p->e - 1) + 1; + rep.append (replacement); p++; } - rep.append(&buffer[from],buffer.size()-from); + rep.append (&buffer[from], buffer.size () - from); } retval = rep; @@ -1541,7 +1635,7 @@ @end deftypefn") { octave_value_list retval; - int nargin = args.length(); + int nargin = args.length (); if (nargin < 3) { @@ -1549,56 +1643,57 @@ return retval; } - if (args(0).is_cell() || args(1).is_cell() || args(2).is_cell()) + if (args(0).is_cell () || args(1).is_cell () || args(2).is_cell ()) { Cell str; Cell pat; Cell rep; dim_vector dv0; - dim_vector dv1(1,1); + dim_vector dv1 (1, 1); - if (args(0).is_cell()) - str = args(0).cell_value(); + if (args(0).is_cell ()) + str = args(0).cell_value (); else str = Cell (args(0)); - if (args(1).is_cell()) - pat = args(1).cell_value(); + if (args(1).is_cell ()) + pat = args(1).cell_value (); else pat = Cell (args(1)); - if (args(2).is_cell()) - rep = args(2).cell_value(); + if (args(2).is_cell ()) + rep = args(2).cell_value (); else rep = Cell (args(2)); - dv0 = str.dims(); - if (pat.numel() != 1) + dv0 = str.dims (); + if (pat.numel () != 1) { - dv1 = pat.dims(); - if (rep.numel() != 1 && dv1 != rep.dims()) + dv1 = pat.dims (); + if (rep.numel () != 1 && dv1 != rep.dims ()) error ("regexprep: Inconsistent cell array dimensions"); } - else if (rep.numel() != 1) - dv1 = rep.dims(); + else if (rep.numel () != 1) + dv1 = rep.dims (); if (!error_state) { Cell ret (dv0); octave_value_list new_args = args; - for (octave_idx_type i = 0; i < dv0.numel(); i++) + for (octave_idx_type i = 0; i < dv0.numel (); i++) { new_args(0) = str(i); if (pat.numel() == 1) new_args(1) = pat(0); if (rep.numel() == 1) new_args(2) = rep(0); - for (octave_idx_type j = 0; j < dv1.numel(); j++) + + for (octave_idx_type j = 0; j < dv1.numel (); j++) { - if (pat.numel() != 1) + if (pat.numel () != 1) new_args(1) = pat(j); - if (rep.numel() != 1) + if (rep.numel () != 1) new_args(2) = rep(j); new_args(0) = octregexprep (new_args, "regexprep"); @@ -1613,7 +1708,8 @@ } if (!error_state) - retval = octave_value (ret); + retval = args(0).is_cell () + ? octave_value (ret) : octave_value (ret(0)); } } else @@ -1669,7 +1765,7 @@ %!assert(regexprep("abc","(b)","$1.."),"ab..c"); ## Test cell array arguments -%!assert(regexprep("abc",{"b","a"},"?"),{"??c"}) +%!assert(regexprep("abc",{"b","a"},"?"),"??c") %!assert(regexprep({"abc","cba"},"b","?"),{"a?c","c?a"}) %!assert(regexprep({"abc","cba"},{"b","a"},{"?","!"}),{"!?c","c?!"})
--- a/src/DLD-FUNCTIONS/schur.cc +++ b/src/DLD-FUNCTIONS/schur.cc @@ -307,7 +307,7 @@ $U^{\\dagger} U$ is the identity matrix I.\n\ @end tex\n\ @ifnottex\n\ -@code{@var{UR} * @var{TR} * @var{UR}' = @var{U} * @var{T} * @var{U}'} and\n\ +@xcode{@var{UR} * @var{TR} * @var{UR}' = @var{U} * @var{T} * @var{U}'} and\n\ @code{@var{U}' * @var{U}} is the identity matrix I.\n\ @end ifnottex\n\ \n\
--- a/src/DLD-FUNCTIONS/spparms.cc +++ b/src/DLD-FUNCTIONS/spparms.cc @@ -136,7 +136,7 @@ { double val = octave_sparse_params::get_key (str); if (xisnan (val)) - error ("spparams: KEY not recognized"); + error ("spparms: KEY not recognized"); else retval (0) = val; } @@ -148,7 +148,7 @@ if (error_state) error ("spparms: input must be a string or a vector"); else if (vals.numel () > OCTAVE_SPARSE_CONTROLS_SIZE) - error ("spparams: too many elements in vector VALS"); + error ("spparms: too many elements in vector VALS"); else octave_sparse_params::set_vals (vals); } @@ -176,3 +176,33 @@ return retval; } + +/* + +%!test +%! old_vals = spparms (); # save state +%! spparms ("defaults"); +%! vals = spparms (); +%! assert (vals, [0 1 1 0 3 3 0.5 1.0 1.0 0.1 0.5 1.0 0.001]'); +%! [keys, vals] = spparms (); +%! assert (rows (keys), 13); +%! assert (keys(2,:), "ths_rel"); +%! assert (vals, [0 1 1 0 3 3 0.5 1.0 1.0 0.1 0.5 1.0 0.001]'); +%! spparms ([3 2 1]); +%! assert (spparms ()(1:3), [3, 2, 1]'); +%! assert (spparms ("ths_rel"), 2); +%! spparms ("exact_d", 5); +%! assert (spparms ("exact_d"), 5); +%! 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)) + +*/
--- a/src/DLD-FUNCTIONS/sqrtm.cc +++ b/src/DLD-FUNCTIONS/sqrtm.cc @@ -49,22 +49,20 @@ bool singular = false; - /* - * the following code is equivalent to this triple loop: - * - * n = rows (T); - * for j = 1:n - * T(j,j) = sqrt (T(j,j)); - * for i = j-1:-1:1 - * T(i,j) /= (T(i,i) + T(j,j)); - * k = 1:i-1; - * T(k,j) -= T(k,i) * T(i,j); - * endfor - * endfor - * - * this is an in-place, cache-aligned variant of the code - * given in Higham's paper. - */ + // The following code is equivalent to this triple loop: + // + // n = rows (T); + // for j = 1:n + // T(j,j) = sqrt (T(j,j)); + // for i = j-1:-1:1 + // T(i,j) /= (T(i,i) + T(j,j)); + // k = 1:i-1; + // T(k,j) -= T(k,i) * T(i,j); + // endfor + // endfor + // + // this is an in-place, cache-aligned variant of the code + // given in Higham's paper. const octave_idx_type n = T.rows (); element_type *Tp = T.fortran_vec (); @@ -117,38 +115,32 @@ { case MatrixType::Upper: case MatrixType::Diagonal: - { - if (! x.diag ().any_element_is_negative ()) - { - // Do it in real arithmetic. - sqrtm_utri_inplace (x); - retval = x; - retval.matrix_type (mt); - } - else - iscomplex = true; - - break; - } - case MatrixType::Lower: + if (! x.diag ().any_element_is_negative ()) { - if (! x.diag ().any_element_is_negative ()) - { - x = x.transpose (); - sqrtm_utri_inplace (x); - retval = x.transpose (); - retval.matrix_type (mt); - } - else - iscomplex = true; + // Do it in real arithmetic. + sqrtm_utri_inplace (x); + retval = x; + retval.matrix_type (mt); + } + else + iscomplex = true; + break; - break; + case MatrixType::Lower: + if (! x.diag ().any_element_is_negative ()) + { + x = x.transpose (); + sqrtm_utri_inplace (x); + retval = x.transpose (); + retval.matrix_type (mt); } + else + iscomplex = true; + break; + default: - { - iscomplex = true; - break; - } + iscomplex = true; + break; } if (iscomplex) @@ -166,46 +158,41 @@ { case MatrixType::Upper: case MatrixType::Diagonal: - { - sqrtm_utri_inplace (x); - retval = x; - retval.matrix_type (mt); + sqrtm_utri_inplace (x); + retval = x; + retval.matrix_type (mt); + break; - break; - } case MatrixType::Lower: - { - x = x.transpose (); - sqrtm_utri_inplace (x); - retval = x.transpose (); - retval.matrix_type (mt); + x = x.transpose (); + sqrtm_utri_inplace (x); + retval = x.transpose (); + retval.matrix_type (mt); + break; - break; - } default: - { - ComplexMatrix u; + { + ComplexMatrix u; - do - { - ComplexSCHUR schur (x, std::string (), true); - x = schur.schur_matrix (); - u = schur.unitary_matrix (); - } - while (0); // schur no longer needed. + do + { + ComplexSCHUR schur (x, std::string (), true); + x = schur.schur_matrix (); + u = schur.unitary_matrix (); + } + while (0); // schur no longer needed. - sqrtm_utri_inplace (x); + sqrtm_utri_inplace (x); - x = u * x; // original x no longer needed. - ComplexMatrix res = xgemm (x, u, blas_no_trans, blas_conj_trans); + x = u * x; // original x no longer needed. + ComplexMatrix res = xgemm (x, u, blas_no_trans, blas_conj_trans); - if (cutoff > 0 && xnorm (imag (res), one) <= cutoff) - retval = real (res); - else - retval = res; - - break; - } + if (cutoff > 0 && xnorm (imag (res), one) <= cutoff) + retval = real (res); + else + retval = res; + } + break; } } @@ -246,22 +233,17 @@ } if (arg.is_diag_matrix ()) - { - // sqrtm of a diagonal matrix is just sqrt. - retval(0) = arg.sqrt (); - } + // sqrtm of a diagonal matrix is just sqrt. + retval(0) = arg.sqrt (); else if (arg.is_single_type ()) - { - retval(0) = do_sqrtm<FloatMatrix, FloatComplexMatrix, FloatComplexSCHUR> (arg); - } + retval(0) = do_sqrtm<FloatMatrix, FloatComplexMatrix, FloatComplexSCHUR> (arg); else if (arg.is_numeric_type ()) - { - retval(0) = do_sqrtm<Matrix, ComplexMatrix, ComplexSCHUR> (arg); - } + retval(0) = do_sqrtm<Matrix, ComplexMatrix, ComplexSCHUR> (arg); if (nargout > 1 && ! error_state) { // This corresponds to generic code + // // norm (s*s - x, "fro") / norm (x, "fro"); octave_value s = retval(0); @@ -270,3 +252,22 @@ return retval; } + +/* + +%!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))(:) )) + +%!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 + +*/
--- a/src/DLD-FUNCTIONS/str2double.cc +++ b/src/DLD-FUNCTIONS/str2double.cc @@ -271,7 +271,7 @@ } else if (args(0).is_cell ()) { - const Cell cell = args(0).cell_value (); + const Cell cell = args(0).cell_value (); if (! error_state) { @@ -286,7 +286,7 @@ } else retval = NDArray (args(0).dims (), octave_NaN); - + return retval; }
--- a/src/DLD-FUNCTIONS/symbfact.cc +++ b/src/DLD-FUNCTIONS/symbfact.cc @@ -63,10 +63,10 @@ Factorize @code{@var{S}' * @var{S}}.\n\ \n\ @item row\n\ -Factorize @code{@var{S} * @var{S}'}.\n\ +Factorize @xcode{@var{S} * @var{S}'}.\n\ \n\ @item lo\n\ -Factorize @code{@var{S}'}\n\ +Factorize @xcode{@var{S}'}\n\ @end table\n\ \n\ @item mode\n\
--- a/src/DLD-FUNCTIONS/urlwrite.cc +++ b/src/DLD-FUNCTIONS/urlwrite.cc @@ -112,11 +112,11 @@ { BEGIN_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - CURLcode res = curl_easy_perform (curl); - if (res != CURLE_OK) + errnum = curl_easy_perform (curl); + if (errnum != CURLE_OK) { if (curlerror) - error ("%s", curl_easy_strerror (res)); + error ("%s", curl_easy_strerror (errnum)); } else retval = true; @@ -145,6 +145,7 @@ std::string host; bool valid; bool ascii; + mutable CURLcode errnum; private: CURL *curl; @@ -250,11 +251,7 @@ std::string lasterror (void) const { - CURLcode errnum; - - curl_easy_getinfo (rep->handle(), CURLINFO_OS_ERRNO, &errnum); - - return std::string (curl_easy_strerror (errnum)); + return std::string (curl_easy_strerror (rep->errnum)); } void set_ostream (std::ostream& os) const
--- a/src/Makefile.am +++ b/src/Makefile.am @@ -3,17 +3,17 @@ # Copyright (C) 1993-2011 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 # <http://www.gnu.org/licenses/>. @@ -24,7 +24,7 @@ @CPPFLAGS@ -I../libgnu -I$(top_srcdir)/libgnu \ -I$(top_srcdir)/libcruft/misc \ -I../liboctave -I$(top_srcdir)/liboctave \ - -I. -I$(srcdir) + -I. -I$(srcdir) AUTOMAKE_OPTIONS = subdir-objects @@ -56,7 +56,7 @@ octave-config endif -## Order matters here. Leave builtins.cc last, because it depends on +## Order matters here. Leave builtins.cc last, because it depends on ## $(DEF_FILES), and building those requires all the sources ## (except builtins.cc) to be available. BUILT_SOURCES = \ @@ -235,6 +235,7 @@ c-file-ptr-stream.h \ comment-list.h \ cutils.h \ + data.h \ debug.h \ defun-dld.h \ defun-int.h \ @@ -310,6 +311,7 @@ defaults.h \ graphics.h \ oct-conf.h \ + profiler.h \ mxarray.h \ version.h @@ -446,6 +448,7 @@ pager.cc \ pr-output.cc \ procstream.cc \ + profiler.cc \ sighandlers.cc \ siglist.c \ sparse.cc \ @@ -478,20 +481,15 @@ include TEMPLATE-INST/module.mk if AMCOND_ENABLE_DYNAMIC_LINKING - DLD_DYNAMIC_SRC = $(DLD_FUNCTIONS_SRC) - DLD_STATIC_SRC = OCT_FILES = $(DLD_FUNCTIONS_LIBS:.la=.oct) OCT_STAMP_FILES = $(subst DLD-FUNCTIONS/,DLD-FUNCTIONS/$(am__leading_dot),$(DLD_FUNCTIONS_LIBS:.la=.oct-stamp)) else - DLD_DYNAMIC_SRC = - DLD_STATIC_SRC = $(DLD_FUNCTIONS_SRC) OCT_FILES = OCT_STAMP_FILES = endif liboctinterp_la_SOURCES = \ $(DIST_SRC) \ - $(DLD_STATIC_SRC) \ $(OPERATORS_SRC) \ $(TEMPLATE_INST_SRC) @@ -506,87 +504,14 @@ version.h \ $(OPT_INC) +liboctinterp_la_CPPFLAGS = @OCTINTERP_DLL_DEFS@ $(AM_CPPFLAGS) -if AMCOND_ENABLE_DYNAMIC_LINKING - OCTAVE_LIBS = \ - ./liboctinterp.la \ - ../liboctave/liboctave.la \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la \ - $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) \ - $(QRUPDATE_LDFLAGS) $(QRUPDATE_LIBS) \ - $(FFTW_XLDFLAGS) $(FFTW_XLIBS) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(GRAPHICS_LDFLAGS) $(GRAPHICS_LIBS) \ - $(FT2_LDFLAGS) $(FT2_LIBS) \ - $(HDF5_LDFLAGS) $(HDF5_LIBS) $(Z_LDFLAGS) $(Z_LIBS) \ - $(OPENGL_LIBS) $(X11_LIBS) $(CARBON_LIBS) \ - $(READLINE_LIBS) $(TERM_LIBS) \ - $(LIBGLOB) \ - $(REGEX_LDFLAGS) $(REGEX_LIBS) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(DL_LIBS) $(PTHREAD_LIBS) \ - $(LIBS) \ - $(FLIBS) -else - ## FIXME -- this list is probably not complete now. It may not even - ## be possible to build a statically linked copy of Octave that is - ## fully functional. - OCTAVE_LIBS = \ - ./liboctinterp.la \ - ../liboctave/liboctave.la \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la \ - $(FFTW_XLDFLAGS) $(FFTW_XLIBS) \ - $(QHULL_LDFLAGS) $(QHULL_LIBS) \ - $(QRUPDATE_LDFLAGS) $(QRUPDATE_LIBS) \ - $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) \ - $(REGEX_LDFLAGS) $(REGEX_LIBS) \ - $(CURL_LDFLAGS) $(CURL_LIBS) \ - $(GLPK_LDFLAGS) $(GLPK_LIBS) \ - $(MAGICK_LDFLAGS) $(MAGICK_LIBS) \ - $(GRAPHICS_LDFLAGS) $(GRAPHICS_LIBS) \ - $(FT2_LDFLAGS) $(FT2_LIBS) \ - $(HDF5_LDFLAGS) $(HDF5_LIBS) $(Z_LDFLAGS) $(Z_LIBS) \ - $(OPENGL_LIBS) $(X11_LIBS) $(CARBON_LIBS) \ - $(READLINE_LIBS) $(TERM_LIBS) \ - $(LIBGLOB) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(DL_LIBS) $(PTHREAD_LIBS) \ - $(LIBS) \ - $(FLIBS) -endif +include link-deps.mk -OCTINTERP_LINK_DEPS = \ - $(RLD_FLAG) \ +liboctinterp_la_LIBADD = \ ../liboctave/liboctave.la \ ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la \ - $(FFTW_XLDFLAGS) $(FFTW_XLIBS) \ - $(FT2_LDFLAGS) $(FT2_LIBS) \ - $(HDF5_LDFLAGS) $(HDF5_LIBS) $(Z_LDFLAGS) $(Z_LIBS) \ - $(OPENGL_LIBS) $(X11_LIBS) $(CARBON_LIBS) \ - $(READLINE_LIBS) $(TERM_LIBS) \ - $(LIBGLOB) \ - $(LAPACK_LIBS) $(BLAS_LIBS) \ - $(LIBS) \ - $(FLIBS) - -liboctinterp_la_LIBADD = $(OCTINTERP_LINK_DEPS) - -## Additional library dependencies used by module.mk files -OCT_LINK_DEPS = \ - $(RLD_FLAG) $(LDFLAGS) \ - ./liboctinterp.la \ - ../liboctave/liboctave.la \ - ../libcruft/libcruft.la \ - ../libcruft/libranlib.la \ - ../libgnu/libgnu.la - -liboctinterp_la_CPPFLAGS = @OCTINTERP_DLL_DEFS@ $(AM_CPPFLAGS) + $(LIBOCTINTERP_LINK_DEPS) # Increment these as needed and according to the rules in the libtool manual: liboctinterp_current = 0 @@ -598,120 +523,39 @@ liboctinterp_la_LDFLAGS = \ -version-info $(liboctinterp_version_info) \ $(NO_UNDEFINED_LDFLAG) \ - -bindir $(bindir) + -bindir $(bindir) \ + $(LIBOCTINTERP_LINK_OPTS) display.df display.lo: CPPFLAGS += $(X11_FLAGS) -DLD-FUNCTIONS/__magick_read__.df: CPPFLAGS += $(MAGICK_CPPFLAGS) -DLD_FUNCTIONS___magick_read___la_CPPFLAGS = $(AM_CPPFLAGS) $(MAGICK_CPPFLAGS) -DLD_FUNCTIONS___magick_read___la_LIBADD += $(MAGICK_LDFLAGS) $(MAGICK_LIBS) - -DLD-FUNCTIONS/convhulln.df: CPPFLAGS += $(QHULL_CPPFLAGS) -DLD_FUNCTIONS_convhulln_la_CPPFLAGS = $(AM_CPPFLAGS) $(QHULL_CPPFLAGS) -DLD_FUNCTIONS_convhulln_la_LIBADD += $(QHULL_LDFLAGS) $(QHULL_LIBS) - -DLD-FUNCTIONS/__delaunayn__.df: CPPFLAGS += $(QHULL_CPPFLAGS) -DLD_FUNCTIONS___delaunayn___la_CPPFLAGS = $(AM_CPPFLAGS) $(QHULL_CPPFLAGS) -DLD_FUNCTIONS___delaunayn___la_LIBADD += $(QHULL_LDFLAGS) $(QHULL_LIBS) - -DLD-FUNCTIONS/__voronoi__.df: CPPFLAGS += $(QHULL_CPPFLAGS) -DLD_FUNCTIONS___voronoi___la_CPPFLAGS = $(AM_CPPFLAGS) $(QHULL_CPPFLAGS) -DLD_FUNCTIONS___voronoi___la_LIBADD += $(QHULL_LDFLAGS) $(QHULL_LIBS) - -DLD-FUNCTIONS/eigs.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_eigs_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_eigs_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) $(LAPACK_LIBS) $(BLAS_LIBS) - -#DLD-FUNCTIONS/qz.df DLD-FUNCTIONS/qz.lo: -DLD_FUNCTIONS_qz_la_LIBADD += $(LAPACK_LIBS) $(BLAS_LIBS) - -DLD-FUNCTIONS/qr.df: CPPFLAGS += $(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_qr_la_CPPFLAGS = $(AM_CPPFLAGS) $(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_qr_la_LIBADD += $(QRUPDATE_LDFLAGS) $(QRUPDATE_LIBS) $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/chol.df: CPPFLAGS += $(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_chol_la_CPPFLAGS = $(AM_CPPFLAGS) $(QRUPDATE_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_chol_la_LIBADD += $(QRUPDATE_LDFLAGS) $(QRUPDATE_LIBS) $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/regexp.df: CPPFLAGS += $(REGEX_CPPFLAGS) -DLD_FUNCTIONS_regexp_la_CPPFLAGS = $(AM_CPPFLAGS) $(REGEX_CPPFLAGS) -DLD_FUNCTIONS_regexp_la_LIBADD += $(REGEX_LDFLAGS) $(REGEX_LIBS) - -DLD-FUNCTIONS/urlwrite.df: CPPFLAGS += $(CURL_CPPFLAGS) -DLD_FUNCTIONS_urlwrite_la_CPPFLAGS = $(AM_CPPFLAGS) $(CURL_CPPFLAGS) -DLD_FUNCTIONS_urlwrite_la_LIBADD += $(CURL_LDFLAGS) $(CURL_LIBS) - -DLD-FUNCTIONS/__fltk_uigetfile__.df: CPPFLAGS += $(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS) -DLD_FUNCTIONS___fltk_uigetfile___la_CPPFLAGS = $(AM_CPPFLAGS) $(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS) -DLD_FUNCTIONS___fltk_uigetfile___la_LIBADD += $(GRAPHICS_LDFLAGS) $(GRAPHICS_LIBS) $(FT2_LDFLAGS) $(FT2_LIBS) - -DLD-FUNCTIONS/__glpk__.df: CPPFLAGS += $(GLPK_CPPFLAGS) -DLD_FUNCTIONS___glpk___la_CPPFLAGS = $(AM_CPPFLAGS) $(GLPK_CPPFLAGS) -DLD_FUNCTIONS___glpk___la_LIBADD += $(GLPK_LDFLAGS) $(GLPK_LIBS) - -DLD-FUNCTIONS/__init_fltk__.df: CPPFLAGS += $(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS) -DLD_FUNCTIONS___init_fltk___la_CPPFLAGS = $(AM_CPPFLAGS) $(GRAPHICS_CFLAGS) $(FT2_CPPFLAGS) -DLD_FUNCTIONS___init_fltk___la_LIBADD += $(GRAPHICS_LDFLAGS) $(GRAPHICS_LIBS) $(FT2_LDFLAGS) $(FT2_LIBS) - -DLD-FUNCTIONS/amd.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_amd_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_amd_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/colamd.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_colamd_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_colamd_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/ccolamd.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_ccolamd_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_ccolamd_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/symbfact.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_symbfact_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_symbfact_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/dmperm.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_dmperm_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_dmperm_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/symrcm.df: CPPFLAGS += $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_symrcm_la_CPPFLAGS = $(AM_CPPFLAGS) $(SPARSE_XCPPFLAGS) -DLD_FUNCTIONS_symrcm_la_LIBADD += $(SPARSE_XLDFLAGS) $(SPARSE_XLIBS) - -DLD-FUNCTIONS/fft.df: CPPFLAGS += $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fft_la_CPPFLAGS = $(AM_CPPFLAGS) $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fft_la_LIBADD += $(FFTW_XLDFLAGS) $(FFTW_XLIBS) - -DLD-FUNCTIONS/fft2.df: CPPFLAGS += $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fft2_la_CPPFLAGS = $(AM_CPPFLAGS) $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fft2_la_LIBADD += $(FFTW_XLDFLAGS) $(FFTW_XLIBS) - -DLD-FUNCTIONS/fftn.df: CPPFLAGS += $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fftn_la_CPPFLAGS = $(AM_CPPFLAGS) $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fftn_la_LIBADD += $(FFTW_XLDFLAGS) $(FFTW_XLIBS) - -DLD-FUNCTIONS/fftw.df: CPPFLAGS += $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fftw_la_CPPFLAGS = $(AM_CPPFLAGS) $(FFTW_XCPPFLAGS) -DLD_FUNCTIONS_fftw_la_LIBADD += $(FFTW_XLDFLAGS) $(FFTW_XLIBS) - - octave_SOURCES = main.c -octave_LDADD = $(OCTAVE_LIBS) +octave_LDADD = \ + liboctinterp.la \ + ../liboctave/liboctave.la \ + ../libcruft/libcruft.la \ + $(OCTAVE_LINK_DEPS) +octave_LDFLAGS = \ + $(NO_UNDEFINED_LDFLAG) \ + $(OCTAVE_LINK_OPTS) ## Section for defining and creating DEF_FILES SRC_DEF_FILES := $(shell $(srcdir)/find-defun-files.sh "$(srcdir)" $(DIST_SRC)) -DLD_STATIC_DEF_FILES = $(DLD_STATIC_SRC:.cc=.df) -DLD_DYNAMIC_DEF_FILES = $(DLD_DYNAMIC_SRC:.cc=.df) +DLD_FUNCTIONS_DEF_FILES = $(DLD_FUNCTIONS_SRC:.cc=.df) ## builtins.cc depends on $(DEF_FILES), so DEF_FILES should only include ## .df files that correspond to sources included in liboctave. -DEF_FILES = $(SRC_DEF_FILES) $(DLD_STATIC_DEF_FILES) +if AMCOND_ENABLE_DYNAMIC_LINKING + DEF_FILES = $(SRC_DEF_FILES) +else + DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) +endif -ALL_DEF_FILES = $(DEF_FILES) $(DLD_DYNAMIC_DEF_FILES) +ALL_DEF_FILES = $(SRC_DEF_FILES) $(DLD_FUNCTIONS_DEF_FILES) -$(DEF_FILES) $(DYNAMIC_DLD_DEF_FILES): mkdefs Makefile +$(SRC_DEF_FILES): mkdefs Makefile $(DEF_FILES): $(OPT_HANDLERS) $(OPT_INC) @@ -725,7 +569,7 @@ -DMAKE_BUILTINS $< | $(srcdir)/mkdefs $(srcdir) $< > $@-t mv $@-t $@ -## Special rules: +## Special rules: ## Mostly for sources which must be built before rest of compilation. ## defaults.h and oct-conf.h must depend on Makefile. Calling configure @@ -794,9 +638,13 @@ $(OPT_INC) : %.h : %.in $(MAKE) -C $(@D) $(@F) -DLD-FUNCTIONS/PKG_ADD: $(DLD_DYNAMIC_DEF_FILES) mk-pkg-add - $(srcdir)/mk-pkg-add $(DLD_DYNAMIC_DEF_FILES) > $@-t +if AMCOND_ENABLE_DYNAMIC_LINKING +DLD_FUNCTIONS_PKG_ADD_FILE = DLD-FUNCTIONS/PKG_ADD + +DLD-FUNCTIONS/PKG_ADD: $(DLD_FUNCTIONS_DEF_FILES) mk-pkg-add + $(srcdir)/mk-pkg-add $(DLD_FUNCTIONS_DEF_FILES) > $@-t mv $@-t $@ +endif lex.lo lex.o oct-parse.lo oct-parse.o: \ AM_CXXFLAGS := $(filter-out -Wold-style-cast, $(AM_CXXFLAGS)) @@ -828,8 +676,7 @@ gendoc$(BUILD_EXEEXT): gendoc.cc $(BUILD_CXX) $(BUILD_CXXFLAGS) -o $@ $^ $(BUILD_LDFLAGS) - -all-local: $(OCT_STAMP_FILES) DLD-FUNCTIONS/PKG_ADD .DOCSTRINGS +all-local: $(OCT_STAMP_FILES) $(DLD_FUNCTIONS_PKG_ADD_FILE) .DOCSTRINGS if AMCOND_BUILD_COMPILED_AUX_PROGRAMS octave-config.cc: octave-config.cc.in Makefile @@ -882,8 +729,8 @@ if AMCOND_ENABLE_DYNAMIC_LINKING install-oct: $(top_srcdir)/build-aux/mkinstalldirs $(DESTDIR)$(octfiledir) - if [ -n "`cat DLD-FUNCTIONS/PKG_ADD`" ]; then \ - $(INSTALL_DATA) DLD-FUNCTIONS/PKG_ADD $(DESTDIR)$(octfiledir)/PKG_ADD; \ + if [ -n "`cat $(DLD_FUNCTIONS_PKG_ADD_FILE)`" ]; then \ + $(INSTALL_DATA) $(DLD_FUNCTIONS_PKG_ADD_FILE) $(DESTDIR)$(octfiledir)/PKG_ADD; \ fi cd $(DESTDIR)$(octlibdir) && \ for ltlib in $(DLD_FUNCTIONS_LIBS); do \ @@ -911,7 +758,7 @@ CLEANFILES = \ $(bin_SCRIPTS) \ - DLD-FUNCTIONS/PKG_ADD \ + $(DLD_FUNCTIONS_PKG_ADD_FILE) \ doc-files \ gendoc.cc \ gendoc$(BUILD_EXEEXT) \
--- a/src/OPERATORS/op-cell.cc +++ b/src/OPERATORS/op-cell.cc @@ -51,36 +51,6 @@ DEFCATOP_FN (c_c, cell, cell, concat) -static octave_value -oct_catop_cell_matrix (octave_base_value& a1, const octave_base_value& a2, - const Array<octave_idx_type>&) -{ - octave_value retval; - CAST_BINOP_ARGS (const octave_cell&, const octave_matrix&); - NDArray tmp = v2.array_value (); - dim_vector dv = tmp.dims (); - if (dv.all_zero ()) - retval = octave_value (v1.cell_value ()); - else - error ("invalid concatenation of cell array with matrix"); - return retval; -} - -static octave_value -oct_catop_matrix_cell (octave_base_value& a1, const octave_base_value& a2, - const Array<octave_idx_type>&) -{ - octave_value retval; - CAST_BINOP_ARGS (const octave_matrix&, const octave_cell&); - NDArray tmp = v1.array_value (); - dim_vector dv = tmp.dims (); - if (dv.all_zero ()) - retval = octave_value (v2.cell_value ()); - else - error ("invalid concatenation of cell array with matrix"); - return retval; -} - DEFASSIGNANYOP_FN (assign, cell, assign); DEFNULLASSIGNOP_FN (null_assign, cell, delete_elements) @@ -93,9 +63,6 @@ INSTALL_CATOP (octave_cell, octave_cell, c_c); - INSTALL_CATOP (octave_cell, octave_matrix, cell_matrix); - INSTALL_CATOP (octave_matrix, octave_cell, matrix_cell); - INSTALL_ASSIGNANYOP (op_asn_eq, octave_cell, assign); INSTALL_ASSIGNOP (op_asn_eq, octave_cell, octave_null_matrix, null_assign);
--- a/src/OPERATORS/op-int.h +++ b/src/OPERATORS/op-int.h @@ -21,6 +21,7 @@ */ #include "quit.h" +#include "bsxfun.h" #define DEFINTBINOP_OP(name, t1, t2, op, t3) \ BINOPDECL (name, a1, a2) \ @@ -703,8 +704,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun (a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T1 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \ @@ -722,8 +730,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun (a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T1 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \ @@ -741,8 +756,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun (a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T2 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \ @@ -760,8 +782,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun (a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T1 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \ @@ -779,8 +808,15 @@ dim_vector b_dims = b.dims (); \ if (a_dims != b_dims) \ { \ - gripe_nonconformant ("operator .^", a_dims, b_dims); \ - return octave_value (); \ + if (is_valid_bsxfun (a_dims, b_dims)) \ + { \ + return bsxfun_pow (a, b); \ + } \ + else \ + { \ + gripe_nonconformant ("operator .^", a_dims, b_dims); \ + return octave_value (); \ + } \ } \ T2 ## NDArray result (a_dims); \ for (int i = 0; i < a.length (); i++) \
--- a/src/OPERATORS/op-pm-sm.cc +++ b/src/OPERATORS/op-pm-sm.cc @@ -32,6 +32,49 @@ #include "ov-perm.h" #include "ov-re-sparse.h" +#include "ov-bool-sparse.h" + +// Unary permutation ops, some cast to sparse + +//Avoid casting to a full matrix +DEFUNOP_OP (uplus, perm_matrix, /* no-op */) + +// Not calling standard CAST_UNOP_ARG for these next two because a +// dynamic_cast would fail. +DEFUNOP (not, perm_matrix) +{ + // Obviously negation of a permutation matrix destroys sparsity + return octave_value ( ! a.bool_array_value ()); +} + +DEFUNOP (uminus, perm_matrix) +{ + return octave_value ( - a.sparse_matrix_value ()); +} + +// Most other logical operations cast to SparseBoolMatrix +DEFBINOP (eq_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return v1.sparse_bool_matrix_value () == v2.sparse_bool_matrix_value (); +} +DEFBINOP (ne_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return v1.sparse_bool_matrix_value () != v2.sparse_bool_matrix_value (); +} +DEFBINOP (el_and_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return mx_el_and(v1.sparse_bool_matrix_value (), + v2.sparse_bool_matrix_value ()); +} +DEFBINOP (el_or_pm, perm_matrix, perm_matrix) +{ + CAST_BINOP_ARGS (const octave_perm_matrix&, const octave_perm_matrix&); + return mx_el_or(v1.sparse_bool_matrix_value (), + v2.sparse_bool_matrix_value ()); +} // permutation matrix by sparse matrix ops @@ -86,6 +129,11 @@ void install_pm_sm_ops (void) { + INSTALL_UNOP (op_not, octave_perm_matrix, not); + INSTALL_UNOP (op_uplus, octave_perm_matrix, uplus); + INSTALL_UNOP (op_uminus, octave_perm_matrix, uminus); + + INSTALL_BINOP (op_mul, octave_perm_matrix, octave_sparse_matrix, mul_pm_sm); INSTALL_BINOP (op_ldiv, octave_perm_matrix, octave_sparse_matrix, @@ -94,4 +142,9 @@ mul_sm_pm); INSTALL_BINOP (op_div, octave_sparse_matrix, octave_perm_matrix, div_sm_pm); + + INSTALL_BINOP (op_eq, octave_perm_matrix, octave_perm_matrix, eq_pm); + INSTALL_BINOP (op_ne, octave_perm_matrix, octave_perm_matrix, ne_pm); + INSTALL_BINOP (op_el_and, octave_perm_matrix, octave_perm_matrix, el_and_pm); + INSTALL_BINOP (op_el_or, octave_perm_matrix, octave_perm_matrix, el_or_pm); }
--- a/src/data.cc +++ b/src/data.cc @@ -53,6 +53,7 @@ #include "oct-map.h" #include "oct-obj.h" #include "ov.h" +#include "ov-class.h" #include "ov-float.h" #include "ov-complex.h" #include "ov-flt-complex.h" @@ -588,7 +589,7 @@ { FloatNDArray a0 = args(0).float_array_value (); FloatNDArray a1 = args(1).float_array_value (); - retval = binmap<float> (a0, a1, xrem, "rem"); + retval = binmap<float> (a0, a1, xrem<float>, "rem"); } } else @@ -602,13 +603,13 @@ { SparseMatrix m0 = args(0).sparse_matrix_value (); SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap<double> (m0, m1, xrem, "rem"); + retval = binmap<double> (m0, m1, xrem<double>, "rem"); } else { NDArray a0 = args(0).array_value (); NDArray a1 = args(1).array_value (); - retval = binmap<double> (a0, a1, xrem, "rem"); + retval = binmap<double> (a0, a1, xrem<double>, "rem"); } } } @@ -721,7 +722,7 @@ { FloatNDArray a0 = args(0).float_array_value (); FloatNDArray a1 = args(1).float_array_value (); - retval = binmap<float> (a0, a1, xmod, "mod"); + retval = binmap<float> (a0, a1, xmod<float>, "mod"); } } else @@ -735,13 +736,13 @@ { SparseMatrix m0 = args(0).sparse_matrix_value (); SparseMatrix m1 = args(1).sparse_matrix_value (); - retval = binmap<double> (m0, m1, xmod, "mod"); + retval = binmap<double> (m0, m1, xmod<double>, "mod"); } else { NDArray a0 = args(0).array_value (); NDArray a1 = args(1).array_value (); - retval = binmap<double> (a0, a1, xmod, "mod"); + retval = binmap<double> (a0, a1, xmod<double>, "mod"); } } } @@ -1527,10 +1528,136 @@ } static octave_value -do_cat (const octave_value_list& args, int dim, std::string fname) +attempt_type_conversion (const octave_value& ov, std::string dtype) +{ + octave_value retval; + + // First try to find function in the class of OV that can convert to + // the dispatch type dtype. It will have the name of the dispatch + // type. + + std::string cname = ov.class_name (); + + octave_value fcn = symbol_table::find_method (dtype, cname); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("conversion from %s to %s failed", dtype.c_str (), + cname.c_str ()); + } + else + { + // No conversion function available. Try the constructor for the + // dispatch type. + + fcn = symbol_table::find_method (dtype, dtype); + + if (fcn.is_defined ()) + { + octave_value_list result + = fcn.do_multi_index_op (1, octave_value_list (1, ov)); + + if (! error_state && result.length () > 0) + retval = result(0); + else + error ("%s constructor failed for %s argument", dtype.c_str (), + cname.c_str ()); + } + else + error ("no constructor for %s!", dtype.c_str ()); + } + + return retval; +} + +octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim) { octave_value retval; + // Get dominant type for list + + std::string dtype = get_dispatch_type (ovl); + + octave_value fcn = symbol_table::find_method (cattype, dtype); + + if (fcn.is_defined ()) + { + // Have method for dominant type, so call it and let it handle + // conversions. + + octave_value_list tmp2 = fcn.do_multi_index_op (1, ovl); + + if (! error_state) + { + if (tmp2.length () > 0) + retval = tmp2(0); + else + { + error ("%s/%s method did not return a value", + dtype.c_str (), cattype.c_str ()); + goto done; + } + } + else + goto done; + } + else + { + // No method for dominant type, so attempt type conversions for + // all elements that are not of the dominant type, then do the + // default operation for octave_class values. + + octave_idx_type j = 0; + octave_idx_type len = ovl.length (); + octave_value_list tmp (len, octave_value ()); + for (octave_idx_type k = 0; k < len; k++) + { + octave_value elt = ovl(k); + + std::string t1_type = elt.class_name (); + + if (t1_type == dtype) + tmp(j++) = elt; + else if (elt.is_object () || ! elt.is_empty ()) + { + tmp(j++) = attempt_type_conversion (elt, dtype); + + if (error_state) + goto done; + } + } + + tmp.resize (j); + + octave_map m = do_single_type_concat_map (tmp, dim); + + std::string cname = tmp(0).class_name (); + std::list<std::string> parents = tmp(0).parent_class_name_list (); + + retval = octave_value (new octave_class (m, cname, parents)); + } + + done: + return retval; +} + +static octave_value +do_cat (const octave_value_list& xargs, int dim, std::string fname) +{ + octave_value retval; + + // We may need to convert elements of the list to cells, so make a + // copy. This should be efficient, it is done mostly by incrementing + // reference counts. + octave_value_list args = xargs; + int n_args = args.length (); if (n_args == 0) @@ -1539,18 +1666,28 @@ retval = args(0); else if (n_args > 1) { - - std::string result_type = args(0).class_name (); - - bool all_sq_strings_p = args(0).is_sq_string (); - bool all_dq_strings_p = args(0).is_dq_string (); - bool all_real_p = args(0).is_real_type (); - bool any_sparse_p = args(0).is_sparse_type(); - - for (int i = 1; i < args.length (); i++) + std::string result_type; + + bool all_sq_strings_p = true; + bool all_dq_strings_p = true; + bool all_real_p = true; + bool all_cmplx_p = true; + bool any_sparse_p = false; + bool any_cell_p = false; + bool any_class_p = false; + + bool first_elem_is_struct = false; + + for (int i = 0; i < n_args; i++) { - result_type = - get_concat_class (result_type, args(i).class_name ()); + if (i == 0) + { + result_type = args(i).class_name (); + + first_elem_is_struct = args(i).is_map (); + } + else + result_type = get_concat_class (result_type, args(i).class_name ()); if (all_sq_strings_p && ! args(i).is_sq_string ()) all_sq_strings_p = false; @@ -1558,11 +1695,30 @@ all_dq_strings_p = false; if (all_real_p && ! args(i).is_real_type ()) all_real_p = false; + if (all_cmplx_p && ! (args(i).is_complex_type () || args(i).is_real_type ())) + all_cmplx_p = false; if (!any_sparse_p && args(i).is_sparse_type ()) any_sparse_p = true; + if (!any_cell_p && args(i).is_cell ()) + any_cell_p = true; + if (!any_class_p && args(i).is_object ()) + any_class_p = true; } - if (result_type == "double") + if (any_cell_p && ! any_class_p && ! first_elem_is_struct) + { + for (int i = 0; i < n_args; i++) + { + if (! args(i).is_cell ()) + args(i) = Cell (args(i)); + } + } + + if (any_class_p) + { + retval = do_class_concat (args, fname, dim); + } + else if (result_type == "double") { if (any_sparse_p) { @@ -1718,6 +1874,197 @@ return do_cat (args, -2, "horzcat"); } +/* +%% test concatenation with all zero matrices +%!assert(horzcat ('', 65*ones(1,10)), 'AAAAAAAAAA'); +%!assert(horzcat (65*ones(1,10), ''), 'AAAAAAAAAA'); + +%!assert (class (horzcat (int64(1), int64(1))), 'int64') +%!assert (class (horzcat (int64(1), int32(1))), 'int64') +%!assert (class (horzcat (int64(1), int16(1))), 'int64') +%!assert (class (horzcat (int64(1), int8(1))), 'int64') +%!assert (class (horzcat (int64(1), uint64(1))), 'int64') +%!assert (class (horzcat (int64(1), uint32(1))), 'int64') +%!assert (class (horzcat (int64(1), uint16(1))), 'int64') +%!assert (class (horzcat (int64(1), uint8(1))), 'int64') +%!assert (class (horzcat (int64(1), single(1))), 'int64') +%!assert (class (horzcat (int64(1), double(1))), 'int64') +%!assert (class (horzcat (int64(1), cell(1))), 'cell') +%!assert (class (horzcat (int64(1), true)), 'int64') +%!assert (class (horzcat (int64(1), 'a')), 'char') + +%!assert (class (horzcat (int32(1), int64(1))), 'int32') +%!assert (class (horzcat (int32(1), int32(1))), 'int32') +%!assert (class (horzcat (int32(1), int16(1))), 'int32') +%!assert (class (horzcat (int32(1), int8(1))), 'int32') +%!assert (class (horzcat (int32(1), uint64(1))), 'int32') +%!assert (class (horzcat (int32(1), uint32(1))), 'int32') +%!assert (class (horzcat (int32(1), uint16(1))), 'int32') +%!assert (class (horzcat (int32(1), uint8(1))), 'int32') +%!assert (class (horzcat (int32(1), single(1))), 'int32') +%!assert (class (horzcat (int32(1), double(1))), 'int32') +%!assert (class (horzcat (int32(1), cell(1))), 'cell') +%!assert (class (horzcat (int32(1), true)), 'int32') +%!assert (class (horzcat (int32(1), 'a')), 'char') + +%!assert (class (horzcat (int16(1), int64(1))), 'int16') +%!assert (class (horzcat (int16(1), int32(1))), 'int16') +%!assert (class (horzcat (int16(1), int16(1))), 'int16') +%!assert (class (horzcat (int16(1), int8(1))), 'int16') +%!assert (class (horzcat (int16(1), uint64(1))), 'int16') +%!assert (class (horzcat (int16(1), uint32(1))), 'int16') +%!assert (class (horzcat (int16(1), uint16(1))), 'int16') +%!assert (class (horzcat (int16(1), uint8(1))), 'int16') +%!assert (class (horzcat (int16(1), single(1))), 'int16') +%!assert (class (horzcat (int16(1), double(1))), 'int16') +%!assert (class (horzcat (int16(1), cell(1))), 'cell') +%!assert (class (horzcat (int16(1), true)), 'int16') +%!assert (class (horzcat (int16(1), 'a')), 'char') + +%!assert (class (horzcat (int8(1), int64(1))), 'int8') +%!assert (class (horzcat (int8(1), int32(1))), 'int8') +%!assert (class (horzcat (int8(1), int16(1))), 'int8') +%!assert (class (horzcat (int8(1), int8(1))), 'int8') +%!assert (class (horzcat (int8(1), uint64(1))), 'int8') +%!assert (class (horzcat (int8(1), uint32(1))), 'int8') +%!assert (class (horzcat (int8(1), uint16(1))), 'int8') +%!assert (class (horzcat (int8(1), uint8(1))), 'int8') +%!assert (class (horzcat (int8(1), single(1))), 'int8') +%!assert (class (horzcat (int8(1), double(1))), 'int8') +%!assert (class (horzcat (int8(1), cell(1))), 'cell') +%!assert (class (horzcat (int8(1), true)), 'int8') +%!assert (class (horzcat (int8(1), 'a')), 'char') + +%!assert (class (horzcat (uint64(1), int64(1))), 'uint64') +%!assert (class (horzcat (uint64(1), int32(1))), 'uint64') +%!assert (class (horzcat (uint64(1), int16(1))), 'uint64') +%!assert (class (horzcat (uint64(1), int8(1))), 'uint64') +%!assert (class (horzcat (uint64(1), uint64(1))), 'uint64') +%!assert (class (horzcat (uint64(1), uint32(1))), 'uint64') +%!assert (class (horzcat (uint64(1), uint16(1))), 'uint64') +%!assert (class (horzcat (uint64(1), uint8(1))), 'uint64') +%!assert (class (horzcat (uint64(1), single(1))), 'uint64') +%!assert (class (horzcat (uint64(1), double(1))), 'uint64') +%!assert (class (horzcat (uint64(1), cell(1))), 'cell') +%!assert (class (horzcat (uint64(1), true)), 'uint64') +%!assert (class (horzcat (uint64(1), 'a')), 'char') + +%!assert (class (horzcat (uint32(1), int64(1))), 'uint32') +%!assert (class (horzcat (uint32(1), int32(1))), 'uint32') +%!assert (class (horzcat (uint32(1), int16(1))), 'uint32') +%!assert (class (horzcat (uint32(1), int8(1))), 'uint32') +%!assert (class (horzcat (uint32(1), uint64(1))), 'uint32') +%!assert (class (horzcat (uint32(1), uint32(1))), 'uint32') +%!assert (class (horzcat (uint32(1), uint16(1))), 'uint32') +%!assert (class (horzcat (uint32(1), uint8(1))), 'uint32') +%!assert (class (horzcat (uint32(1), single(1))), 'uint32') +%!assert (class (horzcat (uint32(1), double(1))), 'uint32') +%!assert (class (horzcat (uint32(1), cell(1))), 'cell') +%!assert (class (horzcat (uint32(1), true)), 'uint32') +%!assert (class (horzcat (uint32(1), 'a')), 'char') + +%!assert (class (horzcat (uint16(1), int64(1))), 'uint16') +%!assert (class (horzcat (uint16(1), int32(1))), 'uint16') +%!assert (class (horzcat (uint16(1), int16(1))), 'uint16') +%!assert (class (horzcat (uint16(1), int8(1))), 'uint16') +%!assert (class (horzcat (uint16(1), uint64(1))), 'uint16') +%!assert (class (horzcat (uint16(1), uint32(1))), 'uint16') +%!assert (class (horzcat (uint16(1), uint16(1))), 'uint16') +%!assert (class (horzcat (uint16(1), uint8(1))), 'uint16') +%!assert (class (horzcat (uint16(1), single(1))), 'uint16') +%!assert (class (horzcat (uint16(1), double(1))), 'uint16') +%!assert (class (horzcat (uint16(1), cell(1))), 'cell') +%!assert (class (horzcat (uint16(1), true)), 'uint16') +%!assert (class (horzcat (uint16(1), 'a')), 'char') + +%!assert (class (horzcat (uint8(1), int64(1))), 'uint8') +%!assert (class (horzcat (uint8(1), int32(1))), 'uint8') +%!assert (class (horzcat (uint8(1), int16(1))), 'uint8') +%!assert (class (horzcat (uint8(1), int8(1))), 'uint8') +%!assert (class (horzcat (uint8(1), uint64(1))), 'uint8') +%!assert (class (horzcat (uint8(1), uint32(1))), 'uint8') +%!assert (class (horzcat (uint8(1), uint16(1))), 'uint8') +%!assert (class (horzcat (uint8(1), uint8(1))), 'uint8') +%!assert (class (horzcat (uint8(1), single(1))), 'uint8') +%!assert (class (horzcat (uint8(1), double(1))), 'uint8') +%!assert (class (horzcat (uint8(1), cell(1))), 'cell') +%!assert (class (horzcat (uint8(1), true)), 'uint8') +%!assert (class (horzcat (uint8(1), 'a')), 'char') + +%!assert (class (horzcat (single(1), int64(1))), 'int64') +%!assert (class (horzcat (single(1), int32(1))), 'int32') +%!assert (class (horzcat (single(1), int16(1))), 'int16') +%!assert (class (horzcat (single(1), int8(1))), 'int8') +%!assert (class (horzcat (single(1), uint64(1))), 'uint64') +%!assert (class (horzcat (single(1), uint32(1))), 'uint32') +%!assert (class (horzcat (single(1), uint16(1))), 'uint16') +%!assert (class (horzcat (single(1), uint8(1))), 'uint8') +%!assert (class (horzcat (single(1), single(1))), 'single') +%!assert (class (horzcat (single(1), double(1))), 'single') +%!assert (class (horzcat (single(1), cell(1))), 'cell') +%!assert (class (horzcat (single(1), true)), 'single') +%!assert (class (horzcat (single(1), 'a')), 'char') + +%!assert (class (horzcat (double(1), int64(1))), 'int64') +%!assert (class (horzcat (double(1), int32(1))), 'int32') +%!assert (class (horzcat (double(1), int16(1))), 'int16') +%!assert (class (horzcat (double(1), int8(1))), 'int8') +%!assert (class (horzcat (double(1), uint64(1))), 'uint64') +%!assert (class (horzcat (double(1), uint32(1))), 'uint32') +%!assert (class (horzcat (double(1), uint16(1))), 'uint16') +%!assert (class (horzcat (double(1), uint8(1))), 'uint8') +%!assert (class (horzcat (double(1), single(1))), 'single') +%!assert (class (horzcat (double(1), double(1))), 'double') +%!assert (class (horzcat (double(1), cell(1))), 'cell') +%!assert (class (horzcat (double(1), true)), 'double') +%!assert (class (horzcat (double(1), 'a')), 'char') + +%!assert (class (horzcat (cell(1), int64(1))), 'cell') +%!assert (class (horzcat (cell(1), int32(1))), 'cell') +%!assert (class (horzcat (cell(1), int16(1))), 'cell') +%!assert (class (horzcat (cell(1), int8(1))), 'cell') +%!assert (class (horzcat (cell(1), uint64(1))), 'cell') +%!assert (class (horzcat (cell(1), uint32(1))), 'cell') +%!assert (class (horzcat (cell(1), uint16(1))), 'cell') +%!assert (class (horzcat (cell(1), uint8(1))), 'cell') +%!assert (class (horzcat (cell(1), single(1))), 'cell') +%!assert (class (horzcat (cell(1), double(1))), 'cell') +%!assert (class (horzcat (cell(1), cell(1))), 'cell') +%!assert (class (horzcat (cell(1), true)), 'cell') +%!assert (class (horzcat (cell(1), 'a')), 'cell') + +%!assert (class (horzcat (true, int64(1))), 'int64') +%!assert (class (horzcat (true, int32(1))), 'int32') +%!assert (class (horzcat (true, int16(1))), 'int16') +%!assert (class (horzcat (true, int8(1))), 'int8') +%!assert (class (horzcat (true, uint64(1))), 'uint64') +%!assert (class (horzcat (true, uint32(1))), 'uint32') +%!assert (class (horzcat (true, uint16(1))), 'uint16') +%!assert (class (horzcat (true, uint8(1))), 'uint8') +%!assert (class (horzcat (true, single(1))), 'single') +%!assert (class (horzcat (true, double(1))), 'double') +%!assert (class (horzcat (true, cell(1))), 'cell') +%!assert (class (horzcat (true, true)), 'logical') +%!assert (class (horzcat (true, 'a')), 'char') + +%!assert (class (horzcat ('a', int64(1))), 'char') +%!assert (class (horzcat ('a', int32(1))), 'char') +%!assert (class (horzcat ('a', int16(1))), 'char') +%!assert (class (horzcat ('a', int8(1))), 'char') +%!assert (class (horzcat ('a', int64(1))), 'char') +%!assert (class (horzcat ('a', int32(1))), 'char') +%!assert (class (horzcat ('a', int16(1))), 'char') +%!assert (class (horzcat ('a', int8(1))), 'char') +%!assert (class (horzcat ('a', single(1))), 'char') +%!assert (class (horzcat ('a', double(1))), 'char') +%!assert (class (horzcat ('a', cell(1))), 'cell') +%!assert (class (horzcat ('a', true)), 'char') +%!assert (class (horzcat ('a', 'a')), 'char') + +%!assert (class (horzcat (cell(1), struct('foo', 'bar'))), 'cell') +%!error horzcat (struct('foo', 'bar'), cell(1)); +*/ + DEFUN (vertcat, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} vertcat (@var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ @@ -1736,6 +2083,12 @@ return do_cat (args, -1, "vertcat"); } +/* +%!test +%! c = {'foo'; 'bar'; 'bazoloa'}; +%! assert (vertcat (c, 'a', 'bc', 'def'), {'foo'; 'bar'; 'bazoloa'; 'a'; 'bc'; 'def'}); +*/ + DEFUN (cat, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} cat (@var{dim}, @var{array1}, @var{array2}, @dots{}, @var{arrayN})\n\ @@ -1943,6 +2296,9 @@ %!error <dimension mismatch> cat (3, cat (3, [], []), [1,2;3,4]); %!error <dimension mismatch> cat (3, zeros (0, 0, 2), [1,2;3,4]); +%!assert ([zeros(3,2,2); ones(1,2,2)], repmat([0;0;0;1],[1,2,2]) ); +%!assert ([zeros(3,2,2); ones(1,2,2)], vertcat(zeros(3,2,2), ones(1,2,2)) ); + */ static octave_value @@ -4194,8 +4550,8 @@ @end example\n\ \n\ Calling @code{eye} with no arguments is equivalent to calling it\n\ -with an argument of 1. This odd definition is for compatibility\n\ -with @sc{matlab}.\n\ +with an argument of 1. Any negative dimensions are treated as zero. \n\ +These odd definitions are for compatibility with @sc{matlab}.\n\ @seealso{speye}\n\ @end deftypefn") { @@ -4932,7 +5288,7 @@ DEFUN (uplus, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} uplus (@var{x})\n\ -This function is equivalent to @w{@code{+ x}}.\n\ +This function and @w{@xcode{+ x}} are equivalent.\n\ @end deftypefn") { return unary_op_defun_body (octave_value::op_uplus, args); @@ -4941,7 +5297,7 @@ DEFUN (uminus, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} uminus (@var{x})\n\ -This function is equivalent to @w{@code{- x}}.\n\ +This function and @w{@xcode{- x}} are equivalent.\n\ @end deftypefn") { return unary_op_defun_body (octave_value::op_uminus, args); @@ -4950,7 +5306,8 @@ DEFUN (transpose, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} transpose (@var{x})\n\ -Return the transpose of @var{x}. This function is equivalent to @code{x.'}.\n\ +Return the transpose of @var{x}.\n\ +This function and @xcode{x.'} are equivalent.\n\ @seealso{ctranspose}\n\ @end deftypefn") { @@ -4982,8 +5339,8 @@ DEFUN (ctranspose, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} ctranspose (@var{x})\n\ -Return the complex conjugate transpose of @var{x}. This function is\n\ -equivalent to @code{x'}.\n\ +Return the complex conjugate transpose of @var{x}.\n\ +This function and @xcode{x'} are equivalent.\n\ @seealso{transpose}\n\ @end deftypefn") { @@ -5059,7 +5416,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} plus (@var{x}, @var{y})\n\ @deftypefnx {Built-in Function} {} plus (@var{x1}, @var{x2}, @dots{})\n\ -This function is equivalent to @w{@code{x + y}}.\n\ +This function and @w{@xcode{x + y}} are equivalent.\n\ If more arguments are given, the summation is applied\n\ cumulatively from left to right:\n\ \n\ @@ -5078,7 +5435,7 @@ DEFUN (minus, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} minus (@var{x}, @var{y})\n\ -This function is equivalent to @w{@code{x - y}}.\n\ +This function and @w{@xcode{x - y}} are equivalent.\n\ @seealso{plus}\n\ @end deftypefn") { @@ -5090,7 +5447,7 @@ @deftypefn {Built-in Function} {} mtimes (@var{x}, @var{y})\n\ @deftypefnx {Built-in Function} {} mtimes (@var{x1}, @var{x2}, @dots{})\n\ Return the matrix multiplication product of inputs.\n\ -This function is equivalent to @w{@code{x * y}}.\n\ +This function and @w{@xcode{x * y}} are equivalent.\n\ If more arguments are given, the multiplication is applied\n\ cumulatively from left to right:\n\ \n\ @@ -5110,7 +5467,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} mrdivide (@var{x}, @var{y})\n\ Return the matrix right division of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x / y}}.\n\ +This function and @w{@xcode{x / y}} are equivalent.\n\ @seealso{mldivide, rdivide}\n\ @end deftypefn") { @@ -5121,7 +5478,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} mpower (@var{x}, @var{y})\n\ Return the matrix power operation of @var{x} raised to the @var{y} power.\n\ -This function is equivalent to @w{@code{x ^ y}}.\n\ +This function and @w{@xcode{x ^ y}} are equivalent.\n\ @seealso{power}\n\ @end deftypefn") { @@ -5132,7 +5489,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} mldivide (@var{x}, @var{y})\n\ Return the matrix left division of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x \\ y}}.\n\ +This function and @w{@xcode{x \\ y}} are equivalent.\n\ @seealso{mrdivide, ldivide}\n\ @end deftypefn") { @@ -5202,7 +5559,7 @@ @deftypefn {Built-in Function} {} times (@var{x}, @var{y})\n\ @deftypefnx {Built-in Function} {} times (@var{x1}, @var{x2}, @dots{})\n\ Return the element-by-element multiplication product of inputs.\n\ -This function is equivalent to @w{@code{x .* y}}.\n\ +This function and @w{@xcode{x .* y}} are equivalent.\n\ If more arguments are given, the multiplication is applied\n\ cumulatively from left to right:\n\ \n\ @@ -5222,7 +5579,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} rdivide (@var{x}, @var{y})\n\ Return the element-by-element right division of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x ./ y}}.\n\ +This function and @w{@xcode{x ./ y}} are equivalent.\n\ @seealso{ldivide, mrdivide}\n\ @end deftypefn") { @@ -5234,7 +5591,7 @@ @deftypefn {Built-in Function} {} power (@var{x}, @var{y})\n\ Return the element-by-element operation of @var{x} raised to the\n\ @var{y} power.\n\ -This function is equivalent to @w{@code{x .^ y}}.\n\ +This function and @w{@xcode{x .^ y}} are equivalent.\n\ @seealso{mpower}\n\ @end deftypefn") { @@ -5245,7 +5602,7 @@ "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} ldivide (@var{x}, @var{y})\n\ Return the element-by-element left division of @var{x} and @var{y}.\n\ -This function is equivalent to @w{@code{x .\\ y}}.\n\ +This function and @w{@xcode{x .\\ y}} are equivalent.\n\ @seealso{rdivide, mldivide}\n\ @end deftypefn") {
new file mode 100644 --- /dev/null +++ b/src/data.h @@ -0,0 +1,34 @@ +/* + +Copyright (C) 2011 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 +<http://www.gnu.org/licenses/>. + +*/ + +#if !defined (octave_data_h) +#define octave_data_h 1 + +#include <string> + +class octave_value; +class octave_value_list; + +extern OCTINTERP_API octave_value +do_class_concat (const octave_value_list& ovl, std::string cattype, int dim); + +#endif
--- a/src/debug.cc +++ b/src/debug.cc @@ -835,13 +835,8 @@ return retval; } -DEFUN (dbstack, args, nargout, - "-*- texinfo -*-\n\ -@deftypefn {Loadable Function} {[@var{stack}, @var{idx}]} dbstack (@var{n})\n\ -Print or return current stack information. With optional argument\n\ -@var{n}, omit the @var{n} innermost stack frames.\n\ -@seealso{dbclear, dbstatus, dbstop}\n\ -@end deftypefn") +static octave_value_list +do_dbstack (const octave_value_list& args, int nargout, std::ostream& os) { octave_value_list retval; @@ -882,7 +877,7 @@ if (nframes_to_display > 0) { - octave_stdout << "stopped in:\n\n"; + os << "stopped in:\n\n"; Cell names = stk.contents ("name"); Cell files = stk.contents ("file"); @@ -908,15 +903,15 @@ if (show_top_level && i == curr_frame) show_top_level = false; - octave_stdout << (i == curr_frame ? " --> " : " ") - << std::setw (max_name_len) << name - << " at line " << line - << " [" << file << "]" - << std::endl; + os << (i == curr_frame ? " --> " : " ") + << std::setw (max_name_len) << name + << " at line " << line + << " [" << file << "]" + << std::endl; } if (show_top_level) - octave_stdout << " --> top level" << std::endl; + os << " --> top level" << std::endl; } } else @@ -929,6 +924,28 @@ return retval; } +// A function that can be easily called from a debugger print the Octave +// stack. This can be useful for finding what line of code the +// interpreter is currently executing when the debugger is stopped in +// some C++ function, for example. + +void +show_octave_dbstack (void) +{ + do_dbstack (octave_value_list (), 0, std::cerr); +} + +DEFUN (dbstack, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Loadable Function} {[@var{stack}, @var{idx}]} dbstack (@var{n})\n\ +Print or return current stack information. With optional argument\n\ +@var{n}, omit the @var{n} innermost stack frames.\n\ +@seealso{dbclear, dbstatus, dbstop}\n\ +@end deftypefn") +{ + return do_dbstack (args, nargout, octave_stdout); +} + static void do_dbupdown (const octave_value_list& args, const std::string& who) {
--- a/src/defaults.cc +++ b/src/defaults.cc @@ -419,6 +419,17 @@ return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (EDITOR); } +/* +%!error (EDITOR (1, 2)); +%!test +%! orig_val = EDITOR (); +%! old_val = EDITOR ("X"); +%! assert (orig_val, old_val); +%! assert (EDITOR (), "X"); +%! EDITOR (orig_val); +%! assert (EDITOR (), orig_val); +*/ + DEFUN (EXEC_PATH, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} EXEC_PATH ()\n\ @@ -438,6 +449,17 @@ return retval; } +/* +%!error (EXEC_PATH (1, 2)); +%!test +%! orig_val = EXEC_PATH (); +%! old_val = EXEC_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (EXEC_PATH (), "X"); +%! EXEC_PATH (orig_val); +%! assert (EXEC_PATH (), orig_val); +*/ + DEFUN (IMAGE_PATH, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} IMAGE_PATH ()\n\ @@ -449,6 +471,17 @@ return SET_NONEMPTY_INTERNAL_STRING_VARIABLE (IMAGE_PATH); } +/* +%!error (IMAGE_PATH (1, 2)); +%!test +%! orig_val = IMAGE_PATH (); +%! old_val = IMAGE_PATH ("X"); +%! assert (orig_val, old_val); +%! assert (IMAGE_PATH (), "X"); +%! IMAGE_PATH (orig_val); +%! assert (IMAGE_PATH (), orig_val); +*/ + DEFUN (OCTAVE_HOME, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} OCTAVE_HOME ()\n\ @@ -465,6 +498,11 @@ return retval; } +/* +%!error OCTAVE_HOME (1); +%!assert (ischar (OCTAVE_HOME ())); +*/ + DEFUNX ("OCTAVE_VERSION", FOCTAVE_VERSION, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} OCTAVE_VERSION ()\n\ @@ -482,3 +520,8 @@ return retval; } + +/* +%!error OCTAVE_VERSION (1); +%!assert (ischar (OCTAVE_VERSION ())); +*/
--- a/src/error.cc +++ b/src/error.cc @@ -1062,10 +1062,18 @@ } else if (nargin == 1 && args(0).is_map ()) { + // empty struct is not an error. return and resume calling function. + if (args(0).is_empty ()) + return retval; + octave_value_list tmp; octave_scalar_map m = args(0).scalar_map_value (); + // empty struct is not an error. return and resume calling function. + if (m.nfields () == 0) + return retval; + if (m.contains ("message")) { octave_value c = m.getfield ("message"); @@ -1684,10 +1692,6 @@ return retval; } -// For backward compatibility. -DEFALIAS (error_text, lasterr); -DEFALIAS (__error_text__, lasterr); - DEFUN (lastwarn, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} lastwarn (@var{msg}, @var{msgid})\n\
--- a/src/file-io.cc +++ b/src/file-io.cc @@ -1068,8 +1068,8 @@ DEFUN (fscanf, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} fscanf (@var{fid}, @var{template}, \"C\")\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}] =} fscanf (@var{fid}, @var{template}, \"C\")\n\ In the first form, read from @var{fid} according to @var{template},\n\ returning the result in the matrix @var{val}.\n\ \n\ @@ -1102,6 +1102,8 @@ \n\ The number of items successfully read is returned in @var{count}.\n\ \n\ +If an error occurs, @var{errmsg} contains a system-dependent error message.\n\ +\n\ In the second form, read from @var{fid} according to @var{template},\n\ with each conversion specifier in @var{template} corresponding to a\n\ single scalar return value. This form is more `C-like', and also\n\ @@ -1135,8 +1137,9 @@ } else { - retval (1) = 0.0; - retval (0) = Matrix (); + retval(2) = "unknown error"; + retval(1) = 0.0; + retval(0) = Matrix (); if (nargin == 2 || nargin == 3) { @@ -1158,6 +1161,7 @@ if (! error_state) { + retval(2) = os.error (); retval(1) = count; retval(0) = tmp; } @@ -1174,10 +1178,27 @@ return retval; } +static std::string +get_sscanf_data (const octave_value& val) +{ + std::string retval; + + if (val.is_string ()) + { + octave_value tmp = val.reshape (dim_vector (1, val.numel ())); + + retval = tmp.string_value (); + } + else + ::error ("sscanf: argument STRING must be a string"); + + return retval; +} + DEFUN (sscanf, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}] =} sscanf (@var{string}, @var{template}, \"C\")\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}, @var{pos}] =} sscanf (@var{string}, @var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}] =} sscanf (@var{string}, @var{template}, \"C\")\n\ This is like @code{fscanf}, except that the characters are taken from the\n\ string @var{string} instead of from a stream. Reaching the end of the\n\ string is treated as an end-of-file condition. In addition to the values\n\ @@ -1194,10 +1215,10 @@ if (nargin == 3 && args(2).is_string ()) { - if (args(0).is_string ()) + std::string data = get_sscanf_data (args(0)); + + if (! error_state) { - std::string data = args(0).string_value (); - octave_stream os = octave_istrstream::create (data); if (os.is_valid ()) @@ -1223,10 +1244,10 @@ retval(1) = 0.0; retval(0) = Matrix (); - if (args(0).is_string ()) + std::string data = get_sscanf_data (args(0)); + + if (! error_state) { - std::string data = args(0).string_value (); - octave_stream os = octave_istrstream::create (data); if (os.is_valid ()) @@ -1263,8 +1284,6 @@ ::error ("%s: unable to create temporary input buffer", who.c_str ()); } - else - ::error ("%s: argument STRING must be a string", who.c_str ()); } else print_usage (); @@ -1275,8 +1294,8 @@ DEFUN (scanf, args, nargout, "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {[@var{val}, @var{count}] =} scanf (@var{template}, @var{size})\n\ -@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}]] =} scanf (@var{template}, \"C\")\n\ +@deftypefn {Built-in Function} {[@var{val}, @var{count}, @var{errmsg}] =} scanf (@var{template}, @var{size})\n\ +@deftypefnx {Built-in Function} {[@var{v1}, @var{v2}, @dots{}, @var{count}, @var{errmsg}]] =} scanf (@var{template}, \"C\")\n\ This is equivalent to calling @code{fscanf} with @var{fid} = @code{stdin}.\n\ \n\ It is currently not useful to call @code{scanf} in interactive\n\
--- a/src/find-defun-files.sh +++ b/src/find-defun-files.sh @@ -21,6 +21,6 @@ file="$srcdir/$arg" fi if [ "`$EGREP -l "$DEFUN_PATTERN" $file`" ]; then - echo "$file" | $SED 's,.*/,,; s/\.\(cc\|yy\|ll\)$/.df/'; + echo "$file" | $SED 's,.*/,,; s/\.cc$/.df/; s/\.ll$/.df/; s/\.yy$/.df/'; fi done
--- a/src/genprops.awk +++ b/src/genprops.awk @@ -241,6 +241,27 @@ emit_get_accessor(i, "octave_value", "get"); } +## string_array_property + +function emit_get_string_array (i) +{ + printf (" std::string get_%s_string (void) const", name[i]); + + if (emit_get[i] == "definition") + printf (" { return %s.string_value (); }\n", name[i]); + else + printf (";\n"); + + printf (" string_vector get_%s_vector (void) const", name[i]); + + if (emit_get[i] == "definition") + printf (" { return %s.string_vector_value (); }\n", name[i]); + else + printf (";\n"); + + emit_get_accessor(i, "octave_value", "get"); +} + ## common section function emit_common_declarations () @@ -300,8 +321,8 @@ emit_get_accessor(i, "graphics_handle", "handle_value"); else if (type[i] == "string_property") emit_get_accessor(i, "std::string", "string_value"); - else if (type[i] == "string_array_property") - emit_get_accessor(i, "octave_value", "get"); + else if (type[i] == "text_label_property") + emit_get_accessor(i, "octave_value", "get"); else if (type[i] == "double_property") emit_get_accessor(i, "double", "double_value"); else if (type[i] == "double_radio_property") @@ -317,6 +338,8 @@ emit_get_color(i); else if (type[i] == "callback_property") emit_get_callback(i); + else if (type[i] == "string_array_property") + emit_get_string_array(i); else { printf (" %s get_%s (void) const", type[i], name[i]);
--- a/src/gl-render.cc +++ b/src/gl-render.cc @@ -544,7 +544,7 @@ }; void -opengl_renderer::draw (const graphics_object& go) +opengl_renderer::draw (const graphics_object& go, bool toplevel) { if (! go.valid_object ()) return; @@ -567,11 +567,20 @@ draw_text (dynamic_cast<const text::properties&> (props)); else if (go.isa ("image")) draw_image (dynamic_cast<const image::properties&> (props)); - else if (go.isa ("uimenu")) - ; + else if (go.isa ("uimenu") || go.isa ("uicontrol") + || go.isa ("uicontextmenu") || go.isa ("uitoolbar") + || go.isa ("uipushtool") || go.isa ("uitoggletool")) + /* SKIP */; + else if (go.isa ("uipanel")) + { + if (toplevel) + draw_uipanel (dynamic_cast<const uipanel::properties&> (props), go); + } else - warning ("opengl_renderer: cannot render object of type `%s'", - props.graphics_object_name ().c_str ()); + { + warning ("opengl_renderer: cannot render object of type `%s'", + props.graphics_object_name ().c_str ()); + } } void @@ -581,13 +590,45 @@ // Initialize OpenGL context + init_gl_context (props.is___enhanced__ (), props.get_color_rgb ()); + + // Draw children + + draw (props.get_all_children (), false); +} + +void +opengl_renderer::draw_uipanel (const uipanel::properties& props, + const graphics_object& go) +{ + graphics_object fig = go.get_ancestor ("figure"); + const figure::properties& figProps = + dynamic_cast<const figure::properties&> (fig.get_properties ()); + + toolkit = figProps.get_toolkit (); + + // Initialize OpenGL context + + init_gl_context (figProps.is___enhanced__ (), + props.get_backgroundcolor_rgb ()); + + // Draw children + + draw (props.get_all_children (), false); +} + +void +opengl_renderer::init_gl_context (bool enhanced, const Matrix& c) +{ + // Initialize OpenGL context + glEnable (GL_DEPTH_TEST); glDepthFunc (GL_LEQUAL); glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glAlphaFunc (GL_GREATER, 0.0f); glEnable (GL_NORMALIZE); - if (props.is___enhanced__ ()) + if (enhanced) { glEnable (GL_BLEND); glEnable (GL_LINE_SMOOTH); @@ -600,17 +641,11 @@ // Clear background - Matrix c = props.get_color_rgb (); - if (c.length() >= 3) { glClearColor (c(0), c(1), c(2), 1); glClear (GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT); } - - // Draw children - - draw (props.get_all_children ()); } void @@ -665,7 +700,7 @@ double p1, double p1N, double p2, double p2N, double dx, double dy, double dz, - int xyz, bool doubleside) + int xyz, bool mirror) { glBegin (GL_LINES); @@ -679,7 +714,7 @@ { glVertex3d (val, p1, p2); glVertex3d (val, p1+dy, p2+dz); - if (doubleside) + if (mirror) { glVertex3d (val, p1N, p2N); glVertex3d (val, p1N-dy, p2N-dz); @@ -689,7 +724,7 @@ { glVertex3d (p1, val, p2); glVertex3d (p1+dx, val, p2+dz); - if (doubleside) + if (mirror) { glVertex3d (p1N, val, p2N); glVertex3d (p1N-dx, val, p2N-dz); @@ -699,7 +734,7 @@ { glVertex3d (p1, p2, val); glVertex3d (p1+dx, p2+dy, val); - if (doubleside) + if (mirror) { glVertex3d (p1N, p2N, val); glVertex3d (p1N-dx, p2N-dy, val); @@ -849,7 +884,7 @@ double ypTickN = props.get_ypTickN (); double zpTickN = props.get_zpTickN (); - bool plotyy = (props.get_tag () == "plotyy"); + bool plotyy = (props.has_property ("__plotyy_axes__")); // Axes box @@ -966,7 +1001,7 @@ string_vector xticklabels = props.get_xticklabel ().all_strings (); int wmax = 0, hmax = 0; bool tick_along_z = nearhoriz || xisinf (fy); - bool box = props.is_box (); + bool mirror = props.is_box () && xstate != AXE_ANY_DIR; set_color (props.get_xcolor_rgb ()); @@ -982,14 +1017,14 @@ render_tickmarks (xticks, x_min, x_max, ypTick, ypTick, zpTick, zpTickN, 0., 0., signum(zpTick-zpTickN)*fz*xticklen, - 0, (box && xstate != AXE_ANY_DIR)); + 0, mirror); } else { render_tickmarks (xticks, x_min, x_max, ypTick, ypTickN, zpTick, zpTick, 0., signum(ypTick-ypTickN)*fy*xticklen, - 0., 0, (box && xstate != AXE_ANY_DIR)); + 0., 0, mirror); } // tick texts @@ -1021,12 +1056,12 @@ render_tickmarks (xmticks, x_min, x_max, ypTick, ypTick, zpTick, zpTickN, 0., 0., signum(zpTick-zpTickN)*fz*xticklen/2, - 0, (box && xstate != AXE_ANY_DIR)); + 0, mirror); else render_tickmarks (xmticks, x_min, x_max, ypTick, ypTickN, zpTick, zpTick, 0., signum(ypTick-ypTickN)*fy*xticklen/2, - 0., 0, (box && xstate != AXE_ANY_DIR)); + 0., 0, mirror); } gh_manager::get_object (props.get_xlabel ()).set ("visible", "on"); @@ -1073,7 +1108,8 @@ string_vector yticklabels = props.get_yticklabel ().all_strings (); int wmax = 0, hmax = 0; bool tick_along_z = nearhoriz || xisinf (fx); - bool box = props.is_box (); + bool mirror = props.is_box () && ystate != AXE_ANY_DIR + && (! props.has_property ("__plotyy_axes__")); set_color (props.get_ycolor_rgb ()); @@ -1088,12 +1124,12 @@ render_tickmarks (yticks, y_min, y_max, xpTick, xpTick, zpTick, zpTickN, 0., 0., signum(zpTick-zpTickN)*fz*yticklen, - 1, (box && ystate != AXE_ANY_DIR)); + 1, mirror); else render_tickmarks (yticks, y_min, y_max, xpTick, xpTickN, zpTick, zpTick, signum(xPlaneN-xPlane)*fx*yticklen, - 0., 0., 1, (box && ystate != AXE_ANY_DIR)); + 0., 0., 1, mirror); // tick texts if (yticklabels.numel () > 0) @@ -1125,12 +1161,12 @@ render_tickmarks (ymticks, y_min, y_max, xpTick, xpTick, zpTick, zpTickN, 0., 0., signum(zpTick-zpTickN)*fz*yticklen/2, - 1, (box && ystate != AXE_ANY_DIR)); + 1, mirror); else render_tickmarks (ymticks, y_min, y_max, xpTick, xpTickN, zpTick, zpTick, signum(xpTick-xpTickN)*fx*yticklen/2, - 0., 0., 1, (box && ystate != AXE_ANY_DIR)); + 0., 0., 1, mirror); } gh_manager::get_object (props.get_ylabel ()).set ("visible", "on"); @@ -1169,7 +1205,7 @@ Matrix zmticks = xform.zscale (props.get_zmtick ().matrix_value ()); string_vector zticklabels = props.get_zticklabel ().all_strings (); int wmax = 0, hmax = 0; - bool box = props.is_box (); + bool mirror = props.is_box () && zstate != AXE_ANY_DIR; set_color (props.get_zcolor_rgb ()); @@ -1185,7 +1221,7 @@ render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlane, yPlane, yPlane, signum(xPlaneN-xPlane)*fx*zticklen, - 0., 0., 2, (box && zstate != AXE_ANY_DIR)); + 0., 0., 2, mirror); else render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlaneN, yPlane, yPlane, 0., @@ -1198,7 +1234,7 @@ render_tickmarks (zticks, z_min, z_max, xPlaneN, xPlane, yPlaneN, yPlane, 0., signum(yPlaneN-yPlane)*fy*zticklen, - 0., 2, (box && zstate != AXE_ANY_DIR)); + 0., 2, mirror); else render_tickmarks (zticks, z_min, z_max, xPlane, xPlane, yPlaneN, yPlane, @@ -1250,7 +1286,7 @@ render_tickmarks (zmticks, z_min, z_max, xPlaneN, xPlane, yPlane, yPlane, signum(xPlaneN-xPlane)*fx*zticklen/2, - 0., 0., 2, (box && zstate != AXE_ANY_DIR)); + 0., 0., 2, mirror); else render_tickmarks (zmticks, z_min, z_max, xPlaneN, xPlaneN, yPlane, yPlane, 0., @@ -1263,13 +1299,13 @@ render_tickmarks (zmticks, z_min, z_max, xPlane, xPlane, yPlaneN, yPlane, 0., signum(yPlaneN-yPlane)*fy*zticklen/2, - 0., 2, (box && zstate != AXE_ANY_DIR)); + 0., 2, mirror); else render_tickmarks (zmticks, z_min, z_max, xPlane, xPlane, yPlaneN, yPlaneN, signum(xPlane-xPlaneN)*fx*zticklen/2, 0., 0., 2, false); - } + } } gh_manager::get_object (props.get_zlabel ()).set ("visible", "on"); @@ -2373,7 +2409,7 @@ { if (c.numel () == 0) c = props.get_color_data ().matrix_value (); - has_markerfacecolor = ((c.numel () > 0) + has_markerfacecolor = ((c.numel () > 0) && (c.rows () == f.rows ())); } } @@ -2421,7 +2457,7 @@ void opengl_renderer::draw_text (const text::properties& props) { - if (props.get_string ().empty ()) + if (props.get_string ().is_empty ()) return; const Matrix pos = xform.scale (props.get_data_position ()); @@ -2448,7 +2484,6 @@ octave_value cdata = props.get_color_data (); dim_vector dv (cdata.dims ()); int h = dv(0), w = dv(1); - bool ok = true; Matrix x = props.get_xdata ().matrix_value (); Matrix y = props.get_ydata ().matrix_value (); @@ -2592,16 +2627,11 @@ draw_pixels (j1-j0, i1-i0, GL_RGB, GL_UNSIGNED_BYTE, a); } else - { - ok = false; - warning ("opengl_texture::draw: invalid image data type (expected double, uint16, or uint8)"); - } + warning ("opengl_texture::draw: invalid image data type (expected double, uint16, or uint8)"); } else - { - ok = false; - warning ("opengl_texture::draw: invalid image size (expected n*m*3 or n*m)"); - } + warning ("opengl_texture::draw: invalid image size (expected n*m*3 or n*m)"); + glPixelZoom (1, 1); } @@ -2857,7 +2887,7 @@ glBegin (GL_POLYGON); for (double ang = 0; ang < (2*M_PI); ang += ang_step) - glVertex2d (sz*cos(ang)/6, sz*sin(ang)/6); + glVertex2d (sz*cos(ang)/3, sz*sin(ang)/3); glEnd (); } break;
--- a/src/gl-render.h +++ b/src/gl-render.h @@ -59,9 +59,9 @@ virtual ~opengl_renderer (void) { } - virtual void draw (const graphics_object& go); + virtual void draw (const graphics_object& go, bool toplevel = true); - virtual void draw (const Matrix& hlist) + virtual void draw (const Matrix& hlist, bool toplevel = false) { int len = hlist.length (); @@ -70,7 +70,7 @@ graphics_object obj = gh_manager::get_object (hlist(i)); if (obj) - draw (obj); + draw (obj, toplevel); } } @@ -86,6 +86,10 @@ virtual void draw_hggroup (const hggroup::properties& props); virtual void draw_text (const text::properties& props); virtual void draw_image (const image::properties& props); + virtual void draw_uipanel (const uipanel::properties& props, + const graphics_object& go); + + virtual void init_gl_context (bool enhanced, const Matrix& backgroundColor); virtual void set_color (const Matrix& c); virtual void set_polygon_offset (bool on, double offset = 0.0);
--- a/src/gl2ps-renderer.cc +++ b/src/gl2ps-renderer.cc @@ -199,7 +199,7 @@ void glps_renderer::draw_text (const text::properties& props) { - if (props.get_string ().empty ()) + if (props.get_string ().is_empty ()) return; set_font (props); @@ -223,9 +223,15 @@ // FIXME: handle margin and surrounding box glRasterPos3d (pos(0), pos(1), pos(2)); - gl2psTextOpt (props.get_string ().c_str (), fontname.c_str (), fontsize, + + octave_value string_prop = props.get_string (); + + string_vector sv = string_prop.all_strings (); + + std::string s = sv.join ("\n"); + + gl2psTextOpt (s.c_str (), fontname.c_str (), fontsize, alignment_to_mode (halign, valign), props.get_rotation ()); - } #endif
--- a/src/gl2ps.c +++ b/src/gl2ps.c @@ -1,6 +1,6 @@ /* * GL2PS, an OpenGL to PostScript Printing Library - * Copyright (C) 1999-2009 C. Geuzaine + * Copyright (C) 1999-2011 C. Geuzaine * * This program is free software; you can redistribute it and/or * modify it under the terms of either: @@ -305,10 +305,12 @@ static void *gl2psRealloc(void *ptr, size_t size) { + void *orig = ptr; if(!size) return NULL; - ptr = realloc(ptr, size); + ptr = realloc(orig, size); if(!ptr){ gl2psMsg(GL2PS_ERROR, "Couldn't reallocate requested memory"); + free(orig); return NULL; } return ptr; @@ -320,12 +322,12 @@ free(ptr); } -static size_t gl2psWriteBigEndian(unsigned long data, size_t bytes) -{ - size_t i; - size_t size = sizeof(unsigned long); +static int gl2psWriteBigEndian(unsigned long data, int bytes) +{ + int i; + int size = sizeof(unsigned long); for(i = 1; i <= bytes; ++i){ - fputc(0xff & (data >> (size-i) * 8), gl2ps->stream); + fputc(0xff & (data >> (size - i) * 8), gl2ps->stream); } return bytes; } @@ -392,10 +394,10 @@ return gl2ps->compress->start; } -static size_t gl2psWriteBigEndianCompress(unsigned long data, size_t bytes) -{ - size_t i; - size_t size = sizeof(unsigned long); +static int gl2psWriteBigEndianCompress(unsigned long data, int bytes) +{ + int i; + int size = sizeof(unsigned long); for(i = 1; i <= bytes; ++i){ *gl2ps->compress->src = (Bytef)(0xff & (data >> (size-i) * 8)); ++gl2ps->compress->src; @@ -441,7 +443,7 @@ return ret; } -static void gl2psPrintGzipHeader() +static void gl2psPrintGzipHeader(void) { #if defined(GL2PS_HAVE_ZLIB) char tmp[10] = {'\x1f', '\x8b', /* magic numbers: 0x1f, 0x8b */ @@ -459,7 +461,7 @@ #endif } -static void gl2psPrintGzipFooter() +static void gl2psPrintGzipFooter(void) { #if defined(GL2PS_HAVE_ZLIB) int n; @@ -789,6 +791,7 @@ static void gl2psUserFlushPNG(png_structp png_ptr) { + (void) png_ptr; /* not used */ } static void gl2psConvertPixmapToPNG(GL2PSimage *pixmap, GL2PSlist *png) @@ -1358,17 +1361,17 @@ (*t2)->verts[0] = quad->verts[0]; (*t2)->verts[1] = quad->verts[2]; (*t2)->verts[2] = quad->verts[3]; - (*t2)->boundary = ((quad->boundary & 4) ? 2 : 0) | ((quad->boundary & 4) ? 2 : 0); + (*t2)->boundary = ((quad->boundary & 4) ? 2 : 0) | ((quad->boundary & 8) ? 4 : 0); } static int gl2psCompareDepth(const void *a, const void *b) { - GL2PSprimitive *q, *w; + const GL2PSprimitive *q, *w; GLfloat dq = 0.0F, dw = 0.0F, diff; int i; - q = *(GL2PSprimitive**)a; - w = *(GL2PSprimitive**)b; + q = *(const GL2PSprimitive* const*)a; + w = *(const GL2PSprimitive* const*)b; for(i = 0; i < q->numverts; i++){ dq += q->verts[i].xyz[2]; @@ -1394,10 +1397,10 @@ static int gl2psTrianglesFirst(const void *a, const void *b) { - GL2PSprimitive *q, *w; - - q = *(GL2PSprimitive**)a; - w = *(GL2PSprimitive**)b; + const GL2PSprimitive *q, *w; + + q = *(const GL2PSprimitive* const*)a; + w = *(const GL2PSprimitive* const*)b; return (q->type < w->type ? 1 : -1); } @@ -1614,7 +1617,7 @@ } } -static void gl2psRescaleAndOffset() +static void gl2psRescaleAndOffset(void) { GL2PSprimitive *prim; GLfloat minZ, maxZ, rangeZ, scaleZ; @@ -3201,7 +3204,7 @@ int i; if(gl2ps->filename && strlen(gl2ps->filename) < 256){ - for(i = strlen(gl2ps->filename)-1; i >= 0; i--){ + for(i = (int)strlen(gl2ps->filename) - 1; i >= 0; i--){ if(gl2ps->filename[i] == '.'){ strncpy(name, gl2ps->filename, i); name[i] = '\0'; @@ -3306,6 +3309,7 @@ static void gl2psPrintTeXBeginViewport(GLint viewport[4]) { + (void) viewport; /* not used */ glRenderMode(GL_FEEDBACK); if(gl2ps->header){ @@ -3409,7 +3413,7 @@ cnt, text->fontsize, x, y, text->str); } else{ - rad = (GLfloat)M_PI * text->angle / 180.0F; + rad = (GLfloat)(M_PI * text->angle / 180.0F); srad = (GLfloat)sin(rad); crad = (GLfloat)cos(rad); gl2ps->streamlength += gl2psPrintf @@ -4170,8 +4174,7 @@ /* Put vertex' edge flag (8bit) and coordinates (32bit) in shader stream */ static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex, - size_t (*action)(unsigned long data, - size_t size), + int (*action)(unsigned long data, int size), GLfloat dx, GLfloat dy, GLfloat xmin, GLfloat ymin) { @@ -4217,8 +4220,7 @@ /* Put vertex' rgb value (8bit for every component) in shader stream */ static int gl2psPrintPDFShaderStreamDataRGB(GL2PSvertex *vertex, - size_t (*action)(unsigned long data, - size_t size)) + int (*action)(unsigned long data, int size)) { int offs = 0; unsigned long imap; @@ -4242,8 +4244,7 @@ /* Put vertex' alpha (8/16bit) in shader stream */ static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex, - size_t (*action)(unsigned long data, - size_t size), + int (*action)(unsigned long data, int size), int sigbyte) { int offs = 0; @@ -4270,8 +4271,7 @@ static int gl2psPrintPDFShaderStreamData(GL2PStriangle *triangle, GLfloat dx, GLfloat dy, GLfloat xmin, GLfloat ymin, - size_t (*action)(unsigned long data, - size_t size), + int (*action)(unsigned long data, int size), int gray) { int i, offs = 0; @@ -4489,8 +4489,7 @@ /* Similar groups of functions for pixmaps and text */ static int gl2psPrintPDFPixmapStreamData(GL2PSimage *im, - size_t (*action)(unsigned long data, - size_t size), + int (*action)(unsigned long data, int size), int gray) { int x, y, shift; @@ -5031,6 +5030,7 @@ gl2psPrintf("\"/>\n"); gl2psListDelete(png); #else + (void) x; (void) y; (void) pixmap; /* not used */ gl2psMsg(GL2PS_WARNING, "GL2PS must be compiled with PNG support in " "order to embed images in SVG streams"); #endif @@ -5842,7 +5842,8 @@ const void *pixels) { int size, i; - GLfloat pos[4], *piv, zoom_x, zoom_y; + const GLfloat *piv; + GLfloat pos[4], zoom_x, zoom_y; GL2PSprimitive *prim; GLboolean valid; @@ -5894,7 +5895,7 @@ prim->data.image->format = GL_RGB; size = height * width * 3; prim->data.image->pixels = (GLfloat*)gl2psMalloc(size * sizeof(GLfloat)); - piv = (GLfloat*)pixels; + piv = (const GLfloat*)pixels; for(i = 0; i < size; ++i, ++piv){ prim->data.image->pixels[i] = *piv; if(!((i + 1) % 3)) @@ -5939,7 +5940,7 @@ glPassThrough((GLfloat)width); glPassThrough((GLfloat)height); for(i = 0; i < size; i += sizeoffloat){ - float *value = (float*)imagemap; + const float *value = (const float*)imagemap; glPassThrough(*value); imagemap += sizeoffloat; }
--- a/src/gl2ps.h +++ b/src/gl2ps.h @@ -1,6 +1,6 @@ /* * GL2PS, an OpenGL to PostScript Printing Library - * Copyright (C) 1999-2009 C. Geuzaine + * Copyright (C) 1999-2011 C. Geuzaine * * This program is free software; you can redistribute it and/or * modify it under the terms of either: @@ -46,6 +46,7 @@ # pragma warning(disable:4115) # pragma warning(disable:4996) # endif +# define WIN32_LEAN_AND_MEAN # include <windows.h> # if defined(GL2PSDLL) # if defined(GL2PSDLL_EXPORTS) @@ -80,14 +81,14 @@ #define GL2PS_MAJOR_VERSION 1 #define GL2PS_MINOR_VERSION 3 -#define GL2PS_PATCH_VERSION 5 +#define GL2PS_PATCH_VERSION 6 #define GL2PS_EXTRA_VERSION "" #define GL2PS_VERSION (GL2PS_MAJOR_VERSION + \ 0.01 * GL2PS_MINOR_VERSION + \ 0.0001 * GL2PS_PATCH_VERSION) -#define GL2PS_COPYRIGHT "(C) 1999-2009 C. Geuzaine" +#define GL2PS_COPYRIGHT "(C) 1999-2011 C. Geuzaine" /* Output file formats (the values and the ordering are important!) */
--- a/src/graphics.cc +++ b/src/graphics.cc @@ -45,9 +45,11 @@ #include "graphics.h" #include "input.h" #include "ov.h" +#include "oct-locbuf.h" #include "oct-obj.h" #include "oct-map.h" #include "ov-fcn-handle.h" +#include "pager.h" #include "parse.h" #include "toplev.h" #include "txt-eng-ft.h" @@ -218,10 +220,18 @@ } static Matrix -default_lim (void) +default_lim (bool logscale = false) { Matrix m (1, 2, 0); - m(1) = 1; + + if (logscale) + { + m(0) = 0.1; + m(1) = 1.0; + } + else + m(1) = 1; + return m; } @@ -308,13 +318,107 @@ } static Matrix +default_control_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = 80; + retval(3) = 30; + + return retval; +} + +static Matrix +default_control_sliderstep (void) +{ + Matrix retval (1, 2, 0.0); + + retval(0) = 0.01; + retval(1) = 0.1; + + return retval; +} + +static Matrix +default_panel_position (void) +{ + Matrix retval (1, 4, 0.0); + + retval(0) = 0; + retval(1) = 0; + retval(2) = retval(3) = 0.5; + + return retval; +} + +static double +convert_font_size (double font_size, const caseless_str& from_units, + const caseless_str& to_units, double parent_height = 0) +{ + // Simple case where from_units == to_units + + if (from_units.compare (to_units)) + return font_size; + + // Converts the given fontsize using the following transformation: + // <old_font_size> => points => <new_font_size> + + double points_size = 0; + double res = 0; + + if (from_units.compare ("points")) + points_size = font_size; + else + { + res = xget (0, "screenpixelsperinch").double_value (); + + if (from_units.compare ("pixels")) + points_size = font_size * 72.0 / res; + else if (from_units.compare ("inches")) + points_size = font_size * 72.0; + else if (from_units.compare ("centimeters")) + points_size = font_size * 72.0 / 2.54; + else if (from_units.compare ("normalized")) + points_size = font_size * parent_height * 72.0 / res; + } + + double new_font_size = 0; + + if (to_units.compare ("points")) + new_font_size = points_size; + else + { + if (res <= 0) + res = xget (0, "screenpixelsperinch").double_value (); + + if (to_units.compare ("pixels")) + new_font_size = points_size * res / 72.0; + else if (to_units.compare ("inches")) + new_font_size = points_size / 72.0; + else if (to_units.compare ("centimeters")) + new_font_size = points_size * 2.54 / 72.0; + else if (to_units.compare ("normalized")) + { + // Avoid setting font size to (0/0) = NaN + + if (parent_height > 0) + new_font_size = points_size * res / (parent_height * 72.0); + } + } + + return new_font_size; +} + +static Matrix convert_position (const Matrix& pos, const caseless_str& from_units, - const caseless_str& to_units, - const Matrix& parent_dim = Matrix (1, 2, 0.0)) + const caseless_str& to_units, const Matrix& parent_dim) { Matrix retval (1, pos.numel ()); double res = 0; bool is_rectangle = (pos.numel () == 4); + bool is_2d = (pos.numel () == 2); if (from_units.compare ("pixels")) retval = pos; @@ -327,7 +431,7 @@ retval(2) = pos(2) * parent_dim(0); retval(3) = pos(3) * parent_dim(1); } - else + else if (! is_2d) retval(2) = 0; } else if (from_units.compare ("characters")) @@ -350,7 +454,7 @@ retval(2) = 0.5 * pos(2) * f; retval(3) = pos(3) * f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -377,7 +481,7 @@ retval(2) = pos(2) * f; retval(3) = pos(3) * f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -393,7 +497,7 @@ retval(2) /= parent_dim(0); retval(3) /= parent_dim(1); } - else + else if (! is_2d) retval(2) = 0; } else if (to_units.compare ("characters")) @@ -414,7 +518,7 @@ retval(2) = 2 * retval(2) / f; retval(3) = retval(3) / f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -441,12 +545,12 @@ retval(2) /= f; retval(3) /= f; } - else + else if (! is_2d) retval(2) = 0; } } } - else if (! is_rectangle) + else if (! is_rectangle && ! is_2d) retval(2) = 0; return retval; @@ -657,7 +761,7 @@ template<class T> static void get_array_limits (const Array<T>& m, double& emin, double& emax, - double& eminp) + double& eminp, double& emaxp) { const T *data = m.data (); octave_idx_type n = m.numel (); @@ -677,6 +781,9 @@ if (e > 0 && e < eminp) eminp = e; + + if (e < 0 && e > emaxp) + emaxp = e; } } } @@ -712,8 +819,38 @@ { pfx = name.substr (0, 7); - if (pfx.compare ("surface") || pfx.compare ("hggroup")) + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) offset = 7; + else if (len >= 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len >= 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len >= 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len >= 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } } } } @@ -754,27 +891,35 @@ go = new hggroup (h, p); else if (type.compare ("uimenu")) go = new uimenu (h, p); + else if (type.compare ("uicontrol")) + go = new uicontrol (h, p); + else if (type.compare ("uipanel")) + go = new uipanel (h, p); + else if (type.compare ("uicontextmenu")) + go = new uicontextmenu (h, p); + else if (type.compare ("uitoolbar")) + go = new uitoolbar (h, p); + else if (type.compare ("uipushtool")) + go = new uipushtool (h, p); + else if (type.compare ("uitoggletool")) + go = new uitoggletool (h, p); return go; } // --------------------------------------------------------------------- bool -base_property::set (const octave_value& v, bool do_run ) +base_property::set (const octave_value& v, bool do_run, bool do_notify_toolkit) { if (do_set (v)) { // Notify graphics toolkit. - if (id >= 0) + if (id >= 0 && do_notify_toolkit) { graphics_object go = gh_manager::get_object (parent); if (go) - { - graphics_toolkit toolkit = go.get_toolkit (); - if (toolkit) - toolkit.update (go, id); - } + go.update (id); } // run listeners @@ -795,7 +940,7 @@ for (int i = 0; i < l.length (); i++) { - gh_manager::execute_callback (parent, l(i), octave_value ()); + gh_manager::execute_listener (parent, l(i)); if (error_state) break; @@ -922,11 +1067,18 @@ if (! s.empty ()) { - if (radio_val.contains (s)) + std::string match; + + if (radio_val.contains (s, match)) { - if (current_type != radio_t || current_val != s) + if (current_type != radio_t || match != current_val) { - current_val = s; + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; current_type = radio_t; return true; } @@ -986,12 +1138,18 @@ if (val.is_string ()) { std::string s = val.string_value (); - - if (! s.empty () && radio_val.contains (s)) - { - if (current_type != radio_t || s != current_val) + std::string match; + + if (! s.empty () && radio_val.contains (s, match)) + { + if (current_type != radio_t || match != current_val) { - current_val = s; + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; current_type = radio_t; return true; } @@ -1130,31 +1288,31 @@ array_property::get_data_limits (void) { xmin = xminp = octave_Inf; - xmax = -octave_Inf; + xmax = xmaxp = -octave_Inf; if (! data.is_empty ()) { if (data.is_integer_type ()) { if (data.is_int8_type ()) - get_array_limits (data.int8_array_value (), xmin, xmax, xminp); + get_array_limits (data.int8_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_uint8_type ()) - get_array_limits (data.uint8_array_value (), xmin, xmax, xminp); + get_array_limits (data.uint8_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_int16_type ()) - get_array_limits (data.int16_array_value (), xmin, xmax, xminp); + get_array_limits (data.int16_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_uint16_type ()) - get_array_limits (data.uint16_array_value (), xmin, xmax, xminp); + get_array_limits (data.uint16_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_int32_type ()) - get_array_limits (data.int32_array_value (), xmin, xmax, xminp); + get_array_limits (data.int32_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_uint32_type ()) - get_array_limits (data.uint32_array_value (), xmin, xmax, xminp); + get_array_limits (data.uint32_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_int64_type ()) - get_array_limits (data.int64_array_value (), xmin, xmax, xminp); + get_array_limits (data.int64_array_value (), xmin, xmax, xminp, xmaxp); else if (data.is_uint64_type ()) - get_array_limits (data.uint64_array_value (), xmin, xmax, xminp); + get_array_limits (data.uint64_array_value (), xmin, xmax, xminp, xmaxp); } else - get_array_limits (data.array_value (), xmin, xmax, xminp); + get_array_limits (data.array_value (), xmin, xmax, xminp, xmaxp); } } @@ -1266,11 +1424,33 @@ return false; } +// If TRUE, we are executing any callback function, or the functions it +// calls. Used to determine handle visibility inside callback +// functions. +static bool executing_callback = false; + void callback_property::execute (const octave_value& data) const { - if (callback.is_defined () && ! callback.is_empty ()) - gh_manager::execute_callback (get_parent (), callback, data); + unwind_protect frame; + + // We are executing the callback function associated with this + // callback property. When set to true, we avoid recursive calls to + // callback routines. + frame.protect_var (executing); + + // We are executing a callback function, so allow handles that have + // their handlevisibility property set to "callback" to be visible. + frame.protect_var (executing_callback); + + if (! executing) + { + executing = true; + executing_callback = true; + + if (callback.is_defined () && ! callback.is_empty ()) + gh_manager::execute_callback (get_parent (), callback, data); + } } // Used to cache dummy graphics objects from which dynamic @@ -1427,6 +1607,54 @@ return retval; } +static void +finalize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + for (int k = 0; k < children.numel (); k++) + finalize_r (children(k)); + + go.finalize (); + } +} + +static void +initialize_r (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + { + Matrix children = go.get_properties ().get_all_children (); + + go.initialize (); + + for (int k = 0; k < children.numel (); k++) + initialize_r (children(k)); + } +} + +void +figure::properties::set_toolkit (const graphics_toolkit& b) +{ + if (toolkit) + finalize_r (get___myhandle__ ()); + + toolkit = b; + __graphics_toolkit__ = b.get_name (); + __plot_stream__ = Matrix (); + + if (toolkit) + initialize_r (get___myhandle__ ()); + + mark_modified (); +} + // --------------------------------------------------------------------- void @@ -1459,8 +1687,38 @@ { pfx = name.substr (0, 7); - if (pfx.compare ("surface") || pfx.compare ("hggroup")) + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoogletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } } } } @@ -1493,6 +1751,16 @@ has_property = hggroup::properties::has_core_property (pname); else if (pfx == "uimenu") has_property = uimenu::properties::has_core_property (pname); + else if (pfx == "uicontrol") + has_property = uicontrol::properties::has_core_property (pname); + else if (pfx == "uipanel") + has_property = uipanel::properties::has_core_property (pname); + else if (pfx == "uicontextmenu") + has_property = uicontextmenu::properties::has_core_property (pname); + else if (pfx == "uitoolbar") + has_property = uitoolbar::properties::has_core_property (pname); + else if (pfx == "uipushtool") + has_property = uipushtool::properties::has_core_property (pname); if (has_property) { @@ -1557,8 +1825,38 @@ { pfx = name.substr (0, 7); - if (pfx.compare ("surface") || pfx.compare ("hggroup")) + if (pfx.compare ("surface") || pfx.compare ("hggroup") + || pfx.compare ("uipanel")) offset = 7; + else if (len > 9) + { + pfx = name.substr (0, 9); + + if (pfx.compare ("uicontrol") + || pfx.compare ("uitoolbar")) + offset = 9; + else if (len > 10) + { + pfx = name.substr (0, 10); + + if (pfx.compare ("uipushtool")) + offset = 10; + else if (len > 12) + { + pfx = name.substr (0, 12); + + if (pfx.compare ("uitoggletool")) + offset = 12; + else if (len > 13) + { + pfx = name.substr (0, 13); + + if (pfx.compare ("uicontextmenu")) + offset = 13; + } + } + } + } } } } @@ -1810,11 +2108,11 @@ } graphics_handle -gh_manager::get_handle (const std::string& go_name) +gh_manager::do_get_handle (bool integer_figure_handle) { graphics_handle retval; - if (go_name == "figure") + if (integer_figure_handle) { // Figure handles are positive integers corresponding to the // figure number. @@ -1873,9 +2171,7 @@ bp.execute_deletefcn (); // Notify graphics toolkit. - graphics_toolkit toolkit = p->second.get_toolkit (); - if (toolkit) - toolkit.finalize (p->second); + p->second.finalize (); // Note: this will be valid only for first explicitly // deleted object. All its children will then have an @@ -1899,6 +2195,38 @@ } } +void +gh_manager::do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) +{ + iterator p = handle_map.find (old_gh); + + if (p != handle_map.end ()) + { + graphics_object go = p->second; + + handle_map.erase (p); + + handle_map[new_gh] = go; + + if (old_gh.value () < 0) + handle_free_list.insert (std::ceil (old_gh.value ()) + - make_handle_fraction ()); + } + else + error ("graphics_handle::free: invalid object %g", old_gh.value ()); + + for (figure_list_iterator q = figure_list.begin (); + q != figure_list.end (); q++) + { + if (*q == old_gh) + { + *q = new_gh; + break; + } + } +} + gh_manager *gh_manager::instance = 0; static void @@ -2044,6 +2372,15 @@ obj.get_properties ().execute_createfcn (); } +static void +xinitialize (const graphics_handle& h) +{ + graphics_object go = gh_manager::get_object (h); + + if (go) + go.initialize (); +} + // --------------------------------------------------------------------- void @@ -2054,12 +2391,12 @@ update (go, id); } -void +bool base_graphics_toolkit::initialize (const graphics_handle& h) { graphics_object go = gh_manager::get_object (h); - initialize (go); + return initialize (go); } void @@ -2240,6 +2577,13 @@ obj.update_axis_limits (axis_type, h); } +bool +base_properties::is_handle_visible (void) const +{ + return (handlevisibility.is ("on") + || (executing_callback && ! handlevisibility.is ("off"))); +} + graphics_toolkit base_properties::get_toolkit (void) const { @@ -2306,6 +2650,11 @@ bool is_valid (void) const { return true; } + bool initialize (const graphics_object& go) + { + return go.isa ("figure"); + } + void finalize (const graphics_object& go) { if (go.isa ("figure")) @@ -2606,6 +2955,50 @@ gripe_set_invalid ("callbackobject"); } +void +figure::properties::set_integerhandle (const octave_value& val) +{ + if (! error_state) + { + if (integerhandle.set (val, true)) + { + bool int_fig_handle = integerhandle.is_on (); + + graphics_object this_go = gh_manager::get_object (__myhandle__); + + graphics_handle old_myhandle = __myhandle__; + + __myhandle__ = gh_manager::get_handle (int_fig_handle); + + gh_manager::renumber_figure (old_myhandle, __myhandle__); + + graphics_object parent_go = gh_manager::get_object (get_parent ()); + + base_properties& props = parent_go.get_properties (); + + props.renumber_child (old_myhandle, __myhandle__); + + Matrix kids = get_children (); + + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object kid = gh_manager::get_object (kids(i)); + + kid.get_properties ().renumber_parent (__myhandle__); + } + + graphics_handle cf = gh_manager::current_figure (); + + if (__myhandle__ == cf) + xset (0, "currentfigure", __myhandle__.value ()); + + this_go.update (integerhandle.get_id ()); + + mark_modified (); + } + } +} + // FIXME This should update monitorpositions and pointerlocation, but // as these properties are yet used, and so it doesn't matter that they // aren't set yet. @@ -2756,13 +3149,14 @@ } Matrix -figure::properties::get_boundingbox (bool) const +figure::properties::get_boundingbox (bool internal, const Matrix&) const { Matrix screen_size = screen_size_pixels (); - Matrix pos; - - pos = convert_position (get_position ().matrix_value (), get_units (), - "pixels", screen_size); + Matrix pos = (internal ? + get_position ().matrix_value () : + get_outerposition ().matrix_value ()); + + pos = convert_position (pos, get_units (), "pixels", screen_size); pos(0)--; pos(1)--; @@ -2772,7 +3166,8 @@ } void -figure::properties::set_boundingbox (const Matrix& bb) +figure::properties::set_boundingbox (const Matrix& bb, bool internal, + bool do_notify_toolkit) { Matrix screen_size = screen_size_pixels (); Matrix pos = bb; @@ -2782,18 +3177,56 @@ pos(0)++; pos = convert_position (pos, "pixels", get_units (), screen_size); - set_position (pos); -} - -void -figure::properties::set_position (const octave_value& v) + if (internal) + set_position (pos, do_notify_toolkit); + else + set_outerposition (pos, do_notify_toolkit); +} + +Matrix +figure::properties::map_from_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos(1) = bb(3) - pos(1); + pos(0)++; + pos = convert_position (pos, "pixels", get_units (), + bb.extract_n (0, 2, 1, 2)); + + return pos; +} + +Matrix +figure::properties::map_to_boundingbox (double x, double y) const +{ + Matrix bb = get_boundingbox (true); + Matrix pos (1, 2, 0); + + pos(0) = x; + pos(1) = y; + + pos = convert_position (pos, get_units (), "pixels", + bb.extract_n (0, 2, 1, 2)); + pos(0)--; + pos(1) = bb(3) - pos(1); + + return pos; +} + +void +figure::properties::set_position (const octave_value& v, + bool do_notify_toolkit) { if (! error_state) { Matrix old_bb, new_bb; old_bb = get_boundingbox (); - position = v; + position.set (v, true, do_notify_toolkit); new_bb = get_boundingbox (); if (old_bb != new_bb) @@ -2810,6 +3243,19 @@ } void +figure::properties::set_outerposition (const octave_value& v, + bool do_notify_toolkit) +{ + if (! error_state) + { + if (outerposition.set (v, true, do_notify_toolkit)) + { + mark_modified (); + } + } +} + +void figure::properties::set_paperunits (const octave_value& v) { if (! error_state) @@ -3172,6 +3618,7 @@ ticklength.add_constraint (dim_vector (1, 2)); tightinset.add_constraint (dim_vector (1, 4)); looseinset.add_constraint (dim_vector (1, 4)); + update_font (); x_zlim.resize (1, 2); @@ -3263,13 +3710,119 @@ void axes::properties::sync_positions (void) { + Matrix ref_linset = looseinset.get ().matrix_value (); + if (autopos_tag_is ("subplot")) + { + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + if (parent_obj.isa ("figure")) + { + // FIXME: temporarily changed units should be protected + // from interrupts + std::string fig_units = parent_obj.get ("units").string_value (); + parent_obj.set ("units", "pixels"); + + Matrix ref_outbox = outerposition.get ().matrix_value (); + ref_outbox(2) += ref_outbox(0); + ref_outbox(3) += ref_outbox(1); + + // Find those subplots that are left, right, bottom and top aligned + // with the current subplot + Matrix kids = parent_obj.get_properties ().get_children (); + std::vector<octave_value> aligned; + std::vector<bool> l_aligned, b_aligned, r_aligned, t_aligned; + for (octave_idx_type i = 0; i < kids.numel (); i++) + { + graphics_object go = gh_manager::get_object (kids(i)); + if (go.isa ("axes")) + { + axes::properties& props = + dynamic_cast<axes::properties&> (go.get_properties ()); + if (props.autopos_tag_is("subplot")) + { + Matrix outpos = go.get ("outerposition").matrix_value (); + bool l_align=(std::abs (outpos(0)-ref_outbox(0)) < 1e-15); + bool b_align=(std::abs (outpos(1)-ref_outbox(1)) < 1e-15); + bool r_align=(std::abs (outpos(0)+outpos(2)-ref_outbox(2)) < 1e-15); + bool t_align=(std::abs (outpos(1)+outpos(3)-ref_outbox(3)) < 1e-15); + if (l_align || b_align || r_align || t_align) + { + aligned.push_back(kids(i)); + l_aligned.push_back(l_align); + b_aligned.push_back(b_align); + r_aligned.push_back(r_align); + t_aligned.push_back(t_align); + // FIXME: the temporarily deleted tags should be + // protected from interrupts + props.set_autopos_tag ("none"); + } + } + } + } + // Determine a minimum box which aligns the subplots + Matrix ref_box(1, 4, 0.); + ref_box(2) = 1.; + ref_box(3) = 1.; + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast<axes::properties&> (go.get_properties ()); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = std::min (0., linset(0)-0.01); + if (b_aligned[i]) + linset(1) = std::min (0., linset(1)-0.01); + if (r_aligned[i]) + linset(2) = std::min (0., linset(2)-0.01); + if (t_aligned[i]) + linset(3) = std::min (0., linset(3)-0.01); + props.set_looseinset (linset); + Matrix pos = props.get_position ().matrix_value (); + if (l_aligned[i]) + ref_box(0) = std::max (ref_box(0), pos(0)); + if (b_aligned[i]) + ref_box(1) = std::max (ref_box(1), pos(1)); + if (r_aligned[i]) + ref_box(2) = std::min (ref_box(2), pos(0)+pos(2)); + if (t_aligned[i]) + ref_box(3) = std::min (ref_box(3), pos(1)+pos(3)); + } + // Set common looseinset values for all aligned subplots and + // revert their tag values + for (size_t i = 0; i < aligned.size (); i++) + { + graphics_object go = gh_manager::get_object (aligned[i]); + axes::properties& props = + dynamic_cast<axes::properties&> (go.get_properties ()); + Matrix outpos = props.get_outerposition ().matrix_value (); + Matrix linset = props.get_looseinset ().matrix_value (); + if (l_aligned[i]) + linset(0) = (ref_box(0)-outpos(0))/outpos(2); + if (b_aligned[i]) + linset(1) = (ref_box(1)-outpos(1))/outpos(3); + if (r_aligned[i]) + linset(2) = (outpos(0)+outpos(2)-ref_box(2))/outpos(2); + if (t_aligned[i]) + linset(3) = (outpos(1)+outpos(3)-ref_box(3))/outpos(3); + props.set_looseinset (linset); + props.set_autopos_tag ("subplot"); + } + parent_obj.set ("units", fig_units); + } + } + else + sync_positions (ref_linset); +} + +void +axes::properties::sync_positions (const Matrix& linset) +{ Matrix pos = position.get ().matrix_value (); Matrix outpos = outerposition.get ().matrix_value (); - Matrix lins = looseinset.get ().matrix_value (); - double lratio = lins(0); - double bratio = lins(1); - double wratio = 1-lins(0)-lins(2); - double hratio = 1-lins(1)-lins(3); + double lratio = linset(0); + double bratio = linset(1); + double wratio = 1-linset(0)-linset(2); + double hratio = 1-linset(1)-linset(3); if (activepositionproperty.is ("outerposition")) { pos = outpos; @@ -3286,7 +3839,7 @@ double thrshldy = 0.005*outpos(3); double minsizex = 0.2*outpos(2); double minsizey = 0.2*outpos(3); - bool updatex = true, updatey = true; + bool updatex = true, updatey = true; for (int i = 0; i < 10; i++) { double dt; @@ -3359,7 +3912,7 @@ inset(1) = pos(1)-outpos(1); inset(2) = outpos(0)+outpos(2)-pos(0)-pos(2); inset(3) = outpos(1)+outpos(3)-pos(1)-pos(3); - + tightinset = inset; } @@ -3372,7 +3925,8 @@ if (v.is_string ()) { - val = gh_manager::make_graphics_handle ("text", __myhandle__, false); + val = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); xset (val, "string", v); } @@ -3572,10 +4126,17 @@ delete_children (true); - xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, false); - ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, false); - zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, false); - title = gh_manager::make_graphics_handle ("text", __myhandle__, false); + xlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + ylabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + zlabel = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); + + title = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); xset (xlabel.handle_value (), "handlevisibility", "off"); xset (ylabel.handle_value (), "handlevisibility", "off"); @@ -3645,7 +4206,8 @@ if (! is_beingdeleted ()) { - hp = gh_manager::make_graphics_handle ("text", __myhandle__, false); + hp = gh_manager::make_graphics_handle ("text", __myhandle__, + false, false); xset (hp.handle_value (), "handlevisibility", "off"); @@ -4140,8 +4702,6 @@ frame.protect_var (updating_axes_layout); updating_axes_layout = true; - update_ticklengths (); - xySym = (xd*yd*(xPlane-xPlaneN)*(yPlane-yPlaneN) > 0); zSign = (zd*(zPlane-zPlaneN) <= 0); xyzSym = zSign ? xySym : !xySym; @@ -4187,6 +4747,8 @@ Matrix viewmat = get_view ().matrix_value (); nearhoriz = std::abs(viewmat(1)) <= 5; + + update_ticklengths (); } void @@ -4223,15 +4785,22 @@ update_title_position (); } +static bool updating_xlabel_position = false; + void axes::properties::update_xlabel_position (void) { + if (updating_xlabel_position) + return; + text::properties& xlabel_props = reinterpret_cast<text::properties&> (gh_manager::get_object (get_xlabel ()).get_properties ()); - bool is_empty = xlabel_props.get_string ().empty (); - - xlabel_props.set_autopos_tag ("none"); + bool is_empty = xlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_xlabel_position); + updating_xlabel_position = true; if (! is_empty) { @@ -4305,19 +4874,24 @@ xlabel_props.set_rotationmode ("auto"); } } - - xlabel_props.set_autopos_tag ("xlabel"); -} +} + +static bool updating_ylabel_position = false; void axes::properties::update_ylabel_position (void) { + if (updating_ylabel_position) + return; + text::properties& ylabel_props = reinterpret_cast<text::properties&> (gh_manager::get_object (get_ylabel ()).get_properties ()); - bool is_empty = ylabel_props.get_string ().empty (); - - ylabel_props.set_autopos_tag ("none"); + bool is_empty = ylabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_ylabel_position); + updating_ylabel_position = true; if (! is_empty) { @@ -4391,20 +4965,25 @@ ylabel_props.set_rotationmode ("auto"); } } - - ylabel_props.set_autopos_tag ("ylabel"); -} +} + +static bool updating_zlabel_position = false; void axes::properties::update_zlabel_position (void) { + if (updating_zlabel_position) + return; + text::properties& zlabel_props = reinterpret_cast<text::properties&> (gh_manager::get_object (get_zlabel ()).get_properties ()); bool camAuto = cameraupvectormode_is ("auto"); - bool is_empty = zlabel_props.get_string ().empty (); - - zlabel_props.set_autopos_tag ("none"); + bool is_empty = zlabel_props.get_string ().is_empty (); + + unwind_protect frame; + frame.protect_var (updating_zlabel_position); + updating_zlabel_position = true; if (! is_empty) { @@ -4499,17 +5078,22 @@ zlabel_props.set_rotationmode ("auto"); } } - - zlabel_props.set_autopos_tag ("zlabel"); -} +} + +static bool updating_title_position = false; void axes::properties::update_title_position (void) { + if (updating_title_position) + return; + text::properties& title_props = reinterpret_cast<text::properties&> (gh_manager::get_object (get_title ()).get_properties ()); - title_props.set_autopos_tag ("none"); + unwind_protect frame; + frame.protect_var (updating_title_position); + updating_title_position = true; if (title_props.positionmode_is ("auto")) { @@ -4523,8 +5107,6 @@ title_props.set_position (p.extract_n(0, 3).transpose ()); title_props.set_positionmode ("auto"); } - - title_props.set_autopos_tag ("title"); } void @@ -4566,7 +5148,8 @@ double minval = octave_Inf; double maxval = -octave_Inf; double min_pos = octave_Inf; - get_children_limits (minval, maxval, min_pos, kids, limit_type); + double max_neg = -octave_Inf; + get_children_limits (minval, maxval, min_pos, max_neg, kids, limit_type); if (!xisinf (minval) && !xisnan (minval) && !xisinf (maxval) && !xisnan (maxval)) { @@ -4693,23 +5276,43 @@ } } +void +axes::properties::update_font (void) +{ +#ifdef HAVE_FREETYPE +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get ("fontname").string_value (), + get ("fontweight").string_value (), + get ("fontangle").string_value (), + get ("fontsize").double_value ()); +#endif +#endif +} + // The INTERNAL flag defines whether position or outerposition is used. Matrix -axes::properties::get_boundingbox (bool internal) const -{ - graphics_object obj = gh_manager::get_object (get_parent ()); - Matrix parent_bb = obj.get_properties ().get_boundingbox (true); +axes::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ Matrix pos = (internal ? get_position ().matrix_value () : get_outerposition ().matrix_value ()); - - pos = convert_position (pos, get_units (), "pixels", - parent_bb.extract_n (0, 2, 1, 2)); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); pos(0)--; pos(1)--; - pos(1) = parent_bb(3) - pos(1) - pos(3); + pos(1) = parent_size(1) - pos(1) - pos(3); return pos; } @@ -4756,7 +5359,7 @@ Matrix text_pos = text_props.get_position ().matrix_value (); text_pos = xform.transform (text_pos(0), text_pos(1), text_pos(2)); - if (text_props.get_string ().empty ()) + if (text_props.get_string ().is_empty ()) { ext(0) = std::min (ext(0), text_pos(0)); ext(1) = std::min (ext(1), text_pos(1)); @@ -4795,7 +5398,7 @@ ext(2) = ext(2)-ext(0); ext(3) = ext(3)-ext(1); - + return ext; } @@ -4842,31 +5445,26 @@ axes::properties::update_fontunits (const caseless_str& old_units) { caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (true).elem (3); double fsz = get_fontsize (); - double pixelsperinch = xget (0, "screenpixelsperinch").double_value(); - double parent_height = get_boundingbox (true).elem (3); - - if (old_units.compare ("normalized")) - fsz = fsz * parent_height * 72 / pixelsperinch; - else if (old_units.compare ("pixels")) - fsz = fsz * 72 / pixelsperinch; - else if (old_units.compare ("inches")) - fsz = fsz * 72; - else if (old_units.compare ("centimeters")) - fsz = fsz * 72 / 2.54; - - if (new_units.compare ("normalized")) - fsz = fsz * pixelsperinch / parent_height / 72; - else if (new_units.compare ("pixels")) - fsz = fsz * pixelsperinch / 72; - else if (new_units.compare ("inches")) - fsz = fsz / 72; - else if (new_units.compare ("centimeters")) - fsz = fsz * 2.54 / 72; + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); set_fontsize (octave_value (fsz)); } +double +axes::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (true).elem(3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + ColumnVector graphics_xform::xform_vector (double x, double y, double z) { @@ -4929,7 +5527,8 @@ // FIXME -- maybe this should go into array_property class? /* static void -check_limit_vals (double& min_val, double& max_val, double& min_pos, +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, const array_property& data) { double val = data.min_val (); @@ -4941,18 +5540,22 @@ val = data.min_pos (); if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) min_pos = val; + val = data.max_neg (); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; } */ static void -check_limit_vals (double& min_val, double& max_val, double& min_pos, +check_limit_vals (double& min_val, double& max_val, + double& min_pos, double& max_neg, const octave_value& data) { if (data.is_matrix_type ()) { Matrix m = data.matrix_value (); - if (! error_state && m.numel () == 3) + if (! error_state && m.numel () == 4) { double val; @@ -4967,6 +5570,10 @@ val = m(2); if (! (xisinf (val) || xisnan (val)) && val > 0 && val < min_pos) min_pos = val; + + val = m(3); + if (! (xisinf (val) || xisnan (val)) && val < 0 && val > max_neg) + max_neg = val; } } } @@ -4984,8 +5591,8 @@ } else { - b = static_cast<int> (gnulib::floor (std::log10 (std::abs (x)))); - a = x / std::pow (10.0, b); + b = static_cast<int> (gnulib::floor (std::log10 (std::abs (x)))); + a = x / std::pow (10.0, b); } } @@ -5031,24 +5638,34 @@ Matrix axes::properties::get_axis_limits (double xmin, double xmax, - double min_pos, bool logscale) + double min_pos, double max_neg, + bool logscale) { Matrix retval; double min_val = xmin; double max_val = xmax; - if (! (xisinf (min_val) || xisinf (max_val))) + if (xisinf (min_val) && min_val > 0 && xisinf (max_val) && max_val < 0) + { + retval = default_lim (logscale); + return retval; + } + else if (! (xisinf (min_val) || xisinf (max_val))) { if (logscale) { - if (xisinf (min_pos)) + if (xisinf (min_pos) && xisinf (max_neg)) { - // warning ("axis: logscale with no positive values to plot"); + // TODO -- max_neg is needed for "loglog ([0 -Inf])" + // This is the only place where max_neg is needed. + // Is there another way? + retval = default_lim (); + retval(0) = pow (10., retval(0)); + retval(1) = pow (10., retval(1)); return retval; } - - if (min_val <= 0) + if ((min_val <= 0 && max_val > 0)) { warning ("axis: omitting nonpositive data in log plot"); min_val = min_pos; @@ -5059,8 +5676,18 @@ min_val *= 0.9; max_val *= 1.1; } - min_val = pow (10, gnulib::floor (log10 (min_val))); - max_val = pow (10, std::ceil (log10 (max_val))); + if (min_val > 0) + { + // Log plots with all positive data + min_val = pow (10, gnulib::floor (log10 (min_val))); + max_val = pow (10, std::ceil (log10 (max_val))); + } + else + { + // Log plots with all negative data + min_val = -pow (10, std::ceil (log10 (-min_val))); + max_val = -pow (10, gnulib::floor (log10 (-max_val))); + } } else { @@ -5106,19 +5733,29 @@ double lo = (lims.get ().matrix_value ()) (0); double hi = (lims.get ().matrix_value ()) (1); + bool is_negative = lo < 0 && hi < 0; + double tmp; // FIXME should this be checked for somewhere else? (i.e. set{x,y,z}lim) if (hi < lo) { - double tmp = hi; + tmp = hi; hi = lo; lo = tmp; } if (is_logscale) { - // FIXME we should check for negtives here - hi = std::log10 (hi); - lo = std::log10 (lo); + if (is_negative) + { + tmp = hi; + hi = std::log10 (-lo); + lo = std::log10 (-tmp); + } + else + { + hi = std::log10 (hi); + lo = std::log10 (lo); + } } double tick_sep = calc_tick_sep (lo , hi); @@ -5147,6 +5784,12 @@ tmp_lims(1) = std::pow (10.,tmp_lims(1)); if (tmp_lims(0) <= 0) tmp_lims(0) = std::pow (10., lo); + if (is_negative) + { + tmp = tmp_lims(0); + tmp_lims(0) = -tmp_lims(1); + tmp_lims(1) = -tmp; + } } lims = tmp_lims; } @@ -5164,6 +5807,13 @@ if (is_logscale) tmp_ticks (i) = std::pow (10., tmp_ticks (i)); } + if (is_logscale && is_negative) + { + Matrix rev_ticks (1, i2-i1+1); + rev_ticks = -tmp_ticks; + for (int i = 0; i <= i2-i1; i++) + tmp_ticks (i) = rev_ticks (i2-i1-i); + } ticks = tmp_ticks; @@ -5183,17 +5833,55 @@ void axes::properties::calc_ticklabels (const array_property& ticks, - any_property& labels, bool /*logscale*/) + any_property& labels, bool logscale) { Matrix values = ticks.get ().matrix_value (); Cell c (values.dims ()); std::ostringstream os; - for (int i = 0; i < values.numel (); i++) - { - os.str (std::string ()); - os << values(i); - c(i) = os.str (); + if (logscale) + { + double significand; + double exponent; + double exp_max = 0.; + double exp_min = 0.; + + for (int i = 0; i < values.numel (); i++) + { + exp_max = std::max (exp_max, std::log10 (values(i))); + exp_min = std::max (exp_min, std::log10 (values(i))); + } + + for (int i = 0; i < values.numel (); i++) + { + if (values(i) < 0.) + exponent = gnulib::floor (std::log10 (-values(i))); + else + exponent = gnulib::floor (std::log10 (values(i))); + significand = values(i) * std::pow (10., -exponent); + os.str (std::string ()); + os << significand; + if (exponent < 0.) + { + os << "e-"; + exponent = -exponent; + } + else + os << "e+"; + if (exponent < 10. && (exp_max > 9 || exp_min < -9)) + os << "0"; + os << exponent; + c(i) = os.str (); + } + } + else + { + for (int i = 0; i < values.numel (); i++) + { + os.str (std::string ()); + os << values(i); + c(i) = os.str (); + } } labels = c; @@ -5204,14 +5892,7 @@ const string_vector& ticklabels, const Matrix& limits) { -#ifdef HAVE_FREETYPE - //FIXME: text_renderer could be cached - ft_render text_renderer; - text_renderer.set_font (get ("fontname").string_value (), - get ("fontweight").string_value (), - get ("fontangle").string_value (), - get ("fontsize").double_value ()); -#else +#ifndef HAVE_FREETYPE double fontsize = get ("fontsize").double_value (); #endif @@ -5242,7 +5923,8 @@ } void -get_children_limits (double& min_val, double& max_val, double& min_pos, +get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, const Matrix& kids, char limit_type) { octave_idx_type n = kids.numel (); @@ -5258,7 +5940,7 @@ { octave_value lim = obj.get_xlim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5272,7 +5954,7 @@ { octave_value lim = obj.get_ylim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5286,7 +5968,7 @@ { octave_value lim = obj.get_zlim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5300,7 +5982,7 @@ { octave_value lim = obj.get_clim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5314,7 +5996,7 @@ { octave_value lim = obj.get_alim (); - check_limit_vals (min_val, max_val, min_pos, lim); + check_limit_vals (min_val, max_val, min_pos, max_neg, lim); } } break; @@ -5338,6 +6020,7 @@ double min_val = octave_Inf; double max_val = -octave_Inf; double min_pos = octave_Inf; + double max_neg = -octave_Inf; char update_type = 0; @@ -5345,7 +6028,7 @@ double val; #define FIX_LIMITS \ - if (limits.numel() == 3) \ + if (limits.numel() == 4) \ { \ val = limits(0); \ if (! (xisinf (val) || xisnan (val))) \ @@ -5356,13 +6039,17 @@ val = limits(2); \ if (! (xisinf (val) || xisnan (val))) \ min_pos = val; \ + val = limits(3); \ + if (! (xisinf (val) || xisnan (val))) \ + max_neg = val; \ } \ else \ { \ - limits.resize(3, 1); \ + limits.resize(4, 1); \ limits(0) = min_val; \ limits(1) = max_val; \ limits(2) = min_pos; \ + limits(3) = max_neg; \ } if (axis_type == "xdata" || axis_type == "xscale" @@ -5374,9 +6061,10 @@ limits = xproperties.get_xlim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.xscale_is ("log")); update_type = 'x'; @@ -5391,9 +6079,10 @@ limits = xproperties.get_ylim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.yscale_is ("log")); update_type = 'y'; @@ -5408,9 +6097,10 @@ limits = xproperties.get_zlim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.zscale_is ("log")); update_type = 'z'; @@ -5425,7 +6115,7 @@ limits = xproperties.get_clim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'c'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); if (min_val > max_val) { @@ -5433,7 +6123,10 @@ max_val = 1; } else if (min_val == max_val) - max_val = min_val + 1; + { + max_val = min_val + 1; + min_val -= 1; + } limits.resize (1, 2); @@ -5453,7 +6146,7 @@ limits = xproperties.get_alim ().matrix_value (); FIX_LIMITS ; - get_children_limits (min_val, max_val, min_pos, kids, 'a'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); if (min_val > max_val) { @@ -5529,6 +6222,7 @@ double min_val = octave_Inf; double max_val = -octave_Inf; double min_pos = octave_Inf; + double max_neg = -octave_Inf; char update_type = 0; @@ -5540,9 +6234,10 @@ { if (xproperties.xlimmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'x'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.xscale_is ("log")); update_type = 'x'; @@ -5554,9 +6249,10 @@ { if (xproperties.ylimmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'y'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.yscale_is ("log")); update_type = 'y'; @@ -5568,9 +6264,10 @@ { if (xproperties.zlimmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'z'); - - limits = xproperties.get_axis_limits (min_val, max_val, min_pos, + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); + + limits = xproperties.get_axis_limits (min_val, max_val, + min_pos, max_neg, xproperties.zscale_is ("log")); update_type = 'z'; @@ -5582,7 +6279,7 @@ { if (xproperties.climmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'c'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); if (min_val > max_val) { @@ -5590,7 +6287,10 @@ max_val = 1; } else if (min_val == max_val) - max_val = min_val + 1; + { + max_val = min_val + 1; + min_val -= 1; + } limits.resize (1, 2); @@ -5607,7 +6307,7 @@ { if (xproperties.alimmode_is ("auto")) { - get_children_limits (min_val, max_val, min_pos, kids, 'a'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); if (min_val > max_val) { @@ -5693,12 +6393,14 @@ double minx = octave_Inf; double maxx = -octave_Inf; double min_pos_x = octave_Inf; - get_children_limits (minx, maxx, min_pos_x, kids, 'x'); + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); double miny = octave_Inf; double maxy = -octave_Inf; double min_pos_y = octave_Inf; - get_children_limits (miny, maxy, min_pos_y, kids, 'y'); + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); // Perform the zooming xlims (0) = x + factor * (xlims (0) - x); @@ -5742,12 +6444,14 @@ double minx = octave_Inf; double maxx = -octave_Inf; double min_pos_x = octave_Inf; - get_children_limits (minx, maxx, min_pos_x, kids, 'x'); + double max_neg_x = -octave_Inf; + get_children_limits (minx, maxx, min_pos_x, max_neg_x, kids, 'x'); double miny = octave_Inf; double maxy = -octave_Inf; double min_pos_y = octave_Inf; - get_children_limits (miny, maxy, min_pos_y, kids, 'y'); + double max_neg_y = -octave_Inf; + get_children_limits (miny, maxy, min_pos_y, max_neg_y, kids, 'y'); xlims (0) += delta_x; xlims (1) += delta_x; @@ -5810,16 +6514,28 @@ ::reset_default_properties (default_properties); } +void +axes::initialize (const graphics_object& go) +{ + base_graphics_object::initialize (go); + + xinitialize (xproperties.get_title ()); + xinitialize (xproperties.get_xlabel ()); + xinitialize (xproperties.get_ylabel ()); + xinitialize (xproperties.get_zlabel ()); +} + // --------------------------------------------------------------------- Matrix line::properties::compute_xlim (void) const { - Matrix m (1, 3); + Matrix m (1, 4); m(0) = xdata.min_val (); m(1) = xdata.max_val (); m(2) = xdata.min_pos (); + m(3) = xdata.max_neg (); return m; } @@ -5827,11 +6543,12 @@ Matrix line::properties::compute_ylim (void) const { - Matrix m (1, 3); + Matrix m (1, 4); m(0) = ydata.min_val (); m(1) = ydata.max_val (); m(2) = ydata.min_pos (); + m(3) = ydata.max_neg (); return m; } @@ -5864,11 +6581,9 @@ } void -text::properties::update_text_extent (void) +text::properties::update_font (void) { #ifdef HAVE_FREETYPE - - // FIXME: font and color should be set only when modified, for efficiency #ifdef HAVE_FONTCONFIG renderer.set_font (get ("fontname").string_value (), get ("fontweight").string_value (), @@ -5876,6 +6591,13 @@ get ("fontsize").double_value ()); #endif renderer.set_color (get_color_rgb ()); +#endif +} + +void +text::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE int halign = 0, valign = 0; @@ -5892,11 +6614,17 @@ valign = 1; Matrix bbox; + // FIXME: string should be parsed only when modified, for efficiency - renderer.text_to_pixels (get_string (), pixels, bbox, + + octave_value string_prop = get_string (); + + string_vector sv = string_prop.all_strings (); + + renderer.text_to_pixels (sv.join ("\n"), pixels, bbox, halign, valign, get_rotation ()); - set_extent (bbox); + #endif if (autopos_tag_is ("xlabel") || autopos_tag_is ("ylabel") || @@ -5941,6 +6669,23 @@ cached_units = get_units (); } +double +text::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + { + graphics_object go (gh_manager::get_object (get___myhandle__ ())); + graphics_object ax (go.get_ancestor ("axes")); + + parent_height = ax.get_properties ().get_boundingbox (true).elem(3); + } + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + // --------------------------------------------------------------------- octave_value @@ -6102,6 +6847,7 @@ double min_val = octave_Inf; double max_val = -octave_Inf; double min_pos = octave_Inf; + double max_neg = -octave_Inf; Matrix limits; double val; @@ -6134,7 +6880,7 @@ update_type = 'a'; } - if (limits.numel() == 3) + if (limits.numel() == 4) { val = limits(0); if (! (xisinf (val) || xisnan (val))) @@ -6145,27 +6891,33 @@ val = limits(2); if (! (xisinf (val) || xisnan (val))) min_pos = val; + val = limits(3); + if (! (xisinf (val) || xisnan (val))) + max_neg = val; } else { - limits.resize(3,1); + limits.resize(4,1); limits(0) = min_val; limits(1) = max_val; limits(2) = min_pos; - } - - get_children_limits (min_val, max_val, min_pos, kids, update_type); + limits(3) = max_neg; + } + + get_children_limits (min_val, max_val, min_pos, max_neg, kids, update_type); unwind_protect frame; frame.protect_var (updating_hggroup_limits); updating_hggroup_limits = true; - if (limits(0) != min_val || limits(1) != max_val || limits(2) != min_pos) + if (limits(0) != min_val || limits(1) != max_val + || limits(2) != min_pos || limits(3) != max_neg) { limits(0) = min_val; limits(1) = max_val; limits(2) = min_pos; + limits(3) = max_neg; switch (update_type) { @@ -6208,36 +6960,37 @@ double min_val = octave_Inf; double max_val = -octave_Inf; double min_pos = octave_Inf; + double max_neg = -octave_Inf; char update_type = 0; if (axis_type == "xlim" || axis_type == "xliminclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'x'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'x'); update_type = 'x'; } else if (axis_type == "ylim" || axis_type == "yliminclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'y'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'y'); update_type = 'y'; } else if (axis_type == "zlim" || axis_type == "zliminclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'z'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'z'); update_type = 'z'; } else if (axis_type == "clim" || axis_type == "climinclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'c'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'c'); update_type = 'c'; } else if (axis_type == "alim" || axis_type == "aliminclude") { - get_children_limits (min_val, max_val, min_pos, kids, 'a'); + get_children_limits (min_val, max_val, min_pos, max_neg, kids, 'a'); update_type = 'a'; } @@ -6247,11 +7000,12 @@ updating_hggroup_limits = true; - Matrix limits (1, 3, 0.0); + Matrix limits (1, 4, 0.0); limits(0) = min_val; limits(1) = max_val; limits(2) = min_pos; + limits(3) = max_neg; switch (update_type) { @@ -6285,6 +7039,301 @@ // --------------------------------------------------------------------- octave_value +uicontrol::properties::get_extent (void) const +{ + Matrix m = extent.get ().matrix_value (); + + graphics_object parent_obj = + gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + return convert_position (m, "pixels", get_units (), parent_size); +} + +void +uicontrol::properties::update_text_extent (void) +{ +#ifdef HAVE_FREETYPE + + text_element *elt; + ft_render text_renderer; + Matrix box; + + // FIXME: parsed content should be cached for efficiency + // FIXME: support multiline text + + elt = text_parser_none ().parse (get_string_string ()); +#ifdef HAVE_FONTCONFIG + text_renderer.set_font (get_fontname (), + get_fontweight (), + get_fontangle (), + get_fontsize ()); +#endif + box = text_renderer.get_extent (elt, 0); + + Matrix ext (1, 4, 0.0); + + // FIXME: also handle left and bottom components + + ext(0) = ext(1) = 1; + ext(2) = box(0); + ext(3) = box(1); + + set_extent (ext); + +#endif +} + +void +uicontrol::properties::update_units (void) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, cached_units, get_units (), parent_size); + set_position (pos); + + cached_units = get_units (); +} + +void +uicontrol::properties::set_style (const octave_value& st) +{ + if (get___object__ ().is_empty()) + style = st; + else + error ("set: cannot change the style of a uicontrol object after creation."); +} + +Matrix +uicontrol::properties::get_boundingbox (bool, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + return pos; +} + +void +uicontrol::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uicontrol::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + fontsize.set (octave_value (fsz), true); +} + +double +uicontrol::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem(3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +Matrix +uipanel::properties::get_boundingbox (bool internal, + const Matrix& parent_pix_size) const +{ + Matrix pos = get_position ().matrix_value (); + Matrix parent_size (parent_pix_size); + + if (parent_size.numel () == 0) + { + graphics_object obj = gh_manager::get_object (get_parent ()); + + parent_size = + obj.get_properties ().get_boundingbox (true).extract_n (0, 2, 1, 2); + } + + pos = convert_position (pos, get_units (), "pixels", parent_size); + + pos(0)--; + pos(1)--; + pos(1) = parent_size(1) - pos(1) - pos(3); + + if (internal) + { + double outer_height = pos(3); + + pos(0) = pos(1) = 0; + + if (! bordertype_is ("none")) + { + double bw = get_borderwidth (); + double mul = 1.0; + + if (bordertype_is ("etchedin") || bordertype_is ("etchedout")) + mul = 2.0; + + pos(0) += mul * bw; + pos(1) += mul * bw; + pos(2) -= 2 * mul * bw; + pos(3) -= 2 * mul * bw; + } + + if (! get_title ().empty ()) + { + double fs = get_fontsize (); + + if (! fontunits_is ("pixels")) + { + double res = xget (0, "screenpixelsperinch").double_value (); + + if (fontunits_is ("points")) + fs *= (res / 72.0); + else if (fontunits_is ("inches")) + fs *= res; + else if (fontunits_is ("centimeters")) + fs *= (res / 2.54); + else if (fontunits_is ("normalized")) + fs *= outer_height; + } + + if (titleposition_is ("lefttop") || titleposition_is ("centertop") + || titleposition_is ("righttop")) + pos(1) += (fs / 2); + pos(3) -= (fs / 2); + } + } + + return pos; +} + +void +uipanel::properties::set_units (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_units = get_units (); + if (units.set (v, true)) + { + update_units (old_units); + mark_modified (); + } + } +} + +void +uipanel::properties::update_units (const caseless_str& old_units) +{ + Matrix pos = get_position ().matrix_value (); + + graphics_object parent_obj = gh_manager::get_object (get_parent ()); + Matrix parent_bbox = parent_obj.get_properties ().get_boundingbox (true), + parent_size = parent_bbox.extract_n (0, 2, 1, 2); + + pos = convert_position (pos, old_units, get_units (), parent_size); + set_position (pos); +} + +void +uipanel::properties::set_fontunits (const octave_value& v) +{ + if (! error_state) + { + caseless_str old_fontunits = get_fontunits (); + if (fontunits.set (v, true)) + { + update_fontunits (old_fontunits); + mark_modified (); + } + } +} + +void +uipanel::properties::update_fontunits (const caseless_str& old_units) +{ + caseless_str new_units = get_fontunits (); + double parent_height = get_boundingbox (false).elem (3); + double fsz = get_fontsize (); + + fsz = convert_font_size (fsz, old_units, new_units, parent_height); + + set_fontsize (octave_value (fsz)); +} + +double +uipanel::properties::get_fontsize_points (double box_pix_height) const +{ + double fs = get_fontsize (); + double parent_height = box_pix_height; + + if (fontunits_is ("normalized") && parent_height <= 0) + parent_height = get_boundingbox (false).elem(3); + + return convert_font_size (fs, get_fontunits (), "points", parent_height); +} + +// --------------------------------------------------------------------- + +octave_value +uitoolbar::get_default (const caseless_str& name) const +{ + octave_value retval = default_properties.lookup (name); + + if (retval.is_undefined ()) + { + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (parent); + + retval = parent_obj.get_default (name); + } + + return retval; +} + +void +uitoolbar::reset_default_properties (void) +{ + ::reset_default_properties (default_properties); +} + +// --------------------------------------------------------------------- + +octave_value base_graphics_object::get_default (const caseless_str& name) const { graphics_handle parent = get_parent (); @@ -6306,7 +7355,8 @@ gh_manager::gh_manager (void) : handle_map (), handle_free_list (), next_handle (-1.0 - (rand () + 1.0) / (RAND_MAX + 2.0)), - figure_list (), graphics_lock (), event_queue (), callback_objects () + figure_list (), graphics_lock (), event_queue (), + callback_objects (), event_processing (0) { handle_map[0] = graphics_object (new root_figure ()); @@ -6316,9 +7366,12 @@ graphics_handle gh_manager::do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, bool do_createfcn) -{ - graphics_handle h = get_handle (go_name); + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit) +{ + graphics_handle h = get_handle (integer_figure_handle); base_graphics_object *go = 0; @@ -6333,9 +7386,8 @@ go->get_properties ().execute_createfcn (); // Notify graphics toolkit. - graphics_toolkit toolkit = go->get_toolkit (); - if (toolkit) - toolkit.initialize (obj); + if (do_notify_toolkit) + obj.initialize (); } else error ("gh_manager::do_make_graphics_handle: invalid object type `%s'", @@ -6345,7 +7397,7 @@ } graphics_handle -gh_manager::do_make_figure_handle (double val) +gh_manager::do_make_figure_handle (double val, bool do_notify_toolkit) { graphics_handle h = val; @@ -6355,9 +7407,8 @@ handle_map[h] = obj; // Notify graphics toolkit. - graphics_toolkit toolkit = go->get_toolkit (); - if (toolkit) - toolkit.initialize (obj); + if (do_notify_toolkit) + obj.initialize (); return h; } @@ -6392,11 +7443,19 @@ callback_event (const graphics_handle& h, const std::string& name, const octave_value& data = Matrix ()) : base_graphics_event (), handle (h), callback_name (name), - callback_data (data) { } + callback (), callback_data (data) { } + + callback_event (const graphics_handle& h, const octave_value& cb, + const octave_value& data = Matrix ()) + : base_graphics_event (), handle (h), callback_name (), + callback (cb), callback_data (data) { } void execute (void) { - gh_manager::execute_callback (handle, callback_name, callback_data); + if (callback.is_defined ()) + gh_manager::execute_callback (handle, callback, callback_data); + else + gh_manager::execute_callback (handle, callback_name, callback_data); } private: @@ -6408,6 +7467,7 @@ private: graphics_handle handle; std::string callback_name; + octave_value callback; octave_value callback_data; }; @@ -6445,15 +7505,23 @@ { public: set_event (const graphics_handle& h, const std::string& name, - const octave_value& value) + const octave_value& value, bool do_notify_toolkit = true) : base_graphics_event (), handle (h), property_name (name), - property_value (value) { } + property_value (value), notify_toolkit (do_notify_toolkit) { } void execute (void) { - gh_manager::autolock guard; - - xset (handle, property_name, property_value); + gh_manager::auto_lock guard; + + graphics_object go = gh_manager::get_object (handle); + + if (go) + { + property p = go.get_properties ().get_property (property_name); + + if (p.ok ()) + p.set (property_value, true, notify_toolkit); + } } private: @@ -6465,6 +7533,7 @@ graphics_handle handle; std::string property_name; octave_value property_value; + bool notify_toolkit; }; graphics_event @@ -6480,6 +7549,18 @@ } graphics_event +graphics_event::create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data) +{ + graphics_event e; + + e.rep = new callback_event (h, cb, data); + + return e; +} + +graphics_event graphics_event::create_function_event (graphics_event::event_fcn fcn, void *data) { @@ -6493,11 +7574,12 @@ graphics_event graphics_event::create_set_event (const graphics_handle& h, const std::string& name, - const octave_value& data) + const octave_value& data, + bool notify_toolkit) { graphics_event e; - e.rep = new set_event (h, name, data); + e.rep = new set_event (h, name, data, notify_toolkit); return e; } @@ -6515,7 +7597,7 @@ void gh_manager::do_restore_gcbo (void) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; callback_objects.pop_front (); @@ -6525,69 +7607,86 @@ } void +gh_manager::do_execute_listener (const graphics_handle& h, + const octave_value& l) +{ + if (octave_thread::is_octave_thread ()) + gh_manager::execute_callback (h, l, octave_value ()); + else + { + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_callback_event (h, l)); + } +} + +void gh_manager::do_execute_callback (const graphics_handle& h, const octave_value& cb_arg, const octave_value& data) { - octave_value_list args; - octave_function *fcn = 0; - - args(0) = h.as_octave_value (); - if (data.is_defined ()) - args(1) = data; - else - args(1) = Matrix (); - - unwind_protect_safe frame; - frame.add_fcn (gh_manager::restore_gcbo); - - if (true) - { - gh_manager::autolock guard; - - callback_objects.push_front (get_object (h)); - xset_gcbo (h); - } - - BEGIN_INTERRUPT_WITH_EXCEPTIONS; - - // Copy CB because "function_value" method is non-const. - - octave_value cb = cb_arg; - - if (cb.is_function_handle ()) - fcn = cb.function_value (); - else if (cb.is_string ()) - { - int status; - std::string s = cb.string_value (); - - eval_string (s, false, status); - } - else if (cb.is_cell () && cb.length () > 0 - && (cb.rows () == 1 || cb.columns () == 1) - && cb.cell_value ()(0).is_function_handle ()) - { - Cell c = cb.cell_value (); - - fcn = c(0).function_value (); - if (! error_state) - { - for (int i = 1; i < c.length () ; i++) - args(1+i) = c(i); - } - } - else - { - std::string nm = cb.class_name (); - error ("trying to execute non-executable object (class = %s)", - nm.c_str ()); - } - - if (fcn && ! error_state) - feval (fcn, args); - - END_INTERRUPT_WITH_EXCEPTIONS; + if (cb_arg.is_defined () && ! cb_arg.is_empty ()) + { + octave_value_list args; + octave_function *fcn = 0; + + args(0) = h.as_octave_value (); + if (data.is_defined ()) + args(1) = data; + else + args(1) = Matrix (); + + unwind_protect_safe frame; + frame.add_fcn (gh_manager::restore_gcbo); + + if (true) + { + gh_manager::auto_lock guard; + + callback_objects.push_front (get_object (h)); + xset_gcbo (h); + } + + BEGIN_INTERRUPT_WITH_EXCEPTIONS; + + // Copy CB because "function_value" method is non-const. + + octave_value cb = cb_arg; + + if (cb.is_function_handle ()) + fcn = cb.function_value (); + else if (cb.is_string ()) + { + int status; + std::string s = cb.string_value (); + + eval_string (s, false, status); + } + else if (cb.is_cell () && cb.length () > 0 + && (cb.rows () == 1 || cb.columns () == 1) + && cb.cell_value ()(0).is_function_handle ()) + { + Cell c = cb.cell_value (); + + fcn = c(0).function_value (); + if (! error_state) + { + for (int i = 1; i < c.length () ; i++) + args(1+i) = c(i); + } + } + else + { + std::string nm = cb.class_name (); + error ("trying to execute non-executable object (class = %s)", + nm.c_str ()); + } + + if (fcn && ! error_state) + feval (fcn, args); + + END_INTERRUPT_WITH_EXCEPTIONS; + } } void @@ -6602,7 +7701,7 @@ gh_manager::do_post_callback (const graphics_handle& h, const std::string name, const octave_value& data) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; graphics_object go = get_object (h); @@ -6641,69 +7740,108 @@ void gh_manager::do_post_function (graphics_event::event_fcn fcn, void* fcn_data) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; do_post_event (graphics_event::create_function_event (fcn, fcn_data)); } void gh_manager::do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value) -{ - gh_manager::autolock guard; - - do_post_event (graphics_event::create_set_event (h, name, value)); + const octave_value& value, bool notify_toolkit) +{ + gh_manager::auto_lock guard; + + do_post_event (graphics_event::create_set_event (h, name, value, + notify_toolkit)); } int gh_manager::do_process_events (bool force) { graphics_event e; - - do - { - e = graphics_event (); - - gh_manager::lock (); - - if (! event_queue.empty ()) - { - if (callback_objects.empty () || force) + bool old_Vdrawnow_requested = Vdrawnow_requested; + unwind_protect frame; + + static int process_events_executing = 0; + + frame.protect_var (process_events_executing); + + if (++process_events_executing <= 1) + { + do + { + e = graphics_event (); + + gh_manager::lock (); + + if (! event_queue.empty ()) { - e = event_queue.front (); - - event_queue.pop_front (); - } - else - { - const graphics_object& go = callback_objects.front (); - - if (go.get_properties ().is_interruptible ()) + if (callback_objects.empty () || force) { e = event_queue.front (); event_queue.pop_front (); } + else + { + const graphics_object& go = callback_objects.front (); + + if (go.get_properties ().is_interruptible ()) + { + e = event_queue.front (); + + event_queue.pop_front (); + } + } } - } + + gh_manager::unlock (); + + if (e.ok ()) + e.execute (); + } + while (e.ok ()); + + gh_manager::lock (); + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); gh_manager::unlock (); - if (e.ok ()) - e.execute (); - } - while (e.ok ()); - - gh_manager::lock (); - - if (event_queue.empty ()) - command_editor::remove_event_hook (gh_manager::process_events); - - gh_manager::unlock (); + flush_octave_stdout (); + + if (Vdrawnow_requested && ! old_Vdrawnow_requested) + { + feval ("drawnow"); + + Vdrawnow_requested = false; + } + } return 0; } +void +gh_manager::do_enable_event_processing (bool enable) +{ + gh_manager::auto_lock guard; + + if (enable) + { + event_processing++; + + command_editor::add_event_hook (gh_manager::process_events); + } + else + { + event_processing--; + + if (event_queue.empty () && event_processing == 0) + command_editor::remove_event_hook (gh_manager::process_events); + } +} + property_list::plist_map_type root_figure::init_factory_properties (void) { @@ -6718,6 +7856,12 @@ plist_map["surface"] = surface::properties::factory_defaults (); plist_map["hggroup"] = hggroup::properties::factory_defaults (); plist_map["uimenu"] = uimenu::properties::factory_defaults (); + plist_map["uicontrol"] = uicontrol::properties::factory_defaults (); + plist_map["uipanel"] = uipanel::properties::factory_defaults (); + plist_map["uicontextmenu"] = uicontextmenu::properties::factory_defaults (); + plist_map["uitoolbar"] = uitoolbar::properties::factory_defaults (); + plist_map["uipushtool"] = uipushtool::properties::factory_defaults (); + plist_map["uitoggletool"] = uitoggletool::properties::factory_defaults (); return plist_map; } @@ -6734,7 +7878,7 @@ @seealso{isfigure}\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6746,6 +7890,59 @@ return retval; } +static bool +is_handle_visible (const graphics_handle& h) +{ + return h.ok () && gh_manager::is_handle_visible (h); +} + +static bool +is_handle_visible (double val) +{ + return is_handle_visible (gh_manager::lookup (val)); +} + +static octave_value +is_handle_visible (const octave_value& val) +{ + octave_value retval = false; + + if (val.is_real_scalar () && is_handle_visible (val.double_value ())) + retval = true; + else if (val.is_numeric_type () && val.is_real_type ()) + { + const NDArray handles = val.array_value (); + + if (! error_state) + { + boolNDArray result (handles.dims ()); + + for (octave_idx_type i = 0; i < handles.numel (); i++) + result.xelem (i) = is_handle_visible (handles (i)); + + retval = result; + } + } + + return retval; +} + +DEFUN (__is_handle_visible__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} __is_handle_visible__ (@var{h})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = is_handle_visible (args(0)); + else + print_usage (); + + return retval; +} + DEFUN (reset, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} reset (@var{h}, @var{property})\n\ @@ -6810,7 +8007,7 @@ @end itemize\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6898,6 +8095,21 @@ return retval; } +static std::string +get_graphics_object_type (const double val) +{ + std::string retval; + + graphics_object obj = gh_manager::get_object (val); + + if (obj) + retval = obj.type (); + else + error ("get: invalid handle (= %g)", val); + + return retval; +} + DEFUN (get, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} get (@var{h}, @var{p})\n\ @@ -6907,7 +8119,7 @@ values or lists respectively.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6917,6 +8129,12 @@ if (nargin == 1 || nargin == 2) { + if (args(0).is_empty()) + { + retval = Matrix (); + return retval; + } + ColumnVector hcv (args(0).vector_value ()); if (! error_state) @@ -6925,31 +8143,57 @@ vals.resize (dim_vector (len, 1)); - for (octave_idx_type n = 0; n < len; n++) + if (nargin == 1 && len > 1) { - graphics_object obj = gh_manager::get_object (hcv(n)); - - if (obj) + std::string t0 = get_graphics_object_type (hcv(0)); + + if (! error_state) { - if (nargin == 1) - vals(n) = obj.get (); - else + for (octave_idx_type n = 1; n < len; n++) { - caseless_str property = args(1).string_value (); - - if (! error_state) - vals(n) = obj.get (property); - else + std::string t = get_graphics_object_type (hcv(n)); + + if (error_state) + break; + + if (t != t0) { - error ("get: expecting property name as second argument"); + error ("get: vector of handles must all have same type"); break; } } + } - else + } + + if (! error_state) + { + for (octave_idx_type n = 0; n < len; n++) { - error ("get: invalid handle (= %g)", hcv(n)); - break; + graphics_object obj = gh_manager::get_object (hcv(n)); + + if (obj) + { + if (nargin == 1) + vals(n) = obj.get (); + else + { + caseless_str property = args(1).string_value (); + + if (! error_state) + vals(n) = obj.get (property); + else + { + error ("get: expecting property name as second argument"); + break; + } + } + } + else + { + error ("get: invalid handle (= %g)", hcv(n)); + break; + } } } } @@ -6967,6 +8211,15 @@ retval = Matrix (); else if (len == 1) retval = vals(0); + else if (len > 1 && nargin == 1) + { + OCTAVE_LOCAL_BUFFER (octave_scalar_map, tmp, len); + + for (octave_idx_type n = 0; n < len; n++) + tmp[n] = vals(n).scalar_map_value (); + + retval = octave_map::cat (0, len, tmp); + } else retval = vals; } @@ -6988,7 +8241,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7040,6 +8293,7 @@ static octave_value make_graphics_object (const std::string& go_name, + bool integer_figure_handle, const octave_value_list& args) { octave_value retval; @@ -7079,7 +8333,9 @@ if (parent.ok ()) { graphics_handle h - = gh_manager::make_graphics_handle (go_name, parent, false); + = gh_manager::make_graphics_handle (go_name, parent, + integer_figure_handle, + false, false); if (! error_state) { @@ -7087,6 +8343,7 @@ xset (h, xargs); xcreatefcn (h); + xinitialize (h); retval = h.value (); @@ -7112,7 +8369,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7132,21 +8389,63 @@ } else { + bool int_fig_handle = true; + + octave_value_list xargs = args.splice (0, 1); + graphics_handle h = octave_NaN; if (xisnan (val)) - h = gh_manager::make_graphics_handle ("figure", 0, false); + { + caseless_str p ("integerhandle"); + + for (int i = 0; i < xargs.length (); i++) + { + if (xargs(i).is_string () + && p.compare (xargs(i).string_value ())) + { + if (i < (xargs.length () - 1)) + { + std::string pval = xargs(i+1).string_value (); + + if (! error_state) + { + caseless_str on ("on"); + int_fig_handle = on.compare (pval); + xargs = xargs.splice (i, 2); + break; + } + } + } + } + + h = gh_manager::make_graphics_handle ("figure", 0, + int_fig_handle, + false, false); + + if (! int_fig_handle) + { + // We need to intiailize the integerhandle + // property without calling the set_integerhandle + // method, because doing that will generate a new + // handle value... + + graphics_object go = gh_manager::get_object (h); + go.get_properties ().init_integerhandle ("off"); + } + } else if (val > 0 && D_NINT (val) == val) - h = gh_manager::make_figure_handle (val); - else - error ("__go_figure__: invalid figure number"); + h = gh_manager::make_figure_handle (val, false); if (! error_state && h.ok ()) { adopt (0, h); - xset (h, args.splice (0, 1)); + gh_manager::push_figure (h); + + xset (h, xargs); xcreatefcn (h); + xinitialize (h); retval = h.value (); } @@ -7164,12 +8463,12 @@ } #define GO_BODY(TYPE) \ - gh_manager::autolock guard; \ + gh_manager::auto_lock guard; \ \ octave_value retval; \ \ if (args.length () > 0) \ - retval = make_graphics_object (#TYPE, args); \ + retval = make_graphics_object (#TYPE, false, args); \ else \ print_usage (); \ \ @@ -7215,7 +8514,7 @@ object, whether 2 or 3.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7308,13 +8607,67 @@ GO_BODY (uimenu); } +DEFUN (__go_uicontrol__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontrol__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontrol); +} + +DEFUN (__go_uipanel__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipanel__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipanel); +} + +DEFUN (__go_uicontextmenu__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uicontextmenu__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uicontextmenu); +} + +DEFUN (__go_uitoolbar__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoolbar__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoolbar); +} + +DEFUN (__go_uipushtool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uipushtool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uipushtool); +} + +DEFUN (__go_uitoggletool__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} __go_uitoggletool__ (@var{parent})\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + GO_BODY (uitoggletool); +} + DEFUN (__go_delete__, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} __go_delete__ (@var{h})\n\ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value_list retval; @@ -7392,7 +8745,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7440,26 +8793,36 @@ return retval; } -DEFUN (__go_handles__, , , +DEFUN (__go_handles__, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_handles__ ()\n\ +@deftypefn {Built-in Function} {} __go_handles__ (@var{show_hidden})\n\ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; - - return octave_value (gh_manager::handle_list ()); -} - -DEFUN (__go_figure_handles__, , , + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::handle_list (show_hidden)); +} + +DEFUN (__go_figure_handles__, args, , "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} __go_figure_handles__ ()\n\ +@deftypefn {Built-in Function} {} __go_figure_handles__ (@var{show_hidden})\n\ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; - - return octave_value (gh_manager::figure_handle_list ()); + gh_manager::auto_lock guard; + + bool show_hidden = false; + + if (args.length () > 0) + show_hidden = args(0).bool_value (); + + return octave_value (gh_manager::figure_handle_list (show_hidden)); } DEFUN (__go_execute_callback__, args, , @@ -7553,7 +8916,7 @@ Return a cell array of registered graphics toolkits.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; return octave_value (graphics_toolkit::available_toolkits_list ()); } @@ -7594,7 +8957,7 @@ if (args.length () == 0 || args.length () == 1) { - Matrix hlist = gh_manager::figure_handle_list (); + Matrix hlist = gh_manager::figure_handle_list (true); for (int i = 0; ! error_state && i < hlist.length (); i++) { @@ -7760,7 +9123,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7832,7 +9195,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7952,7 +9315,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -8010,7 +9373,7 @@ get_property_from_handle (double handle, const std::string& property, const std::string& func) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; graphics_object obj = gh_manager::get_object (handle); octave_value retval; @@ -8027,7 +9390,7 @@ set_property_in_handle (double handle, const std::string& property, const octave_value& arg, const std::string& func) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; graphics_object obj = gh_manager::get_object (handle); int ret = false;
--- a/src/graphics.h.in +++ b/src/graphics.h.in @@ -33,6 +33,7 @@ #include <list> #include <map> #include <set> +#include <sstream> #include <string> #include "caseless-str.h" @@ -220,7 +221,11 @@ { Matrix retval (m.rows (), m.cols ()); - do_scale (m.data (), retval.fortran_vec (), m.numel ()); + if (m.any_element_is_positive ()) + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + else + do_neg_scale (m.data (), retval.fortran_vec (), m.numel ()); + return retval; } @@ -228,7 +233,11 @@ { NDArray retval (m.dims ()); - do_scale (m.data (), retval.fortran_vec (), m.numel ()); + if (m.any_element_is_positive ()) + do_scale (m.data (), retval.fortran_vec (), m.numel ()); + else + do_neg_scale (m.data (), retval.fortran_vec (), m.numel ()); + return retval; } @@ -247,6 +256,12 @@ for (int i = 0; i < n; i++) dest[i] = log10(src[i]); } + + void do_neg_scale (const double *src, double *dest, int n) const + { + for (int i = 0; i < n; i++) + dest[i] = -log10(-src[i]); + } }; class scaler @@ -363,7 +378,8 @@ // Sets property value, notifies graphics toolkit. // If do_run is true, runs associated listeners. - bool set (const octave_value& v, bool do_run = true); + OCTINTERP_API bool set (const octave_value& v, bool do_run = true, + bool do_notify_toolkit = true); virtual octave_value get (void) const { @@ -598,6 +614,8 @@ Cell cell_value (void) const {return Cell (str);} + string_vector string_vector_value (void) const { return str; } + string_array_property& operator = (const octave_value& val) { set (val); @@ -692,6 +710,178 @@ // --------------------------------------------------------------------- +class text_label_property : public base_property +{ +public: + enum type { char_t, cellstr_t }; + + text_label_property (const std::string& s, const graphics_handle& h, + const std::string& val = "") + : base_property (s, h), value (val), stored_type (char_t) + { } + + text_label_property (const std::string& s, const graphics_handle& h, + const NDArray& nda) + : base_property (s, h), stored_type (char_t) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + } + + text_label_property (const std::string& s, const graphics_handle& h, + const Cell& c) + : base_property (s, h), stored_type (cellstr_t) + { + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + break; + } + } + } + + text_label_property (const text_label_property& p) + : base_property (p), value (p.value), stored_type (p.stored_type) + { } + + bool empty (void) const + { + octave_value tmp = get (); + return tmp.is_empty (); + } + + octave_value get (void) const + { + if (stored_type == char_t) + return octave_value (char_value ()); + else + return octave_value (cell_value ()); + } + + std::string string_value (void) const + { + return value.empty () ? std::string () : value[0]; + } + + string_vector string_vector_value (void) const { return value; } + + charMatrix char_value (void) const { return charMatrix (value, ' '); } + + Cell cell_value (void) const {return Cell (value); } + + text_label_property& operator = (const octave_value& val) + { + set (val); + return *this; + } + + base_property* clone (void) const { return new text_label_property (*this); } + +protected: + + bool do_set (const octave_value& val) + { + if (val.is_string ()) + { + value = val.all_strings (); + + stored_type = char_t; + } + else if (val.is_cell ()) + { + Cell c = val.cell_value (); + + octave_idx_type nel = c.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + octave_value tmp = c(i); + + if (tmp.is_string ()) + value[i] = c(i).string_value (); + else + { + double d = c(i).double_value (); + + if (! error_state) + { + std::ostringstream buf; + buf << d; + value[i] = buf.str (); + } + else + return false; + } + } + + stored_type = cellstr_t; + } + else + { + NDArray nda = val.array_value (); + + if (! error_state) + { + octave_idx_type nel = nda.numel (); + + value.resize (nel); + + for (octave_idx_type i = 0; i < nel; i++) + { + std::ostringstream buf; + buf << nda(i); + value[i] = buf.str (); + } + + stored_type = char_t; + } + else + { + error ("set: invalid string property value for \"%s\"", + get_name ().c_str ()); + + return false; + } + } + + return true; + } + +private: + string_vector value; + type stored_type; +}; + +// --------------------------------------------------------------------- + class radio_values { public: @@ -713,11 +903,11 @@ std::string default_value (void) const { return default_val; } - bool validate (const std::string& val) + bool validate (const std::string& val, std::string& match) { bool retval = true; - if (! contains (val)) + if (! contains (val, match)) { error ("invalid value = %s", val.c_str ()); retval = false; @@ -726,9 +916,46 @@ return retval; } - bool contains (const std::string& val) + bool contains (const std::string& val, std::string& match) { - return (possible_vals.find (val) != possible_vals.end ()); + size_t k = 0; + + size_t len = val.length (); + + std::string first_match; + + for (std::set<caseless_str>::const_iterator p = possible_vals.begin (); + p != possible_vals.end (); p++) + { + if (p->compare (val, len)) + { + if (len == p->length ()) + { + // We found a full match (consider the case of val == + // "replace" with possible values "replace" and + // "replacechildren"). Any other matches are + // irrelevant, so set match and return now. + + match = *p; + return true; + } + else + { + if (k == 0) + first_match = *p; + + k++; + } + } + } + + if (k == 1) + { + match = first_match; + return true; + } + else + return false; } std::string values_as_string (void) const; @@ -791,11 +1018,19 @@ if (newval.is_string ()) { std::string s = newval.string_value (); - if (vals.validate (s)) + + std::string match; + + if (vals.validate (s, match)) { - if (s != current_val) + if (match != current_val) { - current_val = s; + if (s.length () != match.length ()) + warning_with_id ("Octave:abbreviated-property-match", + "%s: allowing %s to match %s value %s", + "set", s.c_str (), get_name ().c_str (), + match.c_str ()); + current_val = match; return true; } } @@ -1115,7 +1350,8 @@ public: array_property (void) : base_property ("", graphics_handle ()), data (Matrix ()), - xmin (), xmax (), xminp (), type_constraints (), size_constraints () + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () { get_data_limits (); } @@ -1123,7 +1359,8 @@ array_property (const std::string& nm, const graphics_handle& h, const octave_value& m) : base_property (nm, h), data (m), - xmin (), xmax (), xminp (), type_constraints (), size_constraints () + xmin (), xmax (), xminp (), xmaxp (), + type_constraints (), size_constraints () { get_data_limits (); } @@ -1133,7 +1370,7 @@ // copy constraints. array_property (const array_property& p) : base_property (p), data (p.data), - xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), + xmin (p.xmin), xmax (p.xmax), xminp (p.xminp), xmaxp (p.xmaxp), type_constraints (), size_constraints () { } @@ -1148,14 +1385,16 @@ double min_val (void) const { return xmin; } double max_val (void) const { return xmax; } double min_pos (void) const { return xminp; } + double max_neg (void) const { return xmaxp; } Matrix get_limits (void) const { - Matrix m (1, 3); + Matrix m (1, 4); m(0) = min_val (); m(1) = max_val (); m(2) = min_pos (); + m(3) = max_neg (); return m; } @@ -1210,6 +1449,7 @@ double xmin; double xmax; double xminp; + double xmaxp; std::list<std::string> type_constraints; std::list<dim_vector> size_constraints; }; @@ -1471,6 +1711,21 @@ do_delete_children (clear); } + void renumber (graphics_handle old_gh, graphics_handle new_gh) + { + for (children_list_iterator p = children_list.begin (); + p != children_list.end (); p++) + { + if (*p == old_gh) + { + *p = new_gh.value (); + return; + } + } + + error ("children_list::renumber: child not found!"); + } + private: typedef std::list<double>::iterator children_list_iterator; typedef std::list<double>::const_iterator const_children_list_iterator; @@ -1587,10 +1842,10 @@ public: callback_property (const std::string& nm, const graphics_handle& h, const octave_value& m) - : base_property (nm, h), callback (m) { } + : base_property (nm, h), callback (m), executing (false) { } callback_property (const callback_property& p) - : base_property (p), callback (p.callback) { } + : base_property (p), callback (p.callback), executing (false) { } octave_value get (void) const { return callback; } @@ -1628,6 +1883,9 @@ private: octave_value callback; + + // If TRUE, we are executing this callback. + mutable bool executing; }; // --------------------------------------------------------------------- @@ -1685,8 +1943,9 @@ octave_value get (void) const { return rep->get (); } - bool set (const octave_value& val) - { return rep->set (val); } + bool set (const octave_value& val, bool do_run = true, + bool do_notify_toolkit = true) + { return rep->set (val, do_run, do_notify_toolkit); } std::string values_as_string (void) const { return rep->values_as_string (); } @@ -1855,10 +2114,10 @@ // Callback function executed when the given graphics object is // created. This allows the graphics toolkit to do toolkit-specific // initializations for a newly created object. - virtual void initialize (const graphics_object&) - { gripe_invalid ("base_graphics_toolkit::initialize"); } - - void initialize (const graphics_handle&); + virtual bool initialize (const graphics_object&) + { gripe_invalid ("base_graphics_toolkit::initialize"); return false; } + + bool initialize (const graphics_handle&); // Callback function executed just prior to deleting the given // graphics object. This allows the graphics toolkit to perform @@ -1950,11 +2209,11 @@ { rep->update (h, id); } // Notifies graphics toolkit that new object was created. - void initialize (const graphics_object& go) - { rep->initialize (go); } - - void initialize (const graphics_handle& h) - { rep->initialize (h); } + bool initialize (const graphics_object& go) + { return rep->initialize (go); } + + bool initialize (const graphics_handle& h) + { return rep->initialize (h); } // Notifies graphics toolkit that object was destroyed. // This is called only for explicitly deleted object. Children are @@ -2012,6 +2271,7 @@ // --------------------------------------------------------------------- class base_graphics_object; +class graphics_object; class OCTINTERP_API base_properties { @@ -2028,6 +2288,11 @@ void override_defaults (base_graphics_object& obj); + virtual void init_integerhandle (const octave_value&) + { + panic_impossible (); + } + // Look through DEFAULTS for properties with given CLASS_NAME, and // apply them to the current object with set (virtual method). @@ -2080,7 +2345,8 @@ virtual graphics_toolkit get_toolkit (void) const; - virtual Matrix get_boundingbox (bool /*internal*/ = false) const + virtual Matrix get_boundingbox (bool /*internal*/ = false, + const Matrix& /*parent_pix_size*/ = Matrix ()) const { return Matrix (1, 4, 0.0); } virtual void update_boundingbox (void); @@ -2131,6 +2397,16 @@ children.delete_children (clear); } + void renumber_child (graphics_handle old_gh, graphics_handle new_gh) + { + children.renumber (old_gh, new_gh); + } + + void renumber_parent (graphics_handle new_gh) + { + parent = new_gh; + } + static property_list::pval_map_type factory_defaults (void); // FIXME -- these functions should be generated automatically by the @@ -2150,10 +2426,7 @@ virtual bool is_climinclude (void) const { return false; } virtual bool is_aliminclude (void) const { return false; } - bool is_handle_visible (void) const - { - return ! handlevisibility.is ("off"); - } + bool is_handle_visible (void) const; std::set<std::string> dynamic_property_names (void) const; @@ -2224,7 +2497,7 @@ public: friend class graphics_object; - base_graphics_object (void) : count (1) { } + base_graphics_object (void) : count (1), toolkit_flag (false) { } virtual ~base_graphics_object (void) { } @@ -2385,6 +2658,8 @@ virtual bool valid_object (void) const { return false; } + bool valid_toolkit_object (void) const { return toolkit_flag; } + virtual std::string type (void) const { return (valid_object () ? get_properties ().graphics_object_name () @@ -2437,14 +2712,43 @@ } protected: + virtual void initialize (const graphics_object& go) + { + if (! toolkit_flag) + toolkit_flag = get_toolkit ().initialize (go); + } + + virtual void finalize (const graphics_object& go) + { + if (toolkit_flag) + { + get_toolkit ().finalize (go); + toolkit_flag = false; + } + } + + virtual void update (const graphics_object& go, int id) + { + if (toolkit_flag) + get_toolkit ().update (go, id); + } + +protected: // A reference count. int count; + // A flag telling whether this object is a valid object + // in the backend context. + bool toolkit_flag; + // No copying! - base_graphics_object (const base_graphics_object&); - - base_graphics_object& operator = (const base_graphics_object&); + base_graphics_object (const base_graphics_object&) : count (0) { } + + base_graphics_object& operator = (const base_graphics_object&) + { + return *this; + } }; class OCTINTERP_API graphics_object @@ -2635,6 +2939,12 @@ listener_mode mode = POSTSET) { rep->delete_property_listener (nm, v, mode); } + void initialize (void) { rep->initialize (*this); } + + void finalize (void) { rep->finalize (*this); } + + void update (int id) { rep->update (*this, id); } + void reset_default_properties (void) { rep->reset_default_properties (); } @@ -2795,6 +3105,11 @@ class OCTINTERP_API properties : public base_properties { public: + void init_integerhandle (const octave_value& val) + { + integerhandle = val; + } + void remove_child (const graphics_handle& h); void set_visible (const octave_value& val); @@ -2807,15 +3122,7 @@ return toolkit; } - void set_toolkit (const graphics_toolkit& b) - { - if (toolkit) - toolkit.finalize (__myhandle__); - toolkit = b; - __graphics_toolkit__ = b.get_name (); - __plot_stream__ = Matrix (); - mark_modified (); - } + void set_toolkit (const graphics_toolkit& b); void set___graphics_toolkit__ (const octave_value& val) { @@ -2840,9 +3147,21 @@ } } - Matrix get_boundingbox (bool internal = false) const; - - void set_boundingbox (const Matrix& bb); + void set_position (const octave_value& val, + bool do_notify_toolkit = true); + + void set_outerposition (const octave_value& val, + bool do_notify_toolkit = true); + + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + void set_boundingbox (const Matrix& bb, bool internal = false, + bool do_notify_toolkit = true); + + Matrix map_from_boundingbox (double x, double y) const; + + Matrix map_to_boundingbox (double x, double y) const; void update_units (const caseless_str& old_units); @@ -2869,7 +3188,7 @@ bool_property dockcontrols , "off" bool_property doublebuffer , "on" string_property filename , "" - bool_property integerhandle , "on" + bool_property integerhandle S , "on" bool_property inverthardcopy , "off" callback_property keypressfcn , Matrix () callback_property keyreleasefcn , Matrix () @@ -2877,6 +3196,7 @@ double_property mincolormap , 64 string_property name , "" bool_property numbertitle , "on" + array_property outerposition s , Matrix (1, 4, -1.0) radio_property paperunits Su , "{inches}|centimeters|normalized|points" array_property paperposition , default_figure_paperposition () radio_property paperpositionmode , "auto|{manual}" @@ -2885,7 +3205,7 @@ radio_property pointer , "crosshair|fullcrosshair|{arrow}|ibeam|watch|topl|topr|botl|botr|left|top|right|bottom|circle|cross|fleur|custom|hand" array_property pointershapecdata , Matrix (16, 16, 0) array_property pointershapehotspot , Matrix (1, 2, 0) - array_property position S , default_figure_position () + array_property position s , default_figure_position () radio_property renderer , "{painters}|zbuffer|opengl|none" radio_property renderermode , "{auto}|manual" bool_property resize , "on" @@ -2905,6 +3225,7 @@ radio_property xvisualmode , "{auto}|manual" callback_property buttondownfcn , Matrix () string_property __graphics_toolkit__ s , "gnuplot" + any_property __guidata__ h , Matrix () END_PROPERTIES protected: @@ -2916,6 +3237,7 @@ pointershapecdata.add_constraint (dim_vector (16, 16)); pointershapehotspot.add_constraint (dim_vector (1, 2)); position.add_constraint (dim_vector (1, 4)); + outerposition.add_constraint (dim_vector (1, 4)); } private: @@ -3096,9 +3418,12 @@ const scaler& get_y_scaler (void) const { return sy; } const scaler& get_z_scaler (void) const { return sz; } - Matrix get_boundingbox (bool internal = false) const; + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; Matrix get_extent (bool with_text = false, bool only_text_height=false) const; + double get_fontsize_points (double box_pix_height = 0) const; + void update_boundingbox (void) { if (units_is ("normalized")) @@ -3206,6 +3531,11 @@ bool x2Dtop, y2Dright, layer2Dtop; bool xySym, xyzSym, zSign, nearhoriz; +#if HAVE_FREETYPE + // freetype renderer, used for calculation of text (tick labels) size + ft_render text_renderer; +#endif + void set_text_child (handle_property& h, const std::string& who, const octave_value& v); @@ -3233,10 +3563,10 @@ radio_property zlimmode al , "{auto}|manual" radio_property climmode al , "{auto}|manual" radio_property alimmode , "{auto}|manual" - handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false) - handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false) - handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false) - handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false) + handle_property xlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) + handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false, false) bool_property xgrid , "off" bool_property ygrid , "off" bool_property zgrid , "off" @@ -3288,11 +3618,11 @@ radio_property cameraviewanglemode , "{auto}|manual" array_property currentpoint , Matrix (2, 3, 0.0) radio_property drawmode , "{normal}|fast" - radio_property fontangle , "{normal}|italic|oblique" - string_property fontname , OCTAVE_DEFAULT_FONTNAME - double_property fontsize , 10 + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 radio_property fontunits SU , "{points}|normalized|inches|centimeters|pixels" - radio_property fontweight , "{normal}|light|demi|bold" + radio_property fontweight u , "{normal}|light|demi|bold" radio_property gridlinestyle , "-|--|{:}|-.|none" string_array_property linestyleorder , "-" double_property linewidth , 0.5 @@ -3318,6 +3648,8 @@ row_vector_property zmtick h , Matrix () // hidden properties for inset array_property looseinset hu , Matrix (1, 4, 0.0) + // hidden properties for alignment of subplots + radio_property autopos_tag h , "{none}|subplot" END_PROPERTIES protected: @@ -3411,7 +3743,15 @@ calc_ticklabels (ztick, zticklabel, zscale.is ("log")); } + void update_font (void); + void update_fontname (void) { update_font (); } + void update_fontsize (void) { update_font (); } + void update_fontangle (void) { update_font (); } + void update_fontweight (void) { update_font (); } + + void sync_positions (const Matrix& linset); void sync_positions (void); + void update_outerposition (void) { set_activepositionproperty ("outerposition"); @@ -3457,7 +3797,9 @@ Matrix calc_tightbox (const Matrix& init_pos); public: - Matrix get_axis_limits (double xmin, double xmax, double min_pos, bool logscale); + Matrix get_axis_limits (double xmin, double xmax, + double min_pos, double max_neg, + bool logscale); void update_xlim (bool do_clr_zoom = true) { @@ -3582,6 +3924,9 @@ void reset_default_properties (void); +protected: + void initialize (const graphics_object& go); + private: property_list default_properties; }; @@ -3667,11 +4012,13 @@ class OCTINTERP_API properties : public base_properties { public: + double get_fontsize_points (double box_pix_height = 0) const; + // See the genprops.awk script for an explanation of the // properties declarations. BEGIN_PROPERTIES (text) - string_property string u , "" + text_label_property string u , "" radio_property units u , "{data}|pixels|normalized|inches|centimeters|points" array_property position mu , Matrix (1, 3, 0.0) double_property rotation mu , 0 @@ -3712,7 +4059,7 @@ Matrix get_extent_matrix (void) const; const uint8NDArray& get_pixels (void) const { return pixels; } #if HAVE_FREETYPE - // freetype render, used for text rendering + // freetype renderer, used for calculation of text size ft_render renderer; #endif @@ -3722,6 +4069,7 @@ position.add_constraint (dim_vector (1, 2)); position.add_constraint (dim_vector (1, 3)); cached_units = get_units (); + update_font (); } private: @@ -3757,13 +4105,14 @@ void update_horizontalalignmentmode (void) { request_autopos (); } void update_verticalalignmentmode (void) { request_autopos (); } + void update_font (void); void update_string (void) { request_autopos (); update_text_extent (); } void update_rotation (void) { update_text_extent (); } - void update_color (void) { update_text_extent (); } - void update_fontname (void) { update_text_extent (); } - void update_fontsize (void) { update_text_extent (); } - void update_fontangle (void) { update_text_extent (); } - void update_fontweight (void) { update_text_extent (); } + void update_color (void) { update_font (); } + void update_fontname (void) { update_font (); update_text_extent (); } + void update_fontsize (void) { update_font (); update_text_extent (); } + void update_fontangle (void) { update_font (); update_text_extent (); } + void update_fontweight (void) { update_font (); update_text_extent (); } void update_interpreter (void) { update_text_extent (); } void update_horizontalalignment (void) { update_text_extent (); } void update_verticalalignment (void) { update_text_extent (); } @@ -3954,7 +4303,7 @@ array_property vertices , Matrix () array_property vertexnormals , Matrix () radio_property normalmode , "{auto}|manual" - color_property facecolor , "{flat}|none|interp" + color_property facecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) double_radio_property facealpha , double_radio_property (1.0, radio_values ("flat|interp")) radio_property facelighting , "flat|{none}|gouraud|phong" color_property edgecolor , color_property (color_values (0, 0, 0), radio_values ("flat|none|interp")) @@ -4070,7 +4419,7 @@ string_property ydatasource , "" string_property zdatasource , "" string_property cdatasource , "" - color_property facecolor , "{flat}|none|interp|texturemap" + color_property facecolor , "{flat}|none|interp" 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" @@ -4286,6 +4635,7 @@ // properties declarations. BEGIN_PROPERTIES (uimenu) + any_property __object__ , Matrix () string_property accelerator , "" callback_property callback , Matrix() bool_property checked , "off" @@ -4324,6 +4674,401 @@ // --------------------------------------------------------------------- +class OCTINTERP_API uicontextmenu : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontextmenu) + any_property __object__ , Matrix () + callback_property callback , Matrix() + array_property position , Matrix (1, 2, 0.0) + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 2)); + position.add_constraint (dim_vector (2, 1)); + visible.set (octave_value (false)); + } + }; + +private: + properties xproperties; + +public: + uicontextmenu (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontextmenu (void) { xproperties.delete_children (); } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uicontrol : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uicontrol) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + callback_property callback , Matrix () + array_property cdata , Matrix () + bool_property clipping , "on" + radio_property enable , "{on}|inactive|off" + array_property extent rG , Matrix (1, 4, 0.0) + radio_property fontangle u , "{normal}|italic|oblique" + string_property fontname u , OCTAVE_DEFAULT_FONTNAME + double_property fontsize u , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight u , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + radio_property horizontalalignment , "{left}|center|right" + callback_property keypressfcn , Matrix () + double_property listboxtop , 1 + double_property max , 1 + double_property min , 0 + array_property position , default_control_position () + array_property sliderstep , default_control_sliderstep () + string_array_property string u , "" + radio_property style S , "{pushbutton}|togglebutton|radiobutton|checkbox|edit|text|slider|frame|listbox|popupmenu" + string_property tooltipstring , "" + radio_property units u , "normalized|inches|centimeters|points|{pixels}|characters" + row_vector_property value , Matrix (1, 1, 1.0) + radio_property verticalalignment , "top|{middle}|bottom" + END_PROPERTIES + + private: + std::string cached_units; + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + position.add_constraint (dim_vector (1, 4)); + sliderstep.add_constraint (dim_vector (1, 2)); + cached_units = get_units (); + } + + void update_text_extent (void); + + void update_string (void) { update_text_extent (); } + void update_fontname (void) { update_text_extent (); } + void update_fontsize (void) { update_text_extent (); } + void update_fontangle (void) { update_text_extent (); } + void update_fontweight (void) { update_text_extent (); } + void update_fontunits (const caseless_str& old_units); + + void update_units (void); + + }; + +private: + properties xproperties; + +public: + uicontrol (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uicontrol (void) { xproperties.delete_children (); } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipanel : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; + + double get_fontsize_points (double box_pix_height = 0) const; + + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipanel) + any_property __object__ , Matrix () + color_property backgroundcolor , color_values (1, 1, 1) + radio_property bordertype , "none|{etchedin}|etchedout|beveledin|beveledout|line" + double_property borderwidth , 1 + radio_property fontangle , "{normal}|italic|oblique" + string_property fontname , OCTAVE_DEFAULT_FONTNAME + double_property fontsize , 10 + radio_property fontunits S , "inches|centimeters|normalized|{points}|pixels" + radio_property fontweight , "light|{normal}|demi|bold" + color_property foregroundcolor , color_values (0, 0, 0) + color_property highlightcolor , color_values (1, 1, 1) + array_property position , default_panel_position () + callback_property resizefcn , Matrix () + color_property shadowcolor , color_values (0, 0, 0) + string_property title , "" + radio_property titleposition , "{lefttop}|centertop|righttop|leftbottom|centerbottom|rightbottom" + radio_property units S , "{normalized}|inches|centimeters|points|pixels|characters" + END_PROPERTIES + + protected: + void init (void) + { + position.add_constraint (dim_vector (1, 4)); + } + + void update_units (const caseless_str& old_units); + void update_fontunits (const caseless_str& old_units); + + }; + +private: + properties xproperties; + +public: + uipanel (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipanel (void) { xproperties.delete_children (); } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoolbar : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoolbar) + any_property __object__ , Matrix () + END_PROPERTIES + + protected: + void init (void) + { } + }; + +private: + properties xproperties; + +public: + uitoolbar (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p), default_properties () + { + xproperties.override_defaults (*this); + } + + ~uitoolbar (void) { xproperties.delete_children (); } + + void override_defaults (base_graphics_object& obj) + { + // Allow parent (figure) to override first (properties knows how + // to find the parent object). + xproperties.override_defaults (obj); + + // Now override with our defaults. If the default_properties + // list includes the properties for all defaults (line, + // surface, etc.) then we don't have to know the type of OBJ + // here, we just call its set function and let it decide which + // properties from the list to use. + obj.set_from_list (default_properties); + } + + void set (const caseless_str& name, const octave_value& value) + { + if (name.compare ("default", 7)) + // strip "default", pass rest to function that will + // parse the remainder and add the element to the + // default_properties map. + default_properties.set (name.substr (7), value); + else + xproperties.set (name, value); + } + + octave_value get (const caseless_str& name) const + { + octave_value retval; + + if (name.compare ("default", 7)) + retval = get_default (name.substr (7)); + else + retval = xproperties.get (name); + + return retval; + } + + octave_value get_default (const caseless_str& name) const; + + octave_value get_defaults (void) const + { + return default_properties.as_struct ("default"); + } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + + void reset_default_properties (void); + +private: + property_list default_properties; +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uipushtool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uipushtool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix() + bool_property enable , "on" + bool_property separator , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uipushtool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uipushtool (void) { xproperties.delete_children (); } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + +class OCTINTERP_API uitoggletool : public base_graphics_object +{ +public: + class OCTINTERP_API properties : public base_properties + { + public: + // See the genprops.awk script for an explanation of the + // properties declarations. + + BEGIN_PROPERTIES (uitoggletool) + any_property __object__ , Matrix () + array_property cdata , Matrix () + callback_property clickedcallback , Matrix() + bool_property enable , "on" + callback_property offcallback , Matrix() + callback_property oncallback , Matrix() + bool_property separator , "off" + bool_property state , "off" + string_property tooltipstring , "" + END_PROPERTIES + + protected: + void init (void) + { + cdata.add_constraint ("double"); + cdata.add_constraint ("single"); + cdata.add_constraint ("uint8"); + cdata.add_constraint (dim_vector (-1, -1, 3)); + } + }; + +private: + properties xproperties; + +public: + uitoggletool (const graphics_handle& mh, const graphics_handle& p) + : base_graphics_object (), xproperties (mh, p) + { + xproperties.override_defaults (*this); + } + + ~uitoggletool (void) { xproperties.delete_children (); } + + base_properties& get_properties (void) { return xproperties; } + + const base_properties& get_properties (void) const { return xproperties; } + + bool valid_object (void) const { return true; } + +}; + +// --------------------------------------------------------------------- + octave_value get_property_from_handle (double handle, const std::string &property, const std::string &func); @@ -4395,14 +5140,19 @@ create_callback_event (const graphics_handle& h, const std::string& name, const octave_value& data = Matrix ()); + + static graphics_event + create_callback_event (const graphics_handle& h, + const octave_value& cb, + const octave_value& data = Matrix ()); static graphics_event create_function_event (event_fcn fcn, void *data = 0); static graphics_event - create_set_event (const graphics_handle& h, - const std::string& name, - const octave_value& value); + create_set_event (const graphics_handle& h, const std::string& name, + const octave_value& value, + bool notify_toolkit = true); private: base_graphics_event *rep; }; @@ -4432,12 +5182,25 @@ return retval; } + static graphics_handle get_handle (bool integer_figure_handle) + { + return instance_ok () + ? instance->do_get_handle (integer_figure_handle) : graphics_handle (); + } + static void free (const graphics_handle& h) { if (instance_ok ()) instance->do_free (h); } + static void renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh) + { + if (instance_ok ()) + instance->do_renumber_figure (old_gh, new_gh); + } + static graphics_handle lookup (double val) { return instance_ok () ? instance->do_lookup (val) : graphics_handle (); @@ -4461,17 +5224,24 @@ static graphics_handle make_graphics_handle (const std::string& go_name, - const graphics_handle& parent, bool do_createfcn = true) + const graphics_handle& parent, + bool integer_figure_handle = false, + bool do_createfcn = true, + bool do_notify_toolkit = true) { return instance_ok () - ? instance->do_make_graphics_handle (go_name, parent, do_createfcn) + ? instance->do_make_graphics_handle (go_name, parent, + integer_figure_handle, + do_createfcn, do_notify_toolkit) : graphics_handle (); } - static graphics_handle make_figure_handle (double val) + static graphics_handle make_figure_handle (double val, + bool do_notify_toolkit = true) { return instance_ok () - ? instance->do_make_figure_handle (val) : graphics_handle (); + ? instance->do_make_figure_handle (val, do_notify_toolkit) + : graphics_handle (); } static void push_figure (const graphics_handle& h) @@ -4492,9 +5262,10 @@ ? instance->do_current_figure () : graphics_handle (); } - static Matrix handle_list (void) + static Matrix handle_list (bool show_hidden = false) { - return instance_ok () ? instance->do_handle_list () : Matrix (); + return instance_ok () + ? instance->do_handle_list (show_hidden) : Matrix (); } static void lock (void) @@ -4503,30 +5274,51 @@ instance->do_lock (); } + static bool try_lock (void) + { + if (instance_ok ()) + return instance->do_try_lock (); + else + return false; + } + static void unlock (void) { if (instance_ok ()) instance->do_unlock (); } - - static Matrix figure_handle_list (void) + + static Matrix figure_handle_list (bool show_hidden = false) { - return instance_ok () ? instance->do_figure_handle_list () : Matrix (); + return instance_ok () + ? instance->do_figure_handle_list (show_hidden) : Matrix (); + } + + static void execute_listener (const graphics_handle& h, + const octave_value& l) + { + if (instance_ok ()) + instance->do_execute_listener (h, l); } static void execute_callback (const graphics_handle& h, const std::string& name, const octave_value& data = Matrix ()) { - graphics_object go = get_object (h); - - if (go.valid_object ()) + octave_value cb; + + if (true) { - octave_value cb = go.get (name); - - if (! error_state) - execute_callback (h, cb, data); + gh_manager::auto_lock lock; + + graphics_object go = get_object (h); + + if (go.valid_object ()) + cb = go.get (name); } + + if (! error_state) + execute_callback (h, cb, data); } static void execute_callback (const graphics_handle& h, @@ -4544,19 +5336,18 @@ if (instance_ok ()) instance->do_post_callback (h, name, data); } - + static void post_function (graphics_event::event_fcn fcn, void* data = 0) { if (instance_ok ()) instance->do_post_function (fcn, data); } - static void post_set (const graphics_handle& h, - const std::string& name, - const octave_value& value) + static void post_set (const graphics_handle& h, const std::string& name, + const octave_value& value, bool notify_toolkit = true) { if (instance_ok ()) - instance->do_post_set (h, name, value); + instance->do_post_set (h, name, value, notify_toolkit); } static int process_events (void) @@ -4569,6 +5360,12 @@ return (instance_ok () ? instance->do_process_events (true) : 0); } + static void enable_event_processing (bool enable = true) + { + if (instance_ok ()) + instance->do_enable_event_processing (enable); + } + static bool is_handle_visible (const graphics_handle& h) { bool retval = false; @@ -4582,18 +5379,21 @@ } public: - class autolock + class auto_lock : public octave_autolock { public: - autolock (void) { lock (); } - - ~autolock (void) { unlock (); } + auto_lock (bool wait = true) + : octave_autolock (instance_ok () + ? instance->graphics_lock + : octave_mutex (), + wait) + { } private: // No copying! - autolock (const autolock&); - autolock& operator = (const autolock&); + auto_lock (const auto_lock&); + auto_lock& operator = (const auto_lock&); }; private: @@ -4631,10 +5431,16 @@ // The stack of callback objects. std::list<graphics_object> callback_objects; - graphics_handle get_handle (const std::string& go_name); + // A flag telling whether event processing must be constantly on. + int event_processing; + + graphics_handle do_get_handle (bool integer_figure_handle); void do_free (const graphics_handle& h); + void do_renumber_figure (const graphics_handle& old_gh, + const graphics_handle& new_gh); + graphics_handle do_lookup (double val) { iterator p = (xisnan (val) ? handle_map.end () : handle_map.find (val)); @@ -4650,33 +5456,48 @@ } graphics_handle do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, bool do_createfcn); - - graphics_handle do_make_figure_handle (double val); - - Matrix do_handle_list (void) + const graphics_handle& p, + bool integer_figure_handle, + bool do_createfcn, + bool do_notify_toolkit); + + graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); + + Matrix do_handle_list (bool show_hidden) { Matrix retval (1, handle_map.size ()); + octave_idx_type i = 0; for (const_iterator p = handle_map.begin (); p != handle_map.end (); p++) { graphics_handle h = p->first; - retval(i++) = h.value (); + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); } + + retval.resize (1, i); + return retval; } - Matrix do_figure_handle_list (void) + Matrix do_figure_handle_list (bool show_hidden) { Matrix retval (1, figure_list.size ()); + octave_idx_type i = 0; for (const_figure_list_iterator p = figure_list.begin (); p != figure_list.end (); p++) { graphics_handle h = *p; - retval(i++) = h.value (); + + if (show_hidden || is_handle_visible (h)) + retval(i++) = h.value (); } + + retval.resize (1, i); + return retval; } @@ -4686,23 +5507,39 @@ graphics_handle do_current_figure (void) const { - return figure_list.empty () ? graphics_handle () : figure_list.front (); + graphics_handle retval; + + for (const_figure_list_iterator p = figure_list.begin (); + p != figure_list.end (); + p++) + { + graphics_handle h = *p; + + if (is_handle_visible (h)) + retval = h; + } + + return retval; } void do_lock (void) { graphics_lock.lock (); } + bool do_try_lock (void) { return graphics_lock.try_lock (); } + void do_unlock (void) { graphics_lock.unlock (); } + void do_execute_listener (const graphics_handle& h, const octave_value& l); + void do_execute_callback (const graphics_handle& h, const octave_value& cb, const octave_value& data); void do_post_callback (const graphics_handle& h, const std::string name, const octave_value& data); - + void do_post_function (graphics_event::event_fcn fcn, void* fcn_data); void do_post_set (const graphics_handle& h, const std::string name, - const octave_value& value); + const octave_value& value, bool notify_toolkit = true); int do_process_events (bool force = false); @@ -4715,9 +5552,12 @@ void do_restore_gcbo (void); void do_post_event (const graphics_event& e); + + void do_enable_event_processing (bool enable = true); }; -void get_children_limits (double& min_val, double& max_val, double& min_pos, +void get_children_limits (double& min_val, double& max_val, + double& min_pos, double& max_neg, const Matrix& kids, char limit_type); OCTINTERP_API int calc_dimensions (const graphics_object& gh);
--- a/src/help.cc +++ b/src/help.cc @@ -152,43 +152,43 @@ pair_type ("#{", "-*- texinfo -*-\n\ @deftypefn {Operator} {} #@{\n\ -Begin block comment. There must be nothing else other than\n\ -whitespace in the line, both before and after @code{#@{}. Also,\n\ -it is possible to nest block comments.\n\ -@seealso{#, #@}, %@{}\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@{, #@}, #}\n\ @end deftypefn"), pair_type ("%{", "-*- texinfo -*-\n\ @deftypefn {Operator} {} %@{\n\ -Begin block comment. There must be nothing else other than\n\ -whitespace in the line, both before and after @code{%@{}. Also,\n\ -it is possible to nest block comments.\n\ -@seealso{%, %@}, #@{}\n\ +Begin block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@{}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@{, %@}, %}\n\ @end deftypefn"), pair_type ("#}", "-*- texinfo -*-\n\ @deftypefn {Operator} {} #@}\n\ -Close block comment. There must be nothing else other than\n\ -whitespace in the line, both before and after @code{#@}}. Also,\n\ -it is possible to nest block comments.\n\ -@seealso{#, #@{, %@}}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{#@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{%@}, #@{, #}\n\ @end deftypefn"), pair_type ("%}", "-*- texinfo -*-\n\ @deftypefn {Operator} {} %@}\n\ -Close block comment. There must be nothing else other than\n\ -whitespace in the line, both before and after @code{%@}}. Also,\n\ -it is possible to nest block comments.\n\ -@seealso{%, %@{, #@}}\n\ +Close block comment. There must be nothing else, other than\n\ +whitespace, in the line both before and after @code{%@}}.\n\ +It is possible to nest block comments.\n\ +@seealso{#@}, %@{, %}\n\ @end deftypefn"), pair_type ("...", "-*- texinfo -*-\n\ @deftypefn {Operator} {} ...\n\ -Continuation marker. Joins current line with following line.\n\ +Continuation marker. Joins current line with following line.\n\ @end deftypefn"), pair_type ("&", @@ -208,12 +208,12 @@ pair_type ("'", "-*- texinfo -*-\n\ @deftypefn {Operator} {} '\n\ -Matrix transpose operator. For complex matrices, computes the\n\ +Matrix transpose operator. For complex matrices, computes the\n\ complex conjugate (Hermitian) transpose.\n\ \n\ The single quote character may also be used to delimit strings, but\n\ it is better to use the double quote character, since that is never\n\ -ambiguous\n\ +ambiguous.\n\ @seealso{.', transpose}\n\ @end deftypefn"), @@ -260,7 +260,7 @@ pair_type ("++", "-*- texinfo -*-\n\ @deftypefn {Operator} {} ++\n\ -Increment operator. As in C, may be applied as a prefix or postfix\n\ +Increment operator. As in C, may be applied as a prefix or postfix\n\ operator.\n\ @seealso{--}\n\ @end deftypefn"), @@ -281,7 +281,7 @@ pair_type ("--", "-*- texinfo -*-\n\ @deftypefn {Operator} {} --\n\ -Decrement operator. As in C, may be applied as a prefix or postfix\n\ +Decrement operator. As in C, may be applied as a prefix or postfix\n\ operator.\n\ @seealso{++}\n\ @end deftypefn"), @@ -289,7 +289,7 @@ pair_type (".'", "-*- texinfo -*-\n\ @deftypefn {Operator} {} .'\n\ -Matrix transpose operator. For complex matrices, computes the\n\ +Matrix transpose operator. For complex matrices, computes the\n\ transpose, @emph{not} the complex conjugate transpose.\n\ @seealso{', transpose}\n\ @end deftypefn"), @@ -432,7 +432,7 @@ "-*- texinfo -*-\n\ @deftypefn {Keyword} {} break\n\ Exit the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, continue}\n\ +@seealso{do, while, for, parfor, continue}\n\ @end deftypefn"), pair_type ("case", @@ -455,7 +455,7 @@ "-*- texinfo -*-\n\ @deftypefn {Keyword} {} continue\n\ Jump to the end of the innermost enclosing do, while or for loop.\n\ -@seealso{do, while, for, break}\n\ +@seealso{do, while, for, parfor, break}\n\ @end deftypefn"), pair_type ("do", @@ -485,7 +485,7 @@ @deftypefn {Keyword} {} end\n\ Mark the end of any @code{for}, @code{if}, @code{do}, @code{while}, or\n\ @code{function} block.\n\ -@seealso{for, if, do, while, function}\n\ +@seealso{for, parfor, if, do, while, function}\n\ @end deftypefn"), pair_type ("end_try_catch", @@ -523,6 +523,13 @@ @seealso{if}\n\ @end deftypefn"), + pair_type ("endparfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} endparfor\n\ +Mark the end of a parfor loop. See @code{parfor} for an example.\n\ +@seealso{parfor}\n\ +@end deftypefn"), + pair_type ("endswitch", "-*- texinfo -*-\n\ @deftypefn {Keyword} {} endswitch\n\ @@ -549,7 +556,7 @@ endfor\n\ @end group\n\ @end example\n\ -@seealso{do, while}\n\ +@seealso{do, parfor, while}\n\ @end deftypefn"), pair_type ("function", @@ -608,6 +615,22 @@ @seealso{switch}\n\ @end deftypefn"), + pair_type ("parfor", + "-*- texinfo -*-\n\ +@deftypefn {Keyword} {} for @var{i} = @var{range}\n\ +@deftypefnx {Keyword} {} for (@var{i} = @var{range}, @var{maxproc})\n\ +Begin a for loop that may execute in parallel.\n\ +\n\ +@example\n\ +@group\n\ +parfor i = 1:10\n\ + i\n\ +endparfor\n\ +@end group\n\ +@end example\n\ +@seealso{for, do, while}\n\ +@end deftypefn"), + pair_type ("persistent", "-*- texinfo -*-\n\ @deftypefn {Keyword} {} persistent @var{var}\n\ @@ -706,14 +729,14 @@ "-*- texinfo -*-\n\ @deftypefn {Keyword} {} varargin\n\ Pass an arbitrary number of arguments into a function.\n\ -@seealso{varargout, nargin, nargout}\n\ +@seealso{varargout, nargin, isargout, nargout, nthargout}\n\ @end deftypefn"), pair_type ("varargout", "-*- texinfo -*-\n\ @deftypefn {Keyword} {} varargout\n\ Pass an arbitrary number of arguments out of a function.\n\ -@seealso{varargin, nargin, nargout}\n\ +@seealso{varargin, nargin, isargout, nargout, nthargout}\n\ @end deftypefn"), pair_type ("while", @@ -749,6 +772,9 @@ const string_vector bif = symbol_table::built_in_function_names (); const int bif_len = bif.length (); + const string_vector cfl = symbol_table::cmdline_function_names (); + const int cfl_len = cfl.length (); + const string_vector lcl = symbol_table::variable_names (); const int lcl_len = lcl.length (); @@ -758,7 +784,8 @@ const string_vector afl = autoloaded_functions (); const int afl_len = afl.length (); - const int total_len = key_len + bif_len + lcl_len + ffl_len + afl_len; + const int total_len + = key_len + bif_len + cfl_len + lcl_len + ffl_len + afl_len; string_vector list (total_len); @@ -772,6 +799,9 @@ for (i = 0; i < bif_len; i++) list[j++] = bif[i]; + for (i = 0; i < cfl_len; i++) + list[j++] = cfl[i]; + for (i = 0; i < lcl_len; i++) list[j++] = lcl[i];
--- a/src/input.cc +++ b/src/input.cc @@ -275,6 +275,9 @@ flush_octave_stdout (); + octave_pager_stream::reset (); + octave_diary_stream::reset (); + octave_diary << prompt; retval = interactive_input (prompt); @@ -686,93 +689,88 @@ frame.protect_var (VPS1); VPS1 = prompt; - if (stdin_is_tty) + if (! (interactive || forced_interactive) + || (reading_fcn_file + || reading_classdef_file + || reading_script_file + || get_input_from_eval_string + || input_from_startup_file + || input_from_command_line_file)) { - if (! (interactive || forced_interactive) - || (reading_fcn_file - || reading_classdef_file - || reading_script_file - || get_input_from_eval_string - || input_from_startup_file - || input_from_command_line_file)) - { - frame.protect_var (forced_interactive); - forced_interactive = true; + frame.protect_var (forced_interactive); + forced_interactive = true; + + frame.protect_var (reading_fcn_file); + reading_fcn_file = false; + + frame.protect_var (reading_classdef_file); + reading_classdef_file = false; + + frame.protect_var (reading_script_file); + reading_script_file = false; - frame.protect_var (reading_fcn_file); - reading_fcn_file = false; + frame.protect_var (input_from_startup_file); + input_from_startup_file = false; + + frame.protect_var (input_from_command_line_file); + input_from_command_line_file = false; - frame.protect_var (reading_classdef_file); - reading_classdef_file = false; + frame.protect_var (get_input_from_eval_string); + get_input_from_eval_string = false; + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (get_input_from_stdin ()); + + // FIXME: are these safe? + frame.add_fcn (switch_to_buffer, old_buf); + frame.add_fcn (delete_buffer, new_buf); - frame.protect_var (reading_script_file); - reading_script_file = false; + switch_to_buffer (new_buf); + } + + while (Vdebugging) + { + reset_error_handler (); + + reset_parser (); - frame.protect_var (input_from_startup_file); - input_from_startup_file = false; + // Save current value of global_command. + frame.protect_var (global_command); + + global_command = 0; - frame.protect_var (input_from_command_line_file); - input_from_command_line_file = false; + // Do this with an unwind-protect cleanup function so that the + // forced variables will be unmarked in the event of an interrupt. + symbol_table::scope_id scope = symbol_table::top_scope (); + frame.add_fcn (symbol_table::unmark_forced_variables, scope); - frame.protect_var (get_input_from_eval_string); - get_input_from_eval_string = false; + // This is the same as yyparse in parse.y. + int retval = octave_parse (); - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer (get_input_from_stdin ()); + if (retval == 0 && global_command) + { + global_command->accept (*current_evaluator); - // FIXME: are these safe? - frame.add_fcn (switch_to_buffer, old_buf); - frame.add_fcn (delete_buffer, new_buf); + // FIXME -- To avoid a memory leak, global_command should be + // deleted, I think. But doing that here causes trouble if + // an error occurs while executing a debugging command + // (dbstep, for example). It's not clear to me why that + // happens. + // + // delete global_command; + // + // global_command = 0; - switch_to_buffer (new_buf); + if (octave_completion_matches_called) + octave_completion_matches_called = false; } - while (Vdebugging) - { - reset_error_handler (); - - reset_parser (); - - // Save current value of global_command. - frame.protect_var (global_command); - - global_command = 0; - - // Do this with an unwind-protect cleanup function so that the - // forced variables will be unmarked in the event of an interrupt. - symbol_table::scope_id scope = symbol_table::top_scope (); - frame.add_fcn (symbol_table::unmark_forced_variables, scope); - - // This is the same as yyparse in parse.y. - int retval = octave_parse (); - - if (retval == 0 && global_command) - { - global_command->accept (*current_evaluator); + // Unmark forced variables. + // Restore previous value of global_command. + frame.run_top (2); - // FIXME -- To avoid a memory leak, global_command should be - // deleted, I think. But doing that here causes trouble if - // an error occurs while executing a debugging command - // (dbstep, for example). It's not clear to me why that - // happens. - // - // delete global_command; - // - // global_command = 0; - - if (octave_completion_matches_called) - octave_completion_matches_called = false; - } - - // Unmark forced variables. - // Restore previous value of global_command. - frame.run_top (2); - - octave_quit (); - } + octave_quit (); } - else - warning ("invalid attempt to debug script read from stdin"); } // If the user simply hits return, this will produce an empty matrix. @@ -799,6 +797,9 @@ flush_octave_stdout (); + octave_pager_stream::reset (); + octave_diary_stream::reset (); + octave_diary << prompt; std::string input_buf = interactive_input (prompt.c_str (), true); @@ -956,14 +957,11 @@ unwind_protect frame; - // FIXME -- we shouldn't need both the - // command_history object and the - // Vsaving_history variable... + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + command_history::ignore_entries (false); - frame.add_fcn (command_history::ignore_entries, ! Vsaving_history); - - frame.protect_var (Vsaving_history); frame.protect_var (Vdebugging); frame.add_fcn (octave_call_stack::restore_frame, @@ -975,7 +973,6 @@ // tree_print_code tpc (octave_stdout); // stmt.accept (tpc); - Vsaving_history = true; Vdebugging = true; std::string prompt = "debug> ";
--- a/src/lex.h +++ b/src/lex.h @@ -60,7 +60,8 @@ : bracketflag (0), braceflag (0), looping (0), convert_spaces_to_comma (true), at_beginning_of_statement (true), - defining_func (0), looking_at_function_handle (false), + defining_func (0), looking_at_function_handle (0), + looking_at_anon_fcn_args (true), looking_at_return_list (false), looking_at_parameter_list (false), looking_at_decl_list (false), looking_at_initializer_expression (false), looking_at_matrix_or_assign_lhs (false), looking_at_object_index (), @@ -101,6 +102,9 @@ // Nonzero means we are parsing a function handle. int looking_at_function_handle; + // TRUE means we are parsing an anonymous function argument list. + bool looking_at_anon_fcn_args; + // TRUE means we're parsing the return list for a function. bool looking_at_return_list;
--- a/src/lex.ll +++ b/src/lex.ll @@ -164,13 +164,13 @@ } \ while (0) -#define BIN_OP_RETURN(tok, convert, bos) \ +#define BIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ do \ { \ yylval.tok_val = new token (input_line_number, current_input_column); \ token_stack.push (yylval.tok_val); \ current_input_column += yyleng; \ - lexer_flags.quote_is_transpose = false; \ + lexer_flags.quote_is_transpose = qit; \ lexer_flags.convert_spaces_to_comma = convert; \ lexer_flags.looking_for_object_index = false; \ lexer_flags.at_beginning_of_statement = bos; \ @@ -178,6 +178,21 @@ } \ while (0) +#define XBIN_OP_RETURN_INTERNAL(tok, convert, bos, qit) \ + do \ + { \ + gripe_matlab_incompatible_operator (yytext); \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, qit); \ + } \ + while (0) + +#define BIN_OP_RETURN(tok, convert, bos) \ + do \ + { \ + BIN_OP_RETURN_INTERNAL (tok, convert, bos, false); \ + } \ + while (0) + #define XBIN_OP_RETURN(tok, convert, bos) \ do \ { \ @@ -539,6 +554,7 @@ lexer_flags.quote_is_transpose = false; lexer_flags.convert_spaces_to_comma = true; + lexer_flags.looking_for_object_index = false; maybe_warn_separator_insert (','); @@ -896,8 +912,8 @@ ".^" { LEXER_DEBUG (".^"); BIN_OP_RETURN (EPOW, false, false); } ".**" { LEXER_DEBUG (".**"); XBIN_OP_RETURN (EPOW, false, false); } ".'" { LEXER_DEBUG (".'"); do_comma_insert_check (); BIN_OP_RETURN (TRANSPOSE, true, false); } -"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN (PLUS_PLUS, true, false); } -"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN (MINUS_MINUS, true, false); } +"++" { LEXER_DEBUG ("++"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (PLUS_PLUS, true, false, true); } +"--" { LEXER_DEBUG ("--"); do_comma_insert_check (); XBIN_OP_RETURN_INTERNAL (MINUS_MINUS, true, false, true); } "<=" { LEXER_DEBUG ("<="); BIN_OP_RETURN (EXPR_LE, false, false); } "==" { LEXER_DEBUG ("=="); BIN_OP_RETURN (EXPR_EQ, false, false); } "~=" { LEXER_DEBUG ("~="); BIN_OP_RETURN (EXPR_NE, false, false); } @@ -961,10 +977,15 @@ lexer_flags.looking_at_object_index.pop_front (); lexer_flags.quote_is_transpose = true; - lexer_flags.convert_spaces_to_comma = nesting_level.is_bracket_or_brace (); + lexer_flags.convert_spaces_to_comma + = (nesting_level.is_bracket_or_brace () + && ! lexer_flags.looking_at_anon_fcn_args); lexer_flags.looking_for_object_index = true; lexer_flags.at_beginning_of_statement = false; + if (lexer_flags.looking_at_anon_fcn_args) + lexer_flags.looking_at_anon_fcn_args = false; + do_comma_insert_check (); COUNT_TOK_AND_RETURN (')'); @@ -1501,6 +1522,11 @@ lexer_flags.at_beginning_of_statement = true; break; + case endparfor_kw: + yylval.tok_val = new token (token::parfor_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + case endswitch_kw: yylval.tok_val = new token (token::switch_end, l, c); lexer_flags.at_beginning_of_statement = true; @@ -1516,6 +1542,11 @@ lexer_flags.at_beginning_of_statement = true; break; + case endenumeration_kw: + yylval.tok_val = new token (token::enumeration_end, l, c); + lexer_flags.at_beginning_of_statement = true; + break; + case endevents_kw: yylval.tok_val = new token (token::events_end, l, c); lexer_flags.at_beginning_of_statement = true; @@ -1531,7 +1562,9 @@ lexer_flags.at_beginning_of_statement = true; break; + case for_kw: + case parfor_kw: case while_kw: promptflag--; lexer_flags.looping++; @@ -1562,9 +1595,10 @@ return 0; break; - case properties_kw: + case enumeration_kw: + case events_kw: case methods_kw: - case events_kw: + case properties_kw: // 'properties', 'methods' and 'events' are keywords for // classdef blocks. if (! lexer_flags.parsing_classdef) @@ -3353,6 +3387,9 @@ // Not initiallly looking at a function handle. looking_at_function_handle = 0; + // Not initiallly looking at an anonymous function argument list. + looking_at_anon_fcn_args = 0; + // Not parsing a function return, parameter, or declaration list. looking_at_return_list = false; looking_at_parameter_list = false; @@ -3435,6 +3472,14 @@ return retval; } +/* + +%!assert (iskeyword ("for")) +%!assert (iskeyword ("fort"), false) +%!assert (iskeyword ("fft"), false) + +*/ + void prep_lexer_for_script_file (void) {
new file mode 100644 --- /dev/null +++ b/src/link-deps.mk @@ -0,0 +1,38 @@ +include ../liboctave/link-deps.mk + +if AMCOND_ENABLE_DYNAMIC_LINKING + LIBOCTINTERP_LINK_DEPS = +else + LIBOCTINTERP_LINK_DEPS = $(DLD_FUNCTIONS_LIBS) +endif + +LIBOCTINTERP_LINK_DEPS += \ + $(GRAPHICS_LIBS) \ + $(FT2_LIBS) \ + $(HDF5_LIBS) \ + $(Z_LIBS) \ + $(OPENGL_LIBS) \ + $(X11_LIBS) \ + $(CARBON_LIBS) + +LIBOCTINTERP_LINK_OPTS = \ + $(GRAPHICS_LDFLAGS) \ + $(FT2_LDFLAGS) \ + $(HDF5_LDFLAGS) \ + $(Z_LDFLAGS) \ + $(REGEX_LDFLAGS) + +OCT_LINK_DEPS = + +OCT_LINK_OPTS = $(LDFLAGS) + +if AMCOND_LINK_ALL_DEPS + LIBOCTINTERP_LINK_DEPS += $(LIBOCTAVE_LINK_DEPS) + LIBOCTINTERP_LINK_OPTS += $(LIBOCTAVE_LINK_OPTS) + + OCTAVE_LINK_DEPS = $(LIBOCTINTERP_LINK_DEPS) + OCTAVE_LINK_OPTS = $(LIBOCTINTERP_LINK_OPTS) + + OCT_LINK_DEPS += $(LIBOCTINTERP_LINK_DEPS) + OCT_LINK_OPTS += $(LIBOCTINTERP_LINK_OPTS) +endif
--- a/src/load-save.cc +++ b/src/load-save.cc @@ -545,6 +545,9 @@ @deftypefnx {Command} {} load options file\n\ @deftypefnx {Command} {} load options file v1 v2 @dots{}\n\ @deftypefnx {Command} {S =} load (\"options\", \"file\", \"v1\", \"v2\", @dots{})\n\ +@deftypefnx {Command} {} load file options\n\ +@deftypefnx {Command} {} load file options v1 v2 @dots{}\n\ +@deftypefnx {Command} {S =} load (\"file\", \"options\", \"v1\", \"v2\", @dots{})\n\ Load the named variables @var{v1}, @var{v2}, @dots{}, from the file\n\ @var{file}. If no variables are specified then all variables found in the\n\ file will be loaded. As with @code{save}, the list of variables to extract\n\ @@ -642,6 +645,16 @@ if (error_state) return retval; + int i = 1; + std::string orig_fname = ""; + + // Function called with Matlab-style ["filename", options] syntax + if (argv[1].at(0) != '-') + { + orig_fname = argv[1]; + i++; + } + // It isn't necessary to have the default load format stored in a // user preference variable since we can determine the type of file // as we are reading. @@ -651,8 +664,8 @@ bool list_only = false; bool verbose = false; - int i; - for (i = 1; i < argc; i++) + //for (i; i < argc; i++) + for (; i < argc; i++) { if (argv[i] == "-force" || argv[i] == "-f") { @@ -710,19 +723,24 @@ break; } - if (i == argc) + if (orig_fname == "") { - print_usage (); - return retval; + if (i == argc) + { + print_usage (); + return retval; + } + else + orig_fname = argv[i]; } - - std::string orig_fname = argv[i]; + else + i--; oct_mach_info::float_format flt_fmt = oct_mach_info::flt_fmt_unknown; bool swap = false; - if (argv[i] == "-") + if (orig_fname == "-") { i++; @@ -747,7 +765,7 @@ } else { - std::string fname = file_ops::tilde_expand (argv[i]); + std::string fname = file_ops::tilde_expand (orig_fname); fname = find_file_to_load (fname, orig_fname);
--- a/src/load-save.h +++ b/src/load-save.h @@ -75,7 +75,7 @@ bool quiet = false); extern octave_value -do_load (std::istream& stream, const std::string& orig_fname, bool force, +do_load (std::istream& stream, const std::string& orig_fname, load_save_format format, oct_mach_info::float_format flt_fmt, bool list_only, bool swap, bool verbose, const string_vector& argv, int argv_idx, int argc, int nargout);
--- a/src/ls-mat5.cc +++ b/src/ls-mat5.cc @@ -1225,21 +1225,29 @@ else { octave_class* cls = new octave_class (m, classname); - cls->reconstruct_exemplar (); - - if (! cls->reconstruct_parents ()) - warning ("load: unable to reconstruct object inheritance"); - - tc = cls; - if (load_path::find_method (classname, "loadobj") != - std::string()) + + if (cls->reconstruct_exemplar ()) { - octave_value_list tmp = feval ("loadobj", tc, 1); - - if (! error_state) - tc = tmp(0); - else - goto data_read_error; + + if (! cls->reconstruct_parents ()) + warning ("load: unable to reconstruct object inheritance"); + + tc = cls; + if (load_path::find_method (classname, "loadobj") != + std::string()) + { + octave_value_list tmp = feval ("loadobj", tc, 1); + + if (! error_state) + tc = tmp(0); + else + goto data_read_error; + } + } + else + { + tc = m; + warning ("load: element has been converted to a structure"); } } }
--- a/src/mappers.cc +++ b/src/mappers.cc @@ -67,7 +67,6 @@ } /* - %!assert(abs (1), 1); %!assert(abs (-3.5), 3.5); %!assert(abs (3+4i), 5); @@ -82,8 +81,7 @@ %!error abs (); %!error abs (1, 2); - - */ +*/ DEFUN (acos, args, , "-*- texinfo -*-\n\ @@ -102,7 +100,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -119,7 +116,6 @@ %!error acos (); %!error acos (1, 2); - */ DEFUN (acosh, args, , @@ -139,7 +135,6 @@ } /* - %!test %! v = [0, pi/2*i, pi*i, pi/2*i]; %! x = [1, 0, -1, 0]; @@ -152,7 +147,6 @@ %!error acosh (); %!error acosh (1, 2); - */ DEFUN (angle, args, , @@ -203,7 +197,6 @@ } /* - %!assert(arg (1), 0); %!assert(arg (i), pi/2); %!assert(arg (-1), pi); @@ -212,13 +205,18 @@ %!assert(arg (single(1)), single(0)); %!assert(arg (single(i)), single(pi/2)); -%!assert(arg (single(-1)), single(pi)); +%!test +%! if (ismac ()) +%! ## Avoid failing for a MacOS feature +%! assert(arg (single(-1)), single(pi), 2*eps(single(1))); +%! else +%! assert(arg (single(-1)), single(pi)); +%! endif %!assert(arg (single(-i)), single(-pi/2)); %!assert(arg (single([1, i; -1, -i])), single([0, pi/2; pi, -pi/2]), 2e1*eps('single')); %!error arg (); %!error arg (1, 2); - */ DEFUN (asin, args, , @@ -265,7 +263,6 @@ } /* - %!test %! v = [0, pi/2*i, 0, -pi/2*i]; %! x = [0, i, 0, -i]; @@ -278,7 +275,6 @@ %!error asinh (); %!error asinh (1, 2); - */ DEFUN (atan, args, , @@ -298,7 +294,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -315,8 +310,7 @@ %!error atan (); %!error atan (1, 2); - - */ +*/ DEFUN (atanh, args, , "-*- texinfo -*-\n\ @@ -335,7 +329,6 @@ } /* - %!test %! v = [0, 0]; %! x = [0, 0]; @@ -348,7 +341,6 @@ %!error atanh (); %!error atanh (1, 2); - */ DEFUN (cbrt, args, , @@ -370,7 +362,6 @@ } /* - %!assert (cbrt (64), 4) %!assert (cbrt (-125), -5) %!assert (cbrt (0), 0) @@ -379,7 +370,6 @@ %!assert (cbrt (NaN), NaN) %!assert (cbrt (2^300), 2^100) %!assert (cbrt (125*2^300), 5*2^100) - */ DEFUN (ceil, args, , @@ -408,7 +398,6 @@ } /* - %% double precision %!assert(ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]); @@ -423,7 +412,6 @@ %!error ceil (); %!error ceil (1, 2); - */ DEFUN (conj, args, , @@ -449,7 +437,6 @@ } /* - %!assert(conj (1), 1); %!assert(conj (i), -i) %!assert(conj (1+i), 1-i) @@ -464,7 +451,6 @@ %!error conj (); %!error conj (1, 2); - */ DEFUN (cos, args, , @@ -484,7 +470,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -501,8 +486,7 @@ %!error cos (); %!error cos (1, 2); - - */ +*/ DEFUN (cosh, args, , "-*- texinfo -*-\n\ @@ -521,7 +505,6 @@ } /* - %!test %! x = [0, pi/2*i, pi*i, 3*pi/2*i]; %! v = [1, 0, -1, 0]; @@ -534,7 +517,6 @@ %!error cosh (); %!error cosh (1, 2); - */ DEFUN (erf, args, , @@ -573,7 +555,6 @@ } /* - %!test %! a = -1i*sqrt(-1/(6.4187*6.4187)); %! assert (erf(a), erf(real(a))); @@ -597,9 +578,6 @@ %% test/octave.test/arith/erf-3.m %!error erf(1,2); - - - */ DEFUN (erfinv, args, , @@ -660,11 +638,9 @@ } /* - %!test %! a = -1i*sqrt(-1/(6.4187*6.4187)); %! assert (erfc(a), erfc(real(a))); - */ DEFUN (erfcx, args, , @@ -695,10 +671,6 @@ return retval; } -/* - -*/ - DEFUN (exp, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} exp (@var{x})\n\ @@ -724,7 +696,6 @@ } /* - %!assert(exp ([0, 1, -1, -1000]), [1, e, 1/e, 0], sqrt (eps)); %!assert(exp (1+i), e * (cos (1) + sin (1) * i), sqrt (eps)); %!assert(exp (single([0, 1, -1, -1000])), single([1, e, 1/e, 0]), sqrt (eps('single'))); @@ -735,7 +706,6 @@ %!assert(exp (Inf) == Inf && exp (-Inf) == 0 && isnan (exp (NaN))); %!assert(exp (Inf ('single')) == Inf('single') && exp (-Inf('single')) == 0 && isnan (exp (NaN('single')))); - */ DEFUN (expm1, args, , @@ -788,7 +758,6 @@ } /* - %!assert(!(finite (Inf))); %!assert(!(finite (NaN))); %!assert(finite (rand(1,10))); @@ -796,8 +765,7 @@ %!assert(!(finite (single(Inf)))); %!assert(!(finite (single(NaN)))); %!assert(finite (single(rand(1,10)))); - - */ +*/ DEFUN (fix, args, , "-*- texinfo -*-\n\ @@ -825,7 +793,6 @@ } /* - %!assert(fix ([1.1, 1, -1.1, -1]), [1, 1, -1, -1]); %!assert(fix ([1.1+1.1i, 1+i, -1.1-1.1i, -1-i]), [1+i, 1+i, -1-i, -1-i]); %!assert(fix (single([1.1, 1, -1.1, -1])), single([1, 1, -1, -1])); @@ -833,7 +800,6 @@ %!error fix (); %!error fix (1, 2); - */ DEFUN (floor, args, , @@ -862,7 +828,6 @@ } /* - %!assert(floor ([2, 1.1, -1.1, -1]), [2, 1, -2, -1]); %!assert(floor ([2+2i, 1.1+1.1i, -1.1-1.1i, -1-i]), [2+2i, 1+i, -2-2i, -1-i]); %!assert(floor (single ([2, 1.1, -1.1, -1])), single ([2, 1, -2, -1])); @@ -870,7 +835,6 @@ %!error floor (); %!error floor (1, 2); - */ DEFUN (gamma, args, , @@ -909,7 +873,6 @@ } /* - %!test %! a = -1i*sqrt(-1/(6.4187*6.4187)); %! assert (gamma(a), gamma(real(a))); @@ -936,7 +899,6 @@ %!error gamma(); %!error gamma(1,2); - */ DEFUN (imag, args, , @@ -956,7 +918,6 @@ } /* - %!assert(imag (1), 0); %!assert(imag (i), 1); %!assert(imag (1+i), 1); @@ -969,8 +930,7 @@ %!error imag (); %!error imag (1, 2); - - */ +*/ DEFUNX ("isalnum", Fisalnum, args, , "-*- texinfo -*-\n\ @@ -990,6 +950,19 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result ((toascii("A"):toascii("Z"))+1) = 1; +%! result ((toascii("0"):toascii("9"))+1) = 1; +%! result ((toascii("a"):toascii("z"))+1) = 1; +%! assert(all (isalnum (charset) == result)); + +%!error isalnum (1, 2); +%!error isalnum (); +*/ + DEFUNX ("isalpha", Fisalpha, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isalpha (@var{s})\n\ @@ -1008,6 +981,18 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result ((toascii("A"):toascii("Z"))+1) = 1; +%! result ((toascii("a"):toascii("z"))+1) = 1; +%! assert(all (isalpha (charset) == result)); + +%!error isalpha (1, 2); +%!error isalpha (); +*/ + DEFUNX ("isascii", Fisascii, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isascii (@var{s})\n\ @@ -1025,6 +1010,16 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = ones (1, 128); +%! assert(all (isascii (charset) == result)); + +%!error isascii (1, 2); +%!error isascii (); +*/ + DEFUNX ("iscntrl", Fiscntrl, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} iscntrl (@var{s})\n\ @@ -1042,6 +1037,19 @@ return retval; } +/* +%% test/octave.test/string/iscntrl-1.m +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result (1:32) = 1; +%! result (128) = 1; +%! assert(all (iscntrl (charset) == result)); + +%!error iscntrl (1, 2); +%!error iscntrl (); +*/ + DEFUNX ("isdigit", Fisdigit, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isdigit (@var{s})\n\ @@ -1059,6 +1067,17 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result ((toascii("0"):toascii("9"))+1) = 1; +%! assert(all (isdigit (charset) == result)); + +%!error isdigit (1, 2); +%!error isdigit (); +*/ + DEFUN (isinf, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isinf (@var{x})\n\ @@ -1085,7 +1104,6 @@ } /* - %!assert(isinf (Inf)); %!assert(!isinf (NaN)); %!assert(!(isinf (NA))); @@ -1097,8 +1115,7 @@ %!assert(!(isinf (single(NA)))); %!assert(isinf (single(rand(1,10))), false(1,10)); %!assert(isinf(single([NaN -Inf -1 0 1 Inf NA])), [false, true, false, false, false, true, false]); - - */ +*/ DEFUNX ("isgraph", Fisgraph, args, , "-*- texinfo -*-\n\ @@ -1118,6 +1135,17 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result (34:127) = 1; +%! assert(all (isgraph (charset) == result)); + +%!error isgraph (1, 2); +%!error isgraph (); +*/ + DEFUNX ("islower", Fislower, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} islower (@var{s})\n\ @@ -1135,6 +1163,17 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result ((toascii("a"):toascii("z"))+1) = 1; +%! assert(all (islower (charset) == result)); + +%!error islower (1, 2); +%!error islower (); +*/ + DEFUN (isna, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isna (@var{x})\n\ @@ -1161,7 +1200,6 @@ } /* - %!assert(!(isna (Inf))); %!assert(!isna (NaN)); %!assert(isna (NA)); @@ -1173,8 +1211,7 @@ %!assert(isna (single(NA))); %!assert(isna (single(rand(1,10))), false(1,10)); %!assert(isna(single([NaN -Inf -1 0 1 Inf NA])), [false, false, false, false, false, false, true]); - - */ +*/ DEFUN (isnan, args, , "-*- texinfo -*-\n\ @@ -1202,7 +1239,6 @@ } /* - %!assert(!(isnan (Inf))); %!assert(isnan (NaN)); %!assert(isnan (NA)); @@ -1214,8 +1250,7 @@ %!assert(isnan (single(NA))); %!assert(isnan (single(rand(1,10))), false(1,10)); %!assert(isnan(single([NaN -Inf -1 0 1 Inf NA])), [true, false, false, false, false, false, true]); - - */ +*/ DEFUNX ("isprint", Fisprint, args, , "-*- texinfo -*-\n\ @@ -1235,6 +1270,20 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result (33:127) = 1; +%! if (ispc () && ! isunix ()) +%! result(10) = 1; +%! endif +%! assert(all (isprint (charset) == result)); + +%!error isprint (1, 2); +%!error isprint (); +*/ + DEFUNX ("ispunct", Fispunct, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} ispunct (@var{s})\n\ @@ -1252,6 +1301,20 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result (34:48) = 1; +%! result (59:65) = 1; +%! result (92:97) = 1; +%! result (124:127) = 1; +%! assert(all (ispunct (charset) == result)); + +%!error ispunct (1, 2); +%!error ispunct (); +*/ + DEFUNX ("isspace", Fisspace, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isspace (@var{s})\n\ @@ -1270,6 +1333,17 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result (toascii (" \f\n\r\t\v")+1) = 1; +%! assert(all (isspace (charset) == result)); + +%!error isspace (1, 2); +%!error isspace (); +*/ + DEFUNX ("isupper", Fisupper, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isupper (@var{s})\n\ @@ -1287,6 +1361,17 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result ((toascii("A"):toascii("Z"))+1) = 1; +%! assert(all (isupper (charset) == result)); + +%!error isupper (1, 2); +%!error isupper (); +*/ + DEFUNX ("isxdigit", Fisxdigit, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} isxdigit (@var{s})\n\ @@ -1304,6 +1389,19 @@ return retval; } +/* +%!test +%! charset = setstr (0:127); +%! result = zeros (1, 128); +%! result ((toascii("A"):toascii("F"))+1) = 1; +%! result ((toascii("0"):toascii("9"))+1) = 1; +%! result ((toascii("a"):toascii("f"))+1) = 1; +%! assert(all (isxdigit (charset) == result)); + +%!error isxdigit (1, 2); +%!error isxdigit (); +*/ + DEFUN (lgamma, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} lgamma (@var{x})\n\ @@ -1322,7 +1420,6 @@ } /* - %!test %! a = -1i*sqrt(-1/(6.4187*6.4187)); %! assert (lgamma(a), lgamma(real(a))); @@ -1349,7 +1446,6 @@ %!error lgamma(); %!error lgamma(1,2); - */ DEFUN (log, args, , @@ -1377,7 +1473,6 @@ } /* - %!assert(log ([1, e, e^2]), [0, 1, 2], sqrt (eps)); %!assert(log ([-0.5, -1.5, -2.5]), log([0.5, 1.5, 2.5]) + pi*1i, sqrt (eps)); @@ -1386,8 +1481,7 @@ %!error log (); %!error log (1, 2); - - */ +*/ DEFUN (log10, args, , "-*- texinfo -*-\n\ @@ -1406,13 +1500,11 @@ } /* - %!assert(log10 ([0.01, 0.1, 1, 10, 100]), [-2, -1, 0, 1, 2], sqrt (eps)); %!assert(log10 (single([0.01, 0.1, 1, 10, 100])), single([-2, -1, 0, 1, 2]), sqrt (eps ('single'))); %!error log10 (); %!error log10 (1, 2); - */ DEFUN (log1p, args, , @@ -1455,7 +1547,6 @@ } /* - %!assert(real (1), 1); %!assert(real (i), 0); %!assert(real (1+i), 1); @@ -1468,7 +1559,6 @@ %!error real (); %!error real (1, 2); - */ DEFUN (round, args, , @@ -1497,7 +1587,6 @@ } /* - %!assert(round (1), 1); %!assert(round (1.1), 1); %!assert(round (5.5), 6); @@ -1516,7 +1605,6 @@ %!error round (); %!error round (1, 2); - */ DEFUN (roundb, args, , @@ -1571,7 +1659,6 @@ } /* - %!assert(sign (-2) , -1); %!assert(sign (3), 1); %!assert(sign (0), 0); @@ -1584,7 +1671,6 @@ %!error sign (); %!error sign (1, 2); - */ DEFUN (sin, args, , @@ -1604,7 +1690,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -1621,7 +1706,6 @@ %!error sin (); %!error sin (1, 2); - */ DEFUN (sinh, args, , @@ -1641,7 +1725,6 @@ } /* - %!test %! x = [0, pi/2*i, pi*i, 3*pi/2*i]; %! v = [0, i, 0, -i]; @@ -1654,8 +1737,7 @@ %!error sinh (); %!error sinh (1, 2); - - */ +*/ DEFUN (sqrt, args, , "-*- texinfo -*-\n\ @@ -1676,7 +1758,6 @@ } /* - %!assert(sqrt (4), 2) %!assert(sqrt (-1), i) %!assert(sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)); @@ -1689,7 +1770,6 @@ %!error sqrt (); %!error sqrt (1, 2); - */ DEFUN (tan, args, , @@ -1709,7 +1789,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -1726,7 +1805,6 @@ %!error tan (); %!error tan (1, 2); - */ DEFUN (tanh, args, , @@ -1746,7 +1824,6 @@ } /* - %!test %! x = [0, pi*i]; %! v = [0, 0]; @@ -1759,7 +1836,6 @@ %!error tanh (); %!error tanh (1, 2); - */ DEFUNX ("toascii", Ftoascii, args, , @@ -1786,6 +1862,17 @@ return retval; } +/* +%!assert(toascii (char (0:127)), 0:127); +%!assert(toascii (" ":"@"), 32:64); +%!assert(toascii ("A":"Z"), 65:90); +%!assert(toascii ("[":"`"), 91:96); +%!assert(toascii ("a":"z"), 97:122); +%!assert(toascii ("{":"~"), 123:126); +%!error toascii (1, 2); +%!error toascii (1, 2); +*/ + DEFUNX ("tolower", Ftolower, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} tolower (@var{s})\n\ @@ -1815,9 +1902,9 @@ DEFALIAS (lower, tolower); /* - %!error <Invalid call to tolower.*> tolower(); %!error <Invalid call to tolower.*> lower(); +%!error tolower (1, 2); %!assert(tolower("OCTAVE"), "octave"); %!assert(tolower("123OCTave!_&"), "123octave!_&"); %!assert(tolower({"ABC", "DEF", {"GHI", {"JKL"}}}), {"abc", "def", {"ghi", {"jkl"}}}); @@ -1829,9 +1916,14 @@ %! a(3,3,3,3) = "D"; %! assert(tolower(a)(3,3,3,3), "d"); +%!test +%! charset = setstr (0:127); +%! result = charset; +%! result ((toascii("A"):toascii("Z"))+1) \ +%! = result ((toascii("a"):toascii("z"))+1); +%! assert(all (tolower (charset) == result)); */ - DEFUNX ("toupper", Ftoupper, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} toupper (@var{s})\n\ @@ -1861,9 +1953,9 @@ DEFALIAS (upper, toupper); /* - %!error <Invalid call to toupper.*> toupper(); %!error <Invalid call to toupper.*> upper(); +%!error toupper (1, 2); %!assert(toupper("octave"), "OCTAVE"); %!assert(toupper("123OCTave!_&"), "123OCTAVE!_&"); %!assert(toupper({"abc", "def", {"ghi", {"jkl"}}}), {"ABC", "DEF", {"GHI", {"JKL"}}}); @@ -1874,7 +1966,12 @@ %!test %! a(3,3,3,3) = "d"; %! assert(toupper(a)(3,3,3,3), "D"); - +%!test +%! charset = setstr (0:127); +%! result = charset; +%! result ((toascii("a"):toascii("z"))+1) \ +%! = result ((toascii("A"):toascii("Z"))+1); +%! assert(all (toupper (charset) == result)); */ DEFALIAS (gammaln, lgamma);
--- a/src/mex.cc +++ b/src/mex.cc @@ -1274,10 +1274,17 @@ int get_string (char *buf, mwSize buflen) const { - int retval = 1; + int retval = 0; mwSize nel = get_number_of_elements (); + if (! (nel < buflen)) + { + retval = 1; + if (buflen > 0) + nel = buflen-1; + } + if (nel < buflen) { mxChar *ptr = static_cast<mxChar *> (pr);
--- a/src/mkoctfile.cc.in +++ b/src/mkoctfile.cc.in @@ -219,7 +219,6 @@ vars["DL_LD"] = get_variable ("DL_LD", %OCTAVE_CONF_DL_LD%); vars["DL_LDFLAGS"] = get_variable ("DL_LDFLAGS", %OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS%); - vars["RLD_FLAG"] = get_variable ("RLD_FLAG", %OCTAVE_CONF_RLD_FLAG%); vars["RDYNAMIC_FLAG"] = get_variable ("RDYNAMIC_FLAG", %OCTAVE_CONF_RDYNAMIC_FLAG%); vars["LIBOCTAVE"] = "-loctave"; vars["LIBOCTINTERP"] = "-loctinterp"; @@ -233,6 +232,10 @@ vars["FFTW3F_LIBS"] = get_variable ("FFTW3F_LIBS", %OCTAVE_CONF_FFTW3F_LIBS%); vars["LIBS"] = get_variable ("LIBS", %OCTAVE_CONF_LIBS%); vars["FLIBS"] = get_variable ("FLIBS", %OCTAVE_CONF_FLIBS%); + vars["OCTAVE_LINK_DEPS"] = get_variable ("FLIBS", %OCTAVE_CONF_OCTAVE_LINK_DEPS%); + vars["OCT_LINK_DEPS"] = get_variable ("FLIBS", %OCTAVE_CONF_OCT_LINK_DEPS%); + vars["FLIBS"] = get_variable ("FLIBS", %OCTAVE_CONF_FLIBS%); + vars["LD_CXX"] = get_variable ("LD_CXX", %OCTAVE_CONF_LD_CXX%); vars["LDFLAGS"] = get_variable ("LDFLAGS", %OCTAVE_CONF_LDFLAGS%); vars["LD_STATIC_FLAG"] = get_variable ("LD_STATIC_FLAG", %OCTAVE_CONF_LD_STATIC_FLAG%); @@ -296,25 +299,30 @@ " -p VAR, --print VAR Print configuration variable VAR. Recognized\n" " variables are:\n" "\n" -" ALL_CFLAGS FLIBS\n" -" ALL_CXXFLAGS FPICFLAG\n" -" ALL_FFLAGS INCFLAGS\n" -" ALL_LDFLAGS LAPACK_LIBS\n" -" BLAS_LIBS LDFLAGS\n" -" CC LD_CXX\n" -" CFLAGS LD_STATIC_FLAG\n" -" CPICFLAG LFLAGS\n" -" CPPFLAGS LIBCRUFT\n" -" CXX LIBOCTAVE\n" -" CXXFLAGS LIBOCTINTERP\n" -" CXXPICFLAG LIBS\n" -" DEPEND_EXTRA_SED_PATTERN OCTAVE_LIBS\n" -" DEPEND_FLAGS RDYNAMIC_FLAG\n" -" DL_LD READLINE_LIBS\n" -" DL_LDFLAGS RLD_FLAG\n" -" F77 SED\n" -" FFLAGS XTRA_CFLAGS\n" -" FFTW_LIBS XTRA_CXXFLAGS\n" +" ALL_CFLAGS FLIBS\n" +" ALL_CXXFLAGS FPICFLAG\n" +" ALL_FFLAGS INCFLAGS\n" +" ALL_LDFLAGS LAPACK_LIBS\n" +" BLAS_LIBS LDFLAGS\n" +" CC LD_CXX\n" +" CFLAGS LD_STATIC_FLAG\n" +" CPICFLAG LFLAGS\n" +" CPPFLAGS LIBCRUFT\n" +" CXX LIBOCTAVE\n" +" CXXFLAGS LIBOCTINTERP\n" +" CXXPICFLAG LIBS\n" +" DEPEND_EXTRA_SED_PATTERN OCTAVE_LIBS\n" +" DEPEND_FLAGS OCTAVE_LINK_DEPS\n" +" DL_LD OCTAVE_LINK_OPTS\n" +" DL_LDFLAGS OCT_LINK_DEPS\n" +" EXEEXT OCT_LINK_OPTS\n" +" F77 RDYNAMIC_FLAG\n" +" F77_INTEGER_8_FLAG READLINE_LIBS\n" +" FFLAGS SED\n" +" FFTW3_LDFLAGS XTRA_CFLAGS\n" +" FFTW3_LIBS XTRA_CXXFLAGS\n" +" FFTW3F_LDFLAGS\n" +" FFTW3F_LIBS\n" "\n" " --link-stand-alone Link a stand-alone executable file.\n" "\n" @@ -742,11 +750,10 @@ + vars["ALL_CXXFLAGS"] + " " + vars["RDYNAMIC_FLAG"] + " " + vars["ALL_LDFLAGS"] + " " + pass_on_options + " " + output_option + " " + objfiles + " " + libfiles - + " " + ldflags + " " + vars["LFLAGS"] + " " - + vars["RLD_FLAG"] + " " + vars["OCTAVE_LIBS"] + " " - + vars["LAPACK_LIBS"] + " " + vars["BLAS_LIBS"] + " " - + vars["FFTW_LIBS"] + " " + vars["READLINE_LIBS"] + " " - + vars["LIBS"] + " " + vars["FLIBS"]; + + " " + ldflags + " " + vars["LFLAGS"] + + " -loctinterp -loctave -lcruft " + + " " + vars["OCT_LINK_OPTS"] + + " " + vars["OCTAVE_LINK_DEPS"]; result = run_command (cmd); } else @@ -758,13 +765,11 @@ } else { - string LINK_DEPS = vars["LFLAGS"] + " " + vars["OCTAVE_LIBS"] - + " " + vars["LDFLAGS"] + " " - + vars["LAPACK_LIBS"] + " " + vars["BLAS_LIBS"] + " " - + vars["FFTW_LIBS"] + " " + vars["LIBS"] + " " + vars["FLIBS"]; string cmd = vars["DL_LD"] + " " + vars["DL_LDFLAGS"] + " " + pass_on_options + " -o " + octfile + " " + objfiles + " " - + libfiles + " " + ldflags + " " + LINK_DEPS; + + libfiles + " " + ldflags + " " + vars["LFLAGS"] + + " -loctinterp -loctave -lcruft " + + vars["OCT_LINK_OPTS"] + " " + vars["OCT_LINK_DEPS"]; result = run_command (cmd); }
--- a/src/mkoctfile.in +++ b/src/mkoctfile.in @@ -85,7 +85,6 @@ : ${DL_LD=%OCTAVE_CONF_DL_LD%} : ${DL_LDFLAGS=%OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS%} -: ${RLD_FLAG=%OCTAVE_CONF_RLD_FLAG%} : ${RDYNAMIC_FLAG=%OCTAVE_CONF_RDYNAMIC_FLAG%} : ${LIBOCTAVE=-loctave} : ${LIBOCTINTERP=-loctinterp} @@ -99,6 +98,10 @@ : ${FFTW3F_LIBS=%OCTAVE_CONF_FFTW3F_LIBS%} : ${LIBS=%OCTAVE_CONF_LIBS%} : ${FLIBS=%OCTAVE_CONF_FLIBS%} +: ${OCTAVE_LINK_DEPS=%OCTAVE_CONF_OCTAVE_LINK_DEPS%} +: ${OCTAVE_LINK_OPTS=%OCTAVE_CONF_OCTAVE_LINK_OPTS%} +: ${OCT_LINK_DEPS=%OCTAVE_CONF_OCT_LINK_DEPS%} +: ${OCT_LINK_OPTS=%OCTAVE_CONF_OCT_LINK_OPTS%} : ${LD_CXX=%OCTAVE_CONF_LD_CXX%} : ${LDFLAGS=%OCTAVE_CONF_LDFLAGS%} : ${LD_STATIC_FLAG=%OCTAVE_CONF_LD_STATIC_FLAG%} @@ -221,7 +224,7 @@ -s, --strip Strip output file. - --mex Create a MEX file. + --mex Create a MEX file. Set the default output extension to ".mex". -o FILE, --output FILE Output file name. Default extension is .oct @@ -231,28 +234,29 @@ -p VAR, --print VAR Print configuration variable VAR. Recognized variables are: - ALL_CFLAGS FFTW3F_LDFLAGS - ALL_CXXFLAGS FFTW3F_LIBS - ALL_FFLAGS FLIBS - ALL_LDFLAGS FPICFLAG - BLAS_LIBS INCFLAGS - CC LAPACK_LIBS - CFLAGS LDFLAGS - CPICFLAG LD_CXX - CPPFLAGS LD_STATIC_FLAG - CXX LFLAGS - CXXFLAGS LIBCRUFT - CXXPICFLAG LIBOCTAVE - DEPEND_EXTRA_SED_PATTERN LIBOCTINTERP - DEPEND_FLAGS LIBS - DL_LD OCTAVE_LIBS - DL_LDFLAGS RDYNAMIC_FLAG - EXEEXT READLINE_LIBS - F77 RLD_FLAG + ALL_CFLAGS FFTW3F_LIBS + ALL_CXXFLAGS FLIBS + ALL_FFLAGS FPICFLAG + ALL_LDFLAGS INCFLAGS + BLAS_LIBS LAPACK_LIBS + CC LDFLAGS + CFLAGS LD_CXX + CPICFLAG LD_STATIC_FLAG + CPPFLAGS LFLAGS + CXX LIBCRUFT + CXXFLAGS LIBOCTAVE + CXXPICFLAG LIBOCTINTERP + DEPEND_EXTRA_SED_PATTERN LIBS + DEPEND_FLAGS OCTAVE_LIBS + DL_LD OCTAVE_LINK_DEPS + DL_LDFLAGS OCT_LINK_DEPS + EXEEXT RDYNAMIC_FLAG + F77 READLINE_LIBS F77_INTEGER_8_FLAG SED FFLAGS XTRA_CFLAGS FFTW3_LDFLAGS XTRA_CXXFLAGS FFTW3_LIBS + FFTW3F_LDFLAGS -v, --verbose Echo commands as they are executed. @@ -529,7 +533,7 @@ if $link && [ -n "$objfiles" ]; then if $link_stand_alone; then if [ -n "$LD_CXX" ]; then - cmd="$LD_CXX $CPPFLAGS $ALL_CXXFLAGS $RDYNAMIC_FLAG $ALL_LDFLAGS $pass_on_options $output_option $objfiles $libfiles $ldflags $LFLAGS $RLD_FLAG $OCTAVE_LIBS $LAPACK_LIBS $BLAS_LIBS $FFTW_LIBS $READLINE_LIBS $LIBS $FLIBS" + cmd="$LD_CXX $CPPFLAGS $ALL_CXXFLAGS $RDYNAMIC_FLAG $ALL_LDFLAGS $pass_on_options $output_option $objfiles $libfiles $ldflags $LFLAGS -loctinterp -loctave -lcruft $OCTAVE_LINK_OPTS $OCTAVE_LINK_DEPS" $dbg $cmd eval $cmd else @@ -537,8 +541,7 @@ exit 1 fi else - LINK_DEPS="$LFLAGS $OCTAVE_LIBS $LDFLAGS $LAPACK_LIBS $BLAS_LIBS $FFTW_LIBS $LIBS $FLIBS" - cmd="$DL_LD $DL_LDFLAGS $pass_on_options -o $octfile $objfiles $libfiles $ldflags $LINK_DEPS" + cmd="$DL_LD $DL_LDFLAGS $pass_on_options -o $octfile $objfiles $libfiles $ldflags $LFLAGS -loctinterp -loctave -lcruft $OCT_LINK_OPTS $OCT_LINK_DEPS" $dbg $cmd eval $cmd fi
--- a/src/oct-conf.h.in +++ b/src/oct-conf.h.in @@ -376,6 +376,14 @@ #define OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS %OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS% #endif +#ifndef OCTAVE_CONF_OCTAVE_LINK_DEPS +#define OCTAVE_CONF_OCTAVE_LINK_DEPS %OCTAVE_CONF_OCTAVE_LINK_DEPS% +#endif + +#ifndef OCTAVE_CONF_OCTAVE_LINK_OPTS +#define OCTAVE_CONF_OCTAVE_LINK_OPTS %OCTAVE_CONF_OCTAVE_LINK_OPTS% +#endif + #ifndef OCTAVE_CONF_OCTINCLUDEDIR #define OCTAVE_CONF_OCTINCLUDEDIR %OCTAVE_CONF_OCTINCLUDEDIR% #endif @@ -384,6 +392,14 @@ #define OCTAVE_CONF_OCTLIBDIR %OCTAVE_CONF_OCTLIBDIR% #endif +#ifndef OCTAVE_CONF_OCT_LINK_DEPS +#define OCTAVE_CONF_OCT_LINK_DEPS %OCTAVE_CONF_OCT_LINK_DEPS% +#endif + +#ifndef OCTAVE_CONF_OCT_LINK_OPTS +#define OCTAVE_CONF_OCT_LINK_OPTS %OCTAVE_CONF_OCT_LINK_OPTS% +#endif + #ifndef OCTAVE_CONF_OPENGL_LIBS #define OCTAVE_CONF_OPENGL_LIBS %OCTAVE_CONF_OPENGL_LIBS% #endif @@ -440,10 +456,6 @@ #define OCTAVE_CONF_REGEX_LIBS %OCTAVE_CONF_REGEX_LIBS% #endif -#ifndef OCTAVE_CONF_RLD_FLAG -#define OCTAVE_CONF_RLD_FLAG %OCTAVE_CONF_RLD_FLAG% -#endif - #ifndef OCTAVE_CONF_SED #define OCTAVE_CONF_SED %OCTAVE_CONF_SED% #endif
--- a/src/oct-hist.cc +++ b/src/oct-hist.cc @@ -88,9 +88,6 @@ return file; } -// Where history is saved. -static std::string Vhistory_file = default_history_file (); - static int default_history_size (void) { @@ -109,27 +106,6 @@ return size; } -// The number of lines to keep in the history file. -static int Vhistory_size = default_history_size (); - -static std::string -default_history_control (void) -{ - std::string retval; - - std::string env_histcontrol = octave_env::getenv ("OCTAVE_HISTCONTROL"); - - if (! env_histcontrol.empty ()) - { - return env_histcontrol; - } - - return retval; -} - -// The number of lines to keep in the history file. -static std::string Vhistory_control = default_history_control (); - static std::string default_history_timestamp_format (void) { @@ -146,9 +122,6 @@ static std::string Vhistory_timestamp_format_string = default_history_timestamp_format (); -// TRUE if we are saving history. -bool Vsaving_history = true; - // Display, save, or load history. Stolen and modified from bash. // // Arg of -w FILENAME means write file, arg of -r FILENAME @@ -160,6 +133,10 @@ { int numbered_output = 1; + unwind_protect frame; + + frame.add_fcn (command_history::set_file, command_history::file ()); + int i; for (i = 1; i < argc; i++) { @@ -537,8 +514,10 @@ void initialize_history (bool read_history_file) { - command_history::initialize (read_history_file, Vhistory_file, Vhistory_size, - Vhistory_control); + command_history::initialize (read_history_file, + default_history_file (), + default_history_size (), + octave_env::getenv ("OCTAVE_HISTCONTROL")); } void @@ -691,12 +670,15 @@ @seealso{history_file, history_size, history_timestamp_format_string, saving_history}\n\ @end deftypefn") { - std::string saved_history_control = Vhistory_control; + std::string old_history_control = command_history::histcontrol (); + + std::string tmp = old_history_control; - octave_value retval = SET_INTERNAL_VARIABLE (history_control); + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_control"); - if (Vhistory_control != saved_history_control) - command_history::process_histcontrol (Vhistory_control); + if (tmp != old_history_control) + command_history::process_histcontrol (tmp); return retval; } @@ -711,13 +693,15 @@ @seealso{history_file, history_timestamp_format_string, saving_history}\n\ @end deftypefn") { - int saved_history_size = Vhistory_size; + int old_history_size = command_history::size (); + + int tmp = old_history_size; - octave_value retval - = SET_INTERNAL_VARIABLE_WITH_LIMITS (history_size, -1, INT_MAX); + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_size", -1, INT_MAX); - if (Vhistory_size != saved_history_size) - command_history::set_size (Vhistory_size); + if (tmp != old_history_size) + command_history::set_size (tmp); return retval; } @@ -733,12 +717,15 @@ @seealso{history_size, saving_history, history_timestamp_format_string}\n\ @end deftypefn") { - std::string saved_history_file = Vhistory_file; + std::string old_history_file = command_history::file (); + + std::string tmp = old_history_file; - octave_value retval = SET_INTERNAL_VARIABLE (history_file); + octave_value retval = set_internal_variable (tmp, args, nargout, + "history_file"); - if (Vhistory_file != saved_history_file) - command_history::set_file (Vhistory_file); + if (tmp != old_history_file) + command_history::set_file (tmp); return retval; } @@ -770,9 +757,15 @@ @seealso{history_control, history_file, history_size, history_timestamp_format_string}\n\ @end deftypefn") { - octave_value retval = SET_INTERNAL_VARIABLE (saving_history); + bool old_saving_history = ! command_history::ignoring_entries (); + + bool tmp = old_saving_history; - command_history::ignore_entries (! Vsaving_history); + octave_value retval = set_internal_variable (tmp, args, nargout, + "saving_history"); + + if (tmp != old_saving_history) + command_history::ignore_entries (! tmp); return retval; }
--- a/src/oct-hist.h +++ b/src/oct-hist.h @@ -35,7 +35,4 @@ // TRUE means input is coming from temporary history file. extern bool input_from_tmp_history_file; -// TRUE if we are saving history. -extern bool Vsaving_history; - #endif
--- a/src/oct-map.cc +++ b/src/oct-map.cc @@ -664,6 +664,7 @@ octave_map::cat (int dim, octave_idx_type n, const octave_scalar_map *map_list) { octave_map retval; + // Allow dim = -1, -2 for compatibility, though it makes no difference here. if (dim == -1 || dim == -2) dim = -dim - 1; @@ -671,7 +672,9 @@ (*current_liboctave_error_handler) ("cat: invalid dimension"); - if (n > 0) + if (n == 1) + retval = map_list[0]; + else if (n > 1) { octave_idx_type idx, nf = 0; for (idx = 0; idx < n; idx++) @@ -726,9 +729,20 @@ octave_map::cat (int dim, octave_idx_type n, const octave_map *map_list) { octave_map retval; - if (n > 0) + + // Allow dim = -1, -2 for compatibility, though it makes no difference here. + if (dim == -1 || dim == -2) + dim = -dim - 1; + else if (dim < 0) + (*current_liboctave_error_handler) + ("cat: invalid dimension"); + + if (n == 1) + retval = map_list[0]; + else if (n > 1) { octave_idx_type idx, nf = 0; + for (idx = 0; idx < n; idx++) { nf = map_list[idx].nfields (); @@ -752,20 +766,29 @@ do_cat (dim, n, map_list, retval); else { - // permute all structures to correct order. - OCTAVE_LOCAL_BUFFER (octave_map, new_map_list, n); + if (nf > 0) + { + // permute all structures to correct order. + OCTAVE_LOCAL_BUFFER (octave_map, new_map_list, n); - permute_to_correct_order (n, nf, idx, map_list, new_map_list); + permute_to_correct_order (n, nf, idx, map_list, new_map_list); - if (nf > 0) - do_cat (dim, n, new_map_list, retval); + do_cat (dim, n, new_map_list, retval); + } else { - // Use dummy arrays. FIXME: Need(?) a better solution. - OCTAVE_LOCAL_BUFFER (Array<char>, dummy, n); - for (octave_idx_type i = 0; i < n; i++) - dummy[i].clear (map_list[i].dimensions); - Array<char>::cat (dim, n, dummy); + dim_vector dv = map_list[0].dimensions; + + for (octave_idx_type i = 1; i < n; i++) + { + if (! dv.concat (map_list[i].dimensions, dim)) + { + error ("dimension mismatch in struct concatenation"); + return retval; + } + } + + retval.dimensions = dv; } } @@ -781,6 +804,18 @@ %! x(1, 1).d = 10; x(4, 6).a = "b"; x(2, 4).f = 27; %! y(1, 6).f = 11; y(1, 6).a = "c"; y(1, 6).d = 33; %! assert (fieldnames ([x; y]), {"d"; "a"; "f"}); + +%!test +%! s = struct (); +%! sr = [s,s]; +%! sc = [s;s]; +%! sm = [s,s;s,s]; +%! assert (nfields (sr), 0); +%! assert (nfields (sc), 0); +%! assert (nfields (sm), 0); +%! assert (size (sr), [1, 2]); +%! assert (size (sc), [2, 1]); +%! assert (size (sm), [2, 2]); */ octave_map
--- a/src/oct-parse.yy +++ b/src/oct-parse.yy @@ -232,9 +232,10 @@ // Build a for command. static tree_command * -make_for_command (token *for_tok, tree_argument_list *lhs, - tree_expression *expr, tree_statement_list *body, - token *end_tok, octave_comment_list *lc); +make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, + tree_expression *expr, tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc); // Build a break command. static tree_command * @@ -439,7 +440,7 @@ %token <tok_val> NAME %token <tok_val> END %token <tok_val> DQ_STRING SQ_STRING -%token <tok_val> FOR WHILE DO UNTIL +%token <tok_val> FOR PARFOR WHILE DO UNTIL %token <tok_val> IF ELSEIF ELSE %token <tok_val> SWITCH CASE OTHERWISE %token <tok_val> BREAK CONTINUE FUNC_RET @@ -447,9 +448,7 @@ %token <tok_val> TRY CATCH %token <tok_val> GLOBAL STATIC %token <tok_val> FCN_HANDLE -%token <tok_val> PROPERTIES -%token <tok_val> METHODS -%token <tok_val> EVENTS +%token <tok_val> PROPERTIES METHODS EVENTS ENUMERATION %token <tok_val> METAQUERY %token <tok_val> SUPERCLASSREF %token <tok_val> GET SET @@ -462,7 +461,7 @@ // Nonterminals we construct. %type <comment_type> stash_comment function_beg classdef_beg -%type <comment_type> properties_beg methods_beg events_beg +%type <comment_type> properties_beg methods_beg events_beg enum_beg %type <sep_type> sep_no_nl opt_sep_no_nl sep opt_sep %type <tree_type> input %type <tree_constant_type> string constant magic_colon @@ -471,7 +470,7 @@ %type <tree_matrix_type> matrix_rows matrix_rows1 %type <tree_cell_type> cell_rows cell_rows1 %type <tree_expression_type> matrix cell -%type <tree_expression_type> primary_expr postfix_expr prefix_expr binary_expr +%type <tree_expression_type> primary_expr oper_expr %type <tree_expression_type> simple_expr colon_expr assign_expr expression %type <tree_identifier_type> identifier fcn_name magic_tilde %type <tree_identifier_type> superclass_identifier meta_identifier @@ -502,6 +501,7 @@ // These types need to be specified. %type <dummy_type> attr %type <dummy_type> class_event +%type <dummy_type> class_enum %type <dummy_type> class_property %type <dummy_type> properties_list %type <dummy_type> properties_block @@ -511,10 +511,11 @@ %type <dummy_type> attr_list %type <dummy_type> events_list %type <dummy_type> events_block +%type <dummy_type> enum_list +%type <dummy_type> enum_block %type <dummy_type> class_body // Precedence and associativity. -%left ';' ',' '\n' %right '=' ADD_EQ SUB_EQ MUL_EQ DIV_EQ LEFTDIV_EQ POW_EQ EMUL_EQ EDIV_EQ ELEFTDIV_EQ EPOW_EQ OR_EQ AND_EQ LSHIFT_EQ RSHIFT_EQ %left EXPR_OR_OR %left EXPR_AND_AND @@ -525,8 +526,9 @@ %left ':' %left '-' '+' EPLUS EMINUS %left '*' '/' LEFTDIV EMUL EDIV ELEFTDIV -%left UNARY PLUS_PLUS MINUS_MINUS EXPR_NOT +%right UNARY EXPR_NOT %left POW EPOW QUOTE TRANSPOSE +%right PLUS_PLUS MINUS_MINUS %left '(' '.' '{' // Where to start. @@ -735,7 +737,10 @@ ; anon_fcn_handle : '@' param_list statement - { $$ = make_anon_fcn_handle ($2, $3); } + { + lexer_flags.quote_is_transpose = false; + $$ = make_anon_fcn_handle ($2, $3); + } ; primary_expr : identifier @@ -796,69 +801,61 @@ { lexer_flags.looking_at_indirect_ref = true; } ; -postfix_expr : primary_expr +oper_expr : primary_expr { $$ = $1; } - | postfix_expr '(' ')' + | oper_expr PLUS_PLUS + { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } + | oper_expr MINUS_MINUS + { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } + | oper_expr '(' ')' { $$ = make_index_expression ($1, 0, '('); } - | postfix_expr '(' arg_list ')' + | oper_expr '(' arg_list ')' { $$ = make_index_expression ($1, $3, '('); } - | postfix_expr '{' '}' + | oper_expr '{' '}' { $$ = make_index_expression ($1, 0, '{'); } - | postfix_expr '{' arg_list '}' + | oper_expr '{' arg_list '}' { $$ = make_index_expression ($1, $3, '{'); } - | postfix_expr PLUS_PLUS - { $$ = make_postfix_op (PLUS_PLUS, $1, $2); } - | postfix_expr MINUS_MINUS - { $$ = make_postfix_op (MINUS_MINUS, $1, $2); } - | postfix_expr QUOTE + | oper_expr QUOTE { $$ = make_postfix_op (QUOTE, $1, $2); } - | postfix_expr TRANSPOSE + | oper_expr TRANSPOSE { $$ = make_postfix_op (TRANSPOSE, $1, $2); } - | postfix_expr indirect_ref_op STRUCT_ELT + | oper_expr indirect_ref_op STRUCT_ELT { $$ = make_indirect_ref ($1, $3->text ()); } - | postfix_expr indirect_ref_op '(' expression ')' + | oper_expr indirect_ref_op '(' expression ')' { $$ = make_indirect_ref ($1, $4); } - ; - -prefix_expr : postfix_expr - { $$ = $1; } - | binary_expr - { $$ = $1; } - | PLUS_PLUS prefix_expr %prec UNARY + | PLUS_PLUS oper_expr %prec UNARY { $$ = make_prefix_op (PLUS_PLUS, $2, $1); } - | MINUS_MINUS prefix_expr %prec UNARY + | MINUS_MINUS oper_expr %prec UNARY { $$ = make_prefix_op (MINUS_MINUS, $2, $1); } - | EXPR_NOT prefix_expr %prec UNARY + | EXPR_NOT oper_expr %prec UNARY { $$ = make_prefix_op (EXPR_NOT, $2, $1); } - | '+' prefix_expr %prec UNARY + | '+' oper_expr %prec UNARY { $$ = make_prefix_op ('+', $2, $1); } - | '-' prefix_expr %prec UNARY + | '-' oper_expr %prec UNARY { $$ = make_prefix_op ('-', $2, $1); } - ; - -binary_expr : prefix_expr POW prefix_expr + | oper_expr POW oper_expr { $$ = make_binary_op (POW, $1, $2, $3); } - | prefix_expr EPOW prefix_expr + | oper_expr EPOW oper_expr { $$ = make_binary_op (EPOW, $1, $2, $3); } - | prefix_expr '+' prefix_expr + | oper_expr '+' oper_expr { $$ = make_binary_op ('+', $1, $2, $3); } - | prefix_expr '-' prefix_expr + | oper_expr '-' oper_expr { $$ = make_binary_op ('-', $1, $2, $3); } - | prefix_expr '*' prefix_expr + | oper_expr '*' oper_expr { $$ = make_binary_op ('*', $1, $2, $3); } - | prefix_expr '/' prefix_expr + | oper_expr '/' oper_expr { $$ = make_binary_op ('/', $1, $2, $3); } - | prefix_expr EPLUS prefix_expr + | oper_expr EPLUS oper_expr { $$ = make_binary_op ('+', $1, $2, $3); } - | prefix_expr EMINUS prefix_expr + | oper_expr EMINUS oper_expr { $$ = make_binary_op ('-', $1, $2, $3); } - | prefix_expr EMUL prefix_expr + | oper_expr EMUL oper_expr { $$ = make_binary_op (EMUL, $1, $2, $3); } - | prefix_expr EDIV prefix_expr + | oper_expr EDIV oper_expr { $$ = make_binary_op (EDIV, $1, $2, $3); } - | prefix_expr LEFTDIV prefix_expr + | oper_expr LEFTDIV oper_expr { $$ = make_binary_op (LEFTDIV, $1, $2, $3); } - | prefix_expr ELEFTDIV prefix_expr + | oper_expr ELEFTDIV oper_expr { $$ = make_binary_op (ELEFTDIV, $1, $2, $3); } ; @@ -866,9 +863,9 @@ { $$ = finish_colon_expression ($1); } ; -colon_expr1 : prefix_expr +colon_expr1 : oper_expr { $$ = new tree_colon_expression ($1); } - | colon_expr1 ':' prefix_expr + | colon_expr1 ':' oper_expr { if (! ($$ = $1->append ($3))) ABORT_PARSE; @@ -1148,12 +1145,26 @@ } | FOR stash_comment assign_lhs '=' expression opt_sep opt_list END { - if (! ($$ = make_for_command ($1, $3, $5, $7, $8, $2))) + if (! ($$ = make_for_command (FOR, $1, $3, $5, 0, + $7, $8, $2))) ABORT_PARSE; } | FOR stash_comment '(' assign_lhs '=' expression ')' opt_sep opt_list END { - if (! ($$ = make_for_command ($1, $4, $6, $9, $10, $2))) + if (! ($$ = make_for_command (FOR, $1, $4, $6, 0, + $9, $10, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment assign_lhs '=' expression opt_sep opt_list END + { + if (! ($$ = make_for_command (PARFOR, $1, $3, $5, + 0, $7, $8, $2))) + ABORT_PARSE; + } + | PARFOR stash_comment '(' assign_lhs '=' expression ',' expression ')' opt_sep opt_list END + { + if (! ($$ = make_for_command (PARFOR, $1, $4, $6, + $8, $11, $12, $2))) ABORT_PARSE; } ; @@ -1238,6 +1249,7 @@ symtab_context.push (symbol_table::current_scope ()); symbol_table::set_scope (symbol_table::alloc_scope ()); lexer_flags.looking_at_function_handle--; + lexer_flags.looking_at_anon_fcn_args = true; } } ; @@ -1479,7 +1491,7 @@ { $$ = 0; } ; -classdef : classdef1 '\n' class_body '\n' stash_comment classdef_end +classdef : classdef1 opt_sep class_body opt_sep stash_comment classdef_end { $$ = 0; } ; @@ -1526,11 +1538,15 @@ { $$ = 0; } | events_block { $$ = 0; } - | class_body '\n' properties_block + | enum_block + { $$ = 0; } + | class_body opt_sep properties_block { $$ = 0; } - | class_body '\n' methods_block + | class_body opt_sep methods_block { $$ = 0; } - | class_body '\n' events_block + | class_body opt_sep events_block + { $$ = 0; } + | class_body opt_sep enum_block { $$ = 0; } ; @@ -1539,14 +1555,14 @@ ; properties_block - : properties_beg opt_attr_list '\n' properties_list '\n' END + : properties_beg opt_attr_list opt_sep properties_list opt_sep END { $$ = 0; } ; properties_list : class_property { $$ = 0; } - | properties_list '\n' class_property + | properties_list opt_sep class_property { $$ = 0; } ; @@ -1560,13 +1576,13 @@ { $$ = 0; } ; -methods_block : methods_beg opt_attr_list '\n' methods_list '\n' END +methods_block : methods_beg opt_attr_list opt_sep methods_list opt_sep END { $$ = 0; } ; methods_list : function { $$ = 0; } - | methods_list '\n' function + | methods_list opt_sep function { $$ = 0; } ; @@ -1574,13 +1590,13 @@ { $$ = 0; } ; -events_block : events_beg opt_attr_list '\n' events_list '\n' END +events_block : events_beg opt_attr_list opt_sep events_list opt_sep END { $$ = 0; } ; events_list : class_event { $$ = 0; } - | events_list '\n' class_event + | events_list opt_sep class_event { $$ = 0; } ; @@ -1588,6 +1604,24 @@ { $$ = 0; } ; +enum_beg : ENUMERATION stash_comment + { $$ = 0; } + ; + +enum_block : enum_beg opt_attr_list opt_sep enum_list opt_sep END + { $$ = 0; } + ; + +enum_list : class_enum + { $$ = 0; } + | enum_list opt_sep class_enum + { $$ = 0; } + ; + +class_enum : identifier '(' expression ')' + { $$ = 0; } + ; + // ============= // Miscellaneous // ============= @@ -1766,6 +1800,10 @@ end_error ("for", ettype, l, c); break; + case token::enumeration_end: + end_error ("enumeration", ettype, l, c); + break; + case token::function_end: end_error ("function", ettype, l, c); break; @@ -1774,6 +1812,10 @@ end_error ("if", ettype, l, c); break; + case token::parfor_end: + end_error ("parfor", ettype, l, c); + break; + case token::try_catch_end: end_error ("try", ettype, l, c); break; @@ -2079,9 +2121,8 @@ make_anon_fcn_handle (tree_parameter_list *param_list, tree_statement *stmt) { // FIXME -- need to get these from the location of the @ symbol. - - int l = -1; - int c = -1; + int l = input_line_number; + int c = current_input_column; tree_parameter_list *ret_list = 0; @@ -2102,6 +2143,9 @@ tree_anon_fcn_handle *retval = new tree_anon_fcn_handle (param_list, ret_list, body, fcn_scope, l, c); + // FIXME: Stash the filename. This does not work and produces + // errors when executed. + //retval->stash_file_name (curr_fcn_file_name); return retval; } @@ -2482,13 +2526,16 @@ // Build a for command. static tree_command * -make_for_command (token *for_tok, tree_argument_list *lhs, - tree_expression *expr, tree_statement_list *body, - token *end_tok, octave_comment_list *lc) +make_for_command (int tok_id, token *for_tok, tree_argument_list *lhs, + tree_expression *expr, tree_expression *maxproc, + tree_statement_list *body, token *end_tok, + octave_comment_list *lc) { tree_command *retval = 0; - if (end_token_ok (end_tok, token::for_end)) + bool parfor = tok_id == PARFOR; + + if (end_token_ok (end_tok, parfor ? token::parfor_end : token::for_end)) { octave_comment_list *tc = octave_comment_buffer::get_comment (); @@ -2501,14 +2548,19 @@ { tree_expression *tmp = lhs->remove_front (); - retval = new tree_simple_for_command (tmp, expr, body, - lc, tc, l, c); + retval = new tree_simple_for_command (parfor, tmp, expr, maxproc, + body, lc, tc, l, c); delete lhs; } else - retval = new tree_complex_for_command (lhs, expr, body, - lc, tc, l, c); + { + if (parfor) + yyerror ("invalid syntax for parfor statement"); + else + retval = new tree_complex_for_command (lhs, expr, body, + lc, tc, l, c); + } } return retval; @@ -2908,6 +2960,7 @@ } fcn->stash_function_name (id_name); + fcn->stash_fcn_location (input_line_number, current_input_column); if (! help_buf.empty () && current_function_depth == 1 && ! parsing_subfunctions) @@ -3348,11 +3401,10 @@ break; case '\n': - current_input_column = 0; + current_input_column = 1; break; default: - current_input_column--; reader.ungetc (c); goto done; } @@ -3479,18 +3531,11 @@ parsing_subfunctions = false; endfunction_found = false; - // The next four lines must be in this order. - frame.add_fcn (command_history::ignore_entries, ! Vsaving_history); - - // FIXME -- we shouldn't need both the - // command_history object and the - // Vsaving_history variable... + frame.add_fcn (command_history::ignore_entries, + command_history::ignoring_entries ()); + command_history::ignore_entries (); - frame.protect_var (Vsaving_history); - - Vsaving_history = false; - FILE *ffile = get_input_from_file (ff, 0); frame.add_fcn (safe_fclose, ffile); @@ -4194,7 +4239,9 @@ retval = feval (name, tmp_args, nargout); } } - else if (f_arg.is_function_handle () || f_arg.is_inline_function ()) + else if (f_arg.is_function_handle () + || f_arg.is_anonymous_function () + || f_arg.is_inline_function ()) { const octave_value_list tmp_args = get_feval_args (args);
--- a/src/oct-stream.cc +++ b/src/oct-stream.cc @@ -1227,158 +1227,9 @@ if (c1 != EOF) { - if (c1 == 'N') - { - int c2 = is.get (); - - if (c2 != EOF) - { - if (c2 == 'A') - { - int c3 = is.get (); - - if (c3 != EOF) - { - is.putback (c3); - - if (isspace (c3) || ispunct (c3)) - ref = octave_NA; - else - { - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.clear (); - - ref = octave_NA; - } - } - else if (c2 == 'a') - { - int c3 = is.get (); - - if (c3 != EOF) - { - if (c3 == 'N') - { - int c4 = is.get (); - - if (c4 != EOF) - { - is.putback (c4); - - if (isspace (c4) || ispunct (c4)) - ref = octave_NaN; - else - { - is.putback (c3); - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.clear (); - - ref = octave_NaN; - } - } - else - { - is.putback (c3); - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - } - else - { - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - } - else if (c1 == 'I') - { - int c2 = is.get (); - - if (c2 != EOF) - { - if (c2 == 'n') - { - int c3 = is.get (); - - if (c3 != EOF) - { - if (c3 == 'f') - { - int c4 = is.get (); - - if (c4 != EOF) - { - is.putback (c4); - - if (isspace (c4) || ispunct (c4)) - ref = octave_Inf; - else - { - is.putback (c3); - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.clear (); - - ref = octave_Inf; - } - } - else - { - is.putback (c3); - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - else - { - is.putback (c2); - is.putback (c1); - - is >> ref; - } - } - } - else - { - is.putback (c1); - - is >> ref; - } + is.putback (c1); + + ref = octave_read_value<double> (is); } } break; @@ -2264,7 +2115,7 @@ octave_idx_type len = fmt_list.length (); - retval.resize (nconv+1, Matrix ()); + retval.resize (nconv+2, Matrix ()); const scanf_format_elt *elt = fmt_list.first (); @@ -2294,6 +2145,9 @@ retval(nconv) = num_values; + int err_num; + retval(nconv+1) = error (false, err_num); + if (! quit) { // Pick up any trailing stuff. @@ -3011,38 +2865,60 @@ { clearerr (); + // Find current position so we can return to it if needed. + long orig_pos = rep->tell (); - status = rep->seek (offset, origin); + // Move to end of file. If successful, find the offset of the end. + + status = rep->seek (0, SEEK_END); if (status == 0) { - long save_pos = rep->tell (); - - rep->seek (0, SEEK_END); - - long pos_eof = rep->tell (); - - // I don't think save_pos can be less than zero, but we'll - // check anyway... - - if (save_pos > pos_eof || save_pos < 0) + long eof_pos = rep->tell (); + + if (origin == SEEK_CUR) + { + // Move back to original position, otherwise we will be + // seeking from the end of file which is probably not the + // original location. + + rep->seek (orig_pos, SEEK_SET); + } + + // Attempt to move to desired position; may be outside bounds + // of existing file. + + status = rep->seek (offset, origin); + + if (status == 0) { - // Seek outside bounds of file. Failure should leave - // position unchanged. + // Where are we after moving to desired position? + + long desired_pos = rep->tell (); + + // I don't think save_pos can be less than zero, but we'll + // check anyway... + + if (desired_pos > eof_pos || desired_pos < 0) + { + // Seek outside bounds of file. Failure should leave + // position unchanged. + + rep->seek (orig_pos, SEEK_SET); + + status = -1; + } + } + else + { + // Seeking to the desired position failed. Move back to + // original position and return failure status. rep->seek (orig_pos, SEEK_SET); status = -1; } - else - { - // Is it possible for this to fail? We are just - // returning to a position after the first successful - // seek. - - rep->seek (save_pos, SEEK_SET); - } } }
--- a/src/octave-config.cc.in +++ b/src/octave-config.cc.in @@ -219,6 +219,6 @@ return 1; } } - + return 0; }
--- a/src/octave-config.in +++ b/src/octave-config.in @@ -19,7 +19,7 @@ ## You should have received a copy of the GNU General Public License ## along with Octave; see the file COPYING. If not, see ## <http://www.gnu.org/licenses/>. -## +## ## Original version by Rafael Laboissiere <rafael@laboissiere.net> ## distributed as free software in the public domain.
--- a/src/octave.cc +++ b/src/octave.cc @@ -58,6 +58,7 @@ #include "octave.h" #include "oct-hist.h" #include "oct-map.h" +#include "oct-mutex.h" #include "oct-obj.h" #include "ops.h" #include "ov.h" @@ -632,6 +633,8 @@ octave_program_invocation_name = octave_env::get_program_invocation_name (); octave_program_name = octave_env::get_program_name (); + octave_thread::init (); + // The order of these calls is important. The call to // install_defaults must come before install_builtins because // default variable values must be available for the variables to be @@ -865,9 +868,9 @@ load_path::initialize (set_initial_path); - execute_startup_files (); + initialize_history (read_history_file); - initialize_history (read_history_file); + execute_startup_files (); if (! inhibit_startup_message && reading_startup_message_printed) std::cout << std::endl; @@ -971,6 +974,11 @@ return retval; } +/* +%!error argv (1); +%!assert (iscellstr (argv ())); +*/ + DEFUN (program_invocation_name, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} program_invocation_name ()\n\ @@ -993,6 +1001,11 @@ return retval; } +/* +%!error program_invocation_name (1); +%!assert (ischar (program_invocation_name ())); +*/ + DEFUN (program_name, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} program_name ()\n\ @@ -1010,3 +1023,8 @@ return retval; } + +/* +%!error program_name (1); +%!assert (ischar (program_name ())); +*/
--- a/src/octave.gperf +++ b/src/octave.gperf @@ -38,14 +38,17 @@ end_try_catch_kw, end_unwind_protect_kw, endclassdef_kw, + endenumeration_kw, endevents_kw, endfor_kw, endfunction_kw, endif_kw, endmethods_kw, + endparfor_kw, endproperties_kw, endswitch_kw, endwhile_kw, + enumeration_kw, events_kw, for_kw, function_kw, @@ -56,6 +59,7 @@ magic_line_kw, methods_kw, otherwise_kw, + parfor_kw, properties_kw, return_kw, set_kw, @@ -82,14 +86,17 @@ end_try_catch, END, end_try_catch_kw end_unwind_protect, END, end_unwind_protect_kw endclassdef, END, endclassdef_kw +endenumeration, END, endenumeration_kw endevents, END, endevents_kw endfor, END, endfor_kw endfunction, END, endfunction_kw endif, END, endif_kw endmethods, END, endmethods_kw +endparfor, END, endparfor_kw endproperties, END, endproperties_kw endswitch, END, endswitch_kw endwhile, END, endwhile_kw +enumeration, ENUMERATION, enumeration_kw events, EVENTS, events_kw for, FOR, for_kw function, FCN, function_kw @@ -98,6 +105,7 @@ if, IF, if_kw methods, METHODS, methods_kw otherwise, OTHERWISE, otherwise_kw +parfor, PARFOR, parfor_kw persistent, STATIC, static_kw properties, PROPERTIES, properties_kw return, FUNC_RET, return_kw
--- a/src/ov-base-mat.h +++ b/src/ov-base-mat.h @@ -89,6 +89,9 @@ octave_value do_index_op (const octave_value_list& idx, bool resize_ok = false); + octave_value_list do_multi_index_op (int, const octave_value_list& idx) + { return do_index_op (idx); } + void assign (const octave_value_list& idx, const MT& rhs); void assign (const octave_value_list& idx, typename MT::element_type rhs);
--- a/src/ov-base.cc +++ b/src/ov-base.cc @@ -50,6 +50,7 @@ #include "ov-str-mat.h" #include "ov-fcn-handle.h" #include "parse.h" +#include "pr-output.h" #include "utils.h" #include "variables.h" @@ -419,7 +420,9 @@ { os << name << " ="; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); + retval = true; } @@ -435,7 +438,7 @@ print (output_buf); - if (print_padding && pad_after) + if (print_padding && pad_after && ! Vcompact_format) newline (output_buf); } @@ -1548,3 +1551,16 @@ { return SET_INTERNAL_VARIABLE (sparse_auto_mutate); } + +/* + +%!test + s = speye(3); + sparse_auto_mutate (false); + s(:, 1) = 1; + assert (typeinfo (s), "sparse matrix"); + sparse_auto_mutate (true); + s(1, :) = 1; + assert (typeinfo (s), "matrix"); + +*/
--- a/src/ov-base.h +++ b/src/ov-base.h @@ -427,6 +427,8 @@ virtual bool is_function_handle (void) const { return false; } + virtual bool is_anonymous_function (void) const { return false; } + virtual bool is_inline_function (void) const { return false; } virtual bool is_function (void) const { return false; }
--- a/src/ov-bool.h +++ b/src/ov-bool.h @@ -119,6 +119,30 @@ uint64_array_value (void) const { return uint64NDArray (dim_vector (1, 1), scalar); } + octave_int8 + int8_scalar_value (void) const { return octave_int8 (scalar); } + + octave_int16 + int16_scalar_value (void) const { return octave_int16 (scalar); } + + octave_int32 + int32_scalar_value (void) const { return octave_int32 (scalar); } + + octave_int64 + int64_scalar_value (void) const { return octave_int64 (scalar); } + + octave_uint8 + uint8_scalar_value (void) const { return octave_uint8 (scalar); } + + octave_uint16 + uint16_scalar_value (void) const { return octave_uint16 (scalar); } + + octave_uint32 + uint32_scalar_value (void) const { return octave_uint32 (scalar); } + + octave_uint64 + uint64_scalar_value (void) const { return octave_uint64 (scalar); } + double double_value (bool = false) const { return scalar; } float float_value (bool = false) const { return scalar; }
--- a/src/ov-builtin.cc +++ b/src/ov-builtin.cc @@ -29,6 +29,7 @@ #include "oct-obj.h" #include "ov-builtin.h" #include "ov.h" +#include "profiler.h" #include "toplev.h" #include "unwind-prot.h" @@ -125,6 +126,8 @@ try { + BEGIN_PROFILER_BLOCK (profiler_name ()) + retval = (*f) (args, nargout); // Do not allow null values to be returned from functions. // FIXME -- perhaps true builtins should be allowed? @@ -137,6 +140,8 @@ // the idiom is very common, so we solve that here. if (retval.length () == 1 && retval.xelem (0).is_undefined ()) retval.clear (); + + END_PROFILER_BLOCK } catch (octave_execution_exception) {
--- a/src/ov-class.cc +++ b/src/ov-class.cc @@ -80,15 +80,120 @@ error ("parents must be objects"); else { - std::string cnm = parent.class_name (); + std::string pcnm = parent.class_name (); - if (find_parent_class (cnm)) + if (find_parent_class (pcnm)) error ("duplicate class in parent tree"); else { - parent_list.push_back (cnm); + parent_list.push_back (pcnm); + + octave_idx_type nel = map.numel (); + octave_idx_type p_nel = parent.numel (); + + if (nel == 0) + { + if (p_nel == 0) + { + // No elements in MAP or the parent class object, + // so just add the field name. + + map.assign (pcnm, Cell (map.dims ())); + } + else if (p_nel == 1) + { + if (map.nfields () == 0) + { + // No elements or fields in MAP, but the + // parent is class object with one element. + // Resize to match size of parent class and + // make the parent a field in MAP. + + map.resize (parent.dims ()); + + map.assign (pcnm, parent); + } + else + { + // No elements in MAP, but we have at least + // one field. So don't resize, just add the + // field name. + + map.assign (pcnm, Cell (map.dims ())); + } + } + else if (map.nfields () == 0) + { + // No elements or fields in MAP and more than one + // element in the parent class object, so we can + // resize MAP to match parent dimsenions, then + // distribute the elements of the parent object to + // the elements of MAP. + + dim_vector parent_dims = parent.dims (); + + map.resize (parent_dims); + + Cell c (parent_dims); + + octave_map pmap = parent.map_value (); - map.assign (cnm, parent); + std::list<std::string> plist + = parent.parent_class_name_list (); + + for (octave_idx_type i = 0; i < p_nel; i++) + c(i) = octave_value (pmap.index(i), pcnm, plist); + + map.assign (pcnm, c); + } + else + error ("class: parent class dimension mismatch"); + } + else if (nel == 1 && p_nel == 1) + { + // Simple assignment. + + map.assign (pcnm, parent); + } + else + { + if (p_nel == 1) + { + // Broadcast the scalar parent class object to + // each element of MAP. + + Cell pcell (map.dims (), parent); + + map.assign (pcnm, pcell); + } + + else if (nel == p_nel) + { + // FIXME -- is there a better way to do this? + + // The parent class object has the same number of + // elements as the map we are using to create the + // new object, so distribute those elements to + // each element of the new object by first + // splitting the elements of the parent class + // object into a cell array with one element per + // cell. Then do the assignment all at once. + + Cell c (parent.dims ()); + + octave_map pmap = parent.map_value (); + + std::list<std::string> plist + = parent.parent_class_name_list (); + + for (octave_idx_type i = 0; i < p_nel; i++) + c(i) = octave_value (pmap.index(i), pcnm, plist); + + map.assign (pcnm, c); + } + else + error ("class: parent class dimension mismatch"); + } } } } @@ -322,6 +427,17 @@ else error ("@%s/size: invalid return value", class_name ().c_str ()); } + else + { + dim_vector dv = dims (); + + int nd = dv.length (); + + retval.resize (1, nd); + + for (int i = 0; i < nd; i++) + retval(i) = dv(i); + } return retval; } @@ -475,7 +591,8 @@ else { if (type.length () == 1 && type[0] == '(') - retval(0) = octave_value (map.index (idx.front ()), class_name ()); + retval(0) = octave_value (map.index (idx.front ()), class_name (), + parent_class_name_list ()); else gripe_invalid_index1 (); } @@ -996,6 +1113,35 @@ return retval; } +string_vector +octave_class::all_strings (bool pad) const +{ + string_vector retval; + + octave_value meth = symbol_table::find_method ("char", class_name ()); + + if (meth.is_defined ()) + { + octave_value_list args; + args(0) = octave_value (new octave_class (map, c_name)); + + octave_value_list tmp = feval (meth.function_value (), args, 1); + + if (!error_state && tmp.length () >= 1) + { + if (tmp(0).is_string ()) + retval = tmp(0).all_strings (pad); + else + error ("cname/char method did not return a character string"); + } + } + else + error ("no char method defined for class %s", class_name().c_str ()); + + return retval; +} + + void octave_class::print (std::ostream& os, bool) const { @@ -1020,7 +1166,8 @@ indent (os); os << name << " ="; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); return retval; } @@ -1685,6 +1832,7 @@ return (fcn && (fcn->is_class_method () || fcn->is_class_constructor () + || fcn->is_anonymous_function_of_class () || fcn->is_private_function_of_class (class_name ())) && find_parent_class (fcn->dispatch_class ())); }
--- a/src/ov-class.h +++ b/src/ov-class.h @@ -54,9 +54,11 @@ parent_list (), obsolete_copies (0) { } - octave_class (const octave_map& m, const std::string& id) + octave_class (const octave_map& m, const std::string& id, + const std::list<std::string>& plist + = std::list<std::string> ()) : octave_base_value (), map (m), c_name (id), - parent_list (), obsolete_copies (0) + parent_list (plist), obsolete_copies (0) { } octave_class (const octave_class& s) @@ -94,6 +96,12 @@ const std::list<octave_value_list>& idx, int nargout); + octave_value_list + do_multi_index_op (int nargout, const octave_value_list& idx) + { + return subsref ("(", std::list<octave_value_list> (1, idx), nargout); + } + static octave_value numeric_conv (const Cell& val, const std::string& type); @@ -127,14 +135,14 @@ size_t nparents (void) const { return parent_list.size (); } octave_value reshape (const dim_vector& new_dims) const - { + { octave_class retval = octave_class (*this); retval.map = retval.map_value().reshape (new_dims); return octave_value (new octave_class (retval)); } octave_value resize (const dim_vector& dv, bool = false) const - { + { octave_class retval = octave_class (*this); retval.map.resize (dv); return octave_value (new octave_class (retval)); @@ -160,6 +168,8 @@ octave_base_value *unique_parent_class (const std::string&); + string_vector all_strings (bool pad) const; + void print (std::ostream& os, bool pr_as_read_syntax = false) const; void print_raw (std::ostream& os, bool pr_as_read_syntax = false) const;
--- a/src/ov-cx-sparse.cc +++ b/src/ov-cx-sparse.cc @@ -904,7 +904,7 @@ ARRAY_MAPPER (atan, Complex, ::atan); ARRAY_MAPPER (atanh, Complex, ::atanh); ARRAY_MAPPER (ceil, Complex, ::ceil); - ARRAY_MAPPER (conj, Complex, std::conj); + ARRAY_MAPPER (conj, Complex, std::conj<double>); ARRAY_MAPPER (cos, Complex, std::cos); ARRAY_MAPPER (cosh, Complex, std::cosh); ARRAY_MAPPER (exp, Complex, std::exp);
--- a/src/ov-fcn-handle.cc +++ b/src/ov-fcn-handle.cc @@ -164,7 +164,38 @@ else { str_ov_map::iterator it = overloads.find (dispatch_type); - if (it != overloads.end ()) + + if (it == overloads.end ()) + { + // Try parent classes too. + + std::list<std::string> plist + = symbol_table::parent_classes (dispatch_type); + + std::list<std::string>::const_iterator pit = plist.begin (); + + while (pit != plist.end ()) + { + std::string pname = *pit; + + std::string fnm = fcn_name (); + + octave_value ftmp = symbol_table::find_method (fnm, pname); + + if (ftmp.is_defined ()) + { + set_overload (pname, ftmp); + + out_of_date_check (ftmp, pname, false); + ov_fcn = ftmp; + + break; + } + + pit++; + } + } + else { out_of_date_check (it->second, dispatch_type, false); ov_fcn = it->second; @@ -1925,3 +1956,12 @@ return retval; } + +/* +%!function r = f (g, i) +%! r = g(i); +%!endfunction +%!test +%! x = [1,2;3,4]; +%! assert (f (@(i) x(:,i), 1), [1;3]); +*/
--- a/src/ov-fcn.h +++ b/src/ov-fcn.h @@ -61,6 +61,9 @@ virtual std::string fcn_file_name (void) const { return std::string (); } + // The name to show in the profiler (also used as map-key). + virtual std::string profiler_name (void) const { return name (); } + virtual std::string parent_fcn_name (void) const { return std::string (); } virtual symbol_table::scope_id parent_fcn_scope (void) const { return -1; } @@ -100,9 +103,13 @@ bool is_private_function (void) const { return private_function; } - bool is_private_function_of_class (const std::string& nm) + bool is_private_function_of_class (const std::string& nm) const { return private_function && xdispatch_class == nm; } + virtual bool + is_anonymous_function_of_class (const std::string& = std::string ()) const + { return false; } + std::string dir_name (void) const { return my_dir_name; } void stash_dir_name (const std::string& dir) { my_dir_name = dir; }
--- a/src/ov-flt-re-mat.cc +++ b/src/ov-flt-re-mat.cc @@ -839,3 +839,32 @@ return octave_value (); } + +/* + +%!assert (class (single(1)), "single") +%!assert (class (single(1 + i)), "single") +%!assert (class (single (int8 (1))), "single") +%!assert (class (single (uint8 (1))), "single") +%!assert (class (single (int16 (1))), "single") +%!assert (class (single (uint16 (1))), "single") +%!assert (class (single (int32 (1))), "single") +%!assert (class (single (uint32 (1))), "single") +%!assert (class (single (int64 (1))), "single") +%!assert (class (single (uint64 (1))), "single") +%!assert (class (single (true)), "single") +%!assert (class (single ("A")), "single") +%!error (single (sparse (1))) +%!test +%! x = diag ([1 3 2]); +%! y = single (x); +%! assert (class (x), "double"); +%! assert (class (y), "single"); +%!test +%! x = diag ([i 3 2]); +%! y = single (x); +%! assert (class (x), "double"); +%! assert (class (y), "single"); + +*/ +
--- a/src/ov-int16.cc +++ b/src/ov-int16.cc @@ -82,3 +82,15 @@ { OCTAVE_TYPE_CONV_BODY (int16); } + +/* + +%!assert (class (int16 (1)), "int16") +%!assert (int16 (1.25), int16 (1)) +%!assert (int16 (1.5), int16 (2)) +%!assert (int16 (-1.5), int16 (-2)) +%!assert (int16 (2^17), int16 (2^16-1)) +%!assert (int16 (-2^17), int16 (-2^16)) + +*/ +
--- a/src/ov-int32.cc +++ b/src/ov-int32.cc @@ -82,3 +82,15 @@ { OCTAVE_TYPE_CONV_BODY (int32); } + +/* + +%!assert (class (int32 (1)), "int32") +%!assert (int32 (1.25), int32 (1)) +%!assert (int32 (1.5), int32 (2)) +%!assert (int32 (-1.5), int32 (-2)) +%!assert (int32 (2^33), int32 (2^32-1)) +%!assert (int32 (-2^33), int32 (-2^32)) + +*/ +
--- a/src/ov-int64.cc +++ b/src/ov-int64.cc @@ -82,3 +82,15 @@ { OCTAVE_TYPE_CONV_BODY (int64); } + +/* + +%!assert (class (int64 (1)), "int64") +%!assert (int64 (1.25), int64 (1)) +%!assert (int64 (1.5), int64 (2)) +%!assert (int64 (-1.5), int64 (-2)) +%!assert (int64 (2^65), int64 (2^64-1)) +%!assert (int64 (-2^65), int64 (-2^64)) + +*/ +
--- a/src/ov-int8.cc +++ b/src/ov-int8.cc @@ -82,3 +82,14 @@ { OCTAVE_TYPE_CONV_BODY (int8); } + +/* + +%!assert (class (int8 (1)), "int8") +%!assert (int8 (1.25), int8 (1)) +%!assert (int8 (1.5), int8 (2)) +%!assert (int8 (-1.5), int8 (-2)) +%!assert (int8 (2^9), int8 (2^8-1)) +%!assert (int8 (-2^9), int8 (-2^8)) + +*/
--- a/src/ov-mex-fcn.cc +++ b/src/ov-mex-fcn.cc @@ -33,6 +33,7 @@ #include "oct-obj.h" #include "ov-mex-fcn.h" #include "ov.h" +#include "profiler.h" #include "toplev.h" #include "unwind-prot.h" @@ -147,7 +148,9 @@ try { + BEGIN_PROFILER_BLOCK (profiler_name ()) retval = call_mex (have_fmex, mex_fcn_ptr, args, nargout, this); + END_PROFILER_BLOCK } catch (octave_execution_exception) {
--- a/src/ov-null-mat.cc +++ b/src/ov-null-mat.cc @@ -118,3 +118,17 @@ return retval; } +/* + +%!assert (isnull ([]), true) +%!assert (isnull ([1]), false) +%!assert (isnull (zeros (0,3)), false) +%!assert (isnull (""), true) +%!assert (isnull ("A"), false) +%!assert (isnull (''), true) +%!assert (isnull ('A'), false) +%!test +%! x = []; +%! assert (isnull (x), false); + +*/
--- a/src/ov-perm.cc +++ b/src/ov-perm.cc @@ -217,6 +217,12 @@ return SparseMatrix (matrix); } +SparseBoolMatrix +octave_perm_matrix::sparse_bool_matrix_value (bool) const +{ + return SparseBoolMatrix (matrix); +} + SparseComplexMatrix octave_perm_matrix::sparse_complex_matrix_value (bool) const {
--- a/src/ov-perm.h +++ b/src/ov-perm.h @@ -160,6 +160,8 @@ SparseMatrix sparse_matrix_value (bool = false) const; + SparseBoolMatrix sparse_bool_matrix_value (bool = false) const; + SparseComplexMatrix sparse_complex_matrix_value (bool = false) const; int8NDArray
--- a/src/ov-range.cc +++ b/src/ov-range.cc @@ -370,7 +370,9 @@ { os << name << " ="; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); + retval = true; } @@ -655,3 +657,16 @@ { return SET_INTERNAL_VARIABLE (allow_noninteger_range_as_index); } + +/* +%!test +%! x = 0:10; +%! save = allow_noninteger_range_as_index (0); +%! fail ('x(2.1:5)'); +%! assert (x(2:5), 1:4); +%! allow_noninteger_range_as_index (1); +%! assert (x(2.49:5), 1:3); +%! assert (x(2.5:5), 2:4); +%! assert (x(2.51:5), 2:4); +%! allow_noninteger_range_as_index (save); +*/
--- a/src/ov-re-mat.cc +++ b/src/ov-re-mat.cc @@ -979,3 +979,36 @@ return octave_value (); } + +/* + +%!assert (class (double (single (1))), "double") +%!assert (class (double (single (1 + i))), "double") +%!assert (class (double (int8 (1))), "double") +%!assert (class (double (uint8 (1))), "double") +%!assert (class (double (int16 (1))), "double") +%!assert (class (double (uint16 (1))), "double") +%!assert (class (double (int32 (1))), "double") +%!assert (class (double (uint32 (1))), "double") +%!assert (class (double (int64 (1))), "double") +%!assert (class (double (uint64 (1))), "double") +%!assert (class (double (true)), "double") +%!assert (class (double ("A")), "double") +%!test +%! x = sparse (logical ([1 0; 0 1])); +%! y = double (x); +%! assert (class (x), "logical"); +%! assert (class (y), "double"); +%! assert (issparse (y)); +%!test +%! x = diag (single ([1 3 2])); +%! y = double (x); +%! assert (class (x), "single"); +%! assert (class (y), "double"); +%!test +%! x = diag (single ([i 3 2])); +%! y = double (x); +%! assert (class (x), "single"); +%! assert (class (y), "double"); + +*/
--- a/src/ov-struct.cc +++ b/src/ov-struct.cc @@ -480,7 +480,7 @@ } else { - if (t_rhs.is_map()) + if (t_rhs.is_map() || t_rhs.is_object ()) { octave_map rhs_map = t_rhs.map_value (); @@ -1335,11 +1335,14 @@ increment_indent_level (); - newline (os); + if (! Vcompact_format) + newline (os); + indent (os); os << "scalar structure containing the fields:"; newline (os); - newline (os); + if (! Vcompact_format) + newline (os); increment_indent_level ();
--- a/src/ov-typeinfo.cc +++ b/src/ov-typeinfo.cc @@ -595,7 +595,7 @@ @deftypefnx {Built-in Function} {} typeinfo (@var{expr})\n\ \n\ Return the type of the expression @var{expr}, as a string. If\n\ -@var{expr} is omitted, return an array of strings containing all the\n\ +@var{expr} is omitted, return an cell array of strings containing all the\n\ currently installed data types.\n\ @end deftypefn") { @@ -612,3 +612,74 @@ return retval; } + +/* +%!error typeinfo ("foo", 1); + +%!assert (iscellstr (typeinfo ())); + +%!assert (typeinfo (false), "bool"); +%!assert (typeinfo ([true, false]), "bool matrix"); + +%!assert (typeinfo (1:2), "range"); + +%!assert (typeinfo ("string"), "string"); +%!assert (typeinfo ('string'), "sq_string"); + +%!assert (typeinfo (diag ([1, 2])), "diagonal matrix") +%!assert (typeinfo (diag ([i, 2])), "complex diagonal matrix") +%!assert (typeinfo (single (diag ([1, 2]))), "float diagonal matrix") +%!assert (typeinfo (single (diag ([i, 2]))), "float complex diagonal matrix") +%!assert (typeinfo (diag (single ([1, 2]))), "float diagonal matrix") +%!assert (typeinfo (diag (single ([i, 2]))), "float complex diagonal matrix") + +%!assert (typeinfo ([]), "null_matrix"); +%!assert (typeinfo (""), "null_string"); +%!assert (typeinfo (''), "null_sq_string"); + +%!assert (typeinfo (1), "scalar"); +%!assert (typeinfo (double (1)), "scalar"); +%!assert (typeinfo ([1, 2]), "matrix"); +%!assert (typeinfo (double ([1, 2])), "matrix"); + +%!assert (typeinfo (i), "complex scalar"); +%!assert (typeinfo ([i, 2]), "complex matrix"); + +%!assert (typeinfo (single (1)), "float scalar"); +%!assert (typeinfo (single ([1, 2])), "float matrix"); + +%!assert (typeinfo (single (i)), "float complex scalar"); +%!assert (typeinfo (single ([i, 2])), "float complex matrix"); + +%!assert (typeinfo (sparse (eye (10))), "sparse matrix"); +%!assert (typeinfo (sparse (i * eye (10))), "sparse complex matrix"); +%!assert (typeinfo (logical (sparse (i * eye (10)))), "sparse bool matrix"); + +%!assert (typeinfo (int8 (1)), "int8 scalar"); +%!assert (typeinfo (int16 (1)), "int16 scalar"); +%!assert (typeinfo (int32 (1)), "int32 scalar"); +%!assert (typeinfo (int64 (1)), "int64 scalar"); +%!assert (typeinfo (uint8 (1)), "uint8 scalar"); +%!assert (typeinfo (uint16 (1)), "uint16 scalar"); +%!assert (typeinfo (uint32 (1)), "uint32 scalar"); +%!assert (typeinfo (uint64 (1)), "uint64 scalar"); + +%!test +%! s.a = 1; +%! assert (typeinfo (s), "scalar struct"); + +%!test +%! s(2).a = 1; +%! assert (typeinfo (s), "struct"); + +%!assert (typeinfo ({"cell"}), "cell"); + +%!assert (typeinfo (@sin), "function handle"); +%!assert (typeinfo (@(x) x), "function handle"); + +%!assert (typeinfo (inline ('x^2')), "inline function"); + +%!test +%! [l, u, p] = lu (rand (3)); +%! assert (typeinfo (p), "permutation matrix"); +*/
--- a/src/ov-uint16.cc +++ b/src/ov-uint16.cc @@ -82,3 +82,15 @@ { OCTAVE_TYPE_CONV_BODY (uint16); } + +/* + +%!assert (class (uint16 (1)), "uint16") +%!assert (uint16 (1.25), uint16 (1)) +%!assert (uint16 (1.5), uint16 (2)) +%!assert (uint16 (-1.5), uint16 (0)) +%!assert (uint16 (2^17), uint16 (2^16-1)) +%!assert (uint16 (-2^17), uint16 (0)) + +*/ +
--- a/src/ov-uint32.cc +++ b/src/ov-uint32.cc @@ -82,3 +82,14 @@ { OCTAVE_TYPE_CONV_BODY (uint32); } + +/* + +%!assert (class (uint32 (1)), "uint32") +%!assert (uint32 (1.25), uint32 (1)) +%!assert (uint32 (1.5), uint32 (2)) +%!assert (uint32 (-1.5), uint32 (0)) +%!assert (uint32 (2^33), uint32 (2^32-1)) +%!assert (uint32 (-2^33), uint32 (0)) + +*/
--- a/src/ov-uint64.cc +++ b/src/ov-uint64.cc @@ -82,3 +82,14 @@ { OCTAVE_TYPE_CONV_BODY (uint64); } + +/* + +%!assert (class (uint64 (1)), "uint64") +%!assert (uint64 (1.25), uint64 (1)) +%!assert (uint64 (1.5), uint64 (2)) +%!assert (uint64 (-1.5), uint64 (0)) +%!assert (uint64 (2^65), uint64 (2^64-1)) +%!assert (uint64 (-2^65), uint64 (0)) + +*/
--- a/src/ov-uint8.cc +++ b/src/ov-uint8.cc @@ -82,3 +82,14 @@ { OCTAVE_TYPE_CONV_BODY (uint8); } + +/* + +%!assert (class (uint8 (1)), "uint8") +%!assert (uint8 (1.25), uint8 (1)) +%!assert (uint8 (1.5), uint8 (2)) +%!assert (uint8 (-1.5), uint8 (0)) +%!assert (uint8 (2^9), uint8 (2^8-1)) +%!assert (uint8 (-2^9), uint8 (0)) + +*/
--- a/src/ov-usr-fcn.cc +++ b/src/ov-usr-fcn.cc @@ -24,6 +24,8 @@ #include <config.h> #endif +#include <sstream> + #include "str-vec.h" #include <defaults.h> @@ -47,6 +49,7 @@ #include "unwind-prot.h" #include "utils.h" #include "parse.h" +#include "profiler.h" #include "variables.h" // Whether to optimize subsasgn method calls. @@ -131,7 +134,9 @@ frame.protect_var (tree_evaluator::statement_context); tree_evaluator::statement_context = tree_evaluator::script; + BEGIN_PROFILER_BLOCK (profiler_name ()) cmd_list->accept (*current_evaluator); + END_PROFILER_BLOCK if (tree_return_command::returning) tree_return_command::returning = 0; @@ -176,13 +181,14 @@ : octave_user_code (std::string (), std::string ()), param_list (pl), ret_list (rl), cmd_list (cl), lead_comm (), trail_comm (), file_name (), + location_line (0), location_column (0), parent_name (), t_parsed (static_cast<time_t> (0)), t_checked (static_cast<time_t> (0)), system_fcn_file (false), call_depth (-1), num_named_args (param_list ? param_list->length () : 0), subfunction (false), inline_function (false), - class_constructor (false), class_method (false), - parent_scope (-1), local_scope (sid), + anonymous_function (false), class_constructor (false), + class_method (false), parent_scope (-1), local_scope (sid), curr_unwind_protect_frame (0) { if (cmd_list) @@ -217,6 +223,25 @@ file_name = nm; } +std::string +octave_user_function::profiler_name (void) const +{ + std::ostringstream result; + + if (is_inline_function ()) + result << "inline@" << fcn_file_name () + << ":" << location_line << ":" << location_column; + else if (is_anonymous_function ()) + result << "anonymous@" << fcn_file_name () + << ":" << location_line << ":" << location_column; + else if (is_subfunction ()) + result << parent_fcn_name () << ">" << name (); + else + result << name (); + + return result.str (); +} + void octave_user_function::mark_as_system_fcn_file (void) { @@ -428,8 +453,9 @@ frame.protect_var (tree_evaluator::statement_context); tree_evaluator::statement_context = tree_evaluator::function; - bool special_expr = (is_inline_function () - || cmd_list->is_anon_function_body ()); + bool special_expr = (is_inline_function () || is_anonymous_function ()); + + BEGIN_PROFILER_BLOCK (profiler_name ()) if (special_expr) { @@ -448,6 +474,8 @@ else cmd_list->accept (*current_evaluator); + END_PROFILER_BLOCK + if (echo_commands) print_code_function_trailer (); @@ -607,7 +635,7 @@ Octave. If called with the optional argument @var{fcn_name}, return the\n\ maximum number of arguments the named function can accept, or -1 if the\n\ function accepts a variable number of arguments.\n\ -@seealso{nargout, varargin, varargout}\n\ +@seealso{nargout, varargin, isargout, varargout, nthargout}\n\ @end deftypefn") { octave_value retval; @@ -620,23 +648,33 @@ if (! error_state) { - octave_value fcn_val = symbol_table::find_user_function (fname); + octave_value fcn_val = symbol_table::find_function (fname); - octave_user_function *fcn = fcn_val.user_function_value (true); - - if (fcn) + if (fcn_val.is_user_function ()) { - if (fcn->takes_varargs ()) - retval = -1; - else + octave_user_function *fcn = fcn_val.user_function_value (true); + + if (fcn) { - tree_parameter_list *param_list = fcn->parameter_list (); + if (fcn->takes_varargs ()) + retval = -1; + else + { + tree_parameter_list *param_list = fcn->parameter_list (); - retval = param_list ? param_list->length () : 0; + retval = param_list ? param_list->length () : 0; + } } + else + error ("nargin: loading user-defined function failed"); } else - error ("nargin: invalid function"); + { + // FIXME -- what about built-in functions or functions + // defined in .oct files or .mex files? + + error ("nargin: FCN_NAME must be a user-defined function"); + } } else error ("nargin: FCN_NAME must be a string"); @@ -681,7 +719,7 @@ @code{f}.\n\ \n\ At the top level, @code{nargout} is undefined.\n\ -@seealso{nargin, isargout, varargin, varargout}\n\ +@seealso{nargin, varargin, isargout, varargout, nthargout}\n\ @end deftypefn") { octave_value retval; @@ -778,7 +816,7 @@ false. @var{k} can also be an array, in which case the function works\n\ element-by-element and a logical array is returned. At the top level,\n\ @code{isargout} returns an error.\n\ -@seealso{nargout, nargin, varargin, varargout}\n\ +@seealso{nargout, nargin, varargin, varargout, nthargout}\n\ @end deftypefn") { octave_value retval;
--- a/src/ov-usr-fcn.h +++ b/src/ov-usr-fcn.h @@ -189,6 +189,12 @@ void stash_fcn_file_name (const std::string& nm); + void stash_fcn_location (int line, int col) + { + location_line = line; + location_column = col; + } + void stash_parent_fcn_name (const std::string& p) { parent_name = p; } void stash_parent_fcn_scope (symbol_table::scope_id ps) { parent_scope = ps; } @@ -207,6 +213,8 @@ std::string fcn_file_name (void) const { return file_name; } + std::string profiler_name (void) const; + std::string parent_fcn_name (void) const { return parent_name; } symbol_table::scope_id parent_fcn_scope (void) const { return parent_scope; } @@ -255,6 +263,20 @@ bool is_inline_function (void) const { return inline_function; } + void mark_as_anonymous_function (void) { anonymous_function = true; } + + bool is_anonymous_function (void) const { return anonymous_function; } + + bool is_anonymous_function_of_class + (const std::string& cname = std::string ()) const + { + return anonymous_function + ? (cname.empty () + ? (! dispatch_class().empty ()) + : cname == dispatch_class ()) + : false; + } + void mark_as_class_constructor (void) { class_constructor = true; } bool is_class_constructor (const std::string& cname = std::string ()) const @@ -344,6 +366,10 @@ // The name of the file we parsed. std::string file_name; + // Location where this function was defined. + int location_line; + int location_column; + // The name of the parent function, if any. std::string parent_name; @@ -371,6 +397,9 @@ // TRUE means this is an inline function. bool inline_function; + // TRUE means this is an anonymous function. + bool anonymous_function; + // TRUE means this function is the constructor for class object. bool class_constructor;
--- a/src/ov.cc +++ b/src/ov.cc @@ -1132,8 +1132,9 @@ maybe_mutate (); } -octave_value::octave_value (const Octave_map& m, const std::string& id) - : rep (new octave_class (m, id)) +octave_value::octave_value (const Octave_map& m, const std::string& id, + const std::list<std::string>& plist) + : rep (new octave_class (m, id, plist)) { } @@ -2690,25 +2691,6 @@ octave_lazy_index::register_type (); } -#if 0 -DEFUN (cast, args, , - "-*- texinfo -*-\n\ -@deftypefn {Built-in Function} {} cast (@var{val}, @var{type})\n\ -Convert @var{val} to the new data type @var{type}.\n\ -@seealso{class, typeinfo}\n\ -@end deftypefn") -{ - octave_value retval; - - if (args.length () == 2) - error ("cast: not implemented"); - else - print_usage (); - - return retval; -} -#endif - DEFUN (sizeof, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} sizeof (@var{val})\n\ @@ -2726,6 +2708,12 @@ return retval; } +/* +%!assert (sizeof (uint64 (ones (3))), 72) +%!assert (sizeof (double (zeros (2,4))), 64) +%!assert (sizeof ({"foo", "bar", "baaz"}), 10) +*/ + DEFUN (subsref, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} subsref (@var{val}, @var{idx})\n\ @@ -2834,3 +2822,114 @@ return retval; } + +/* +%!test +%! a = reshape ([1:25], 5,5); +%! idx1 = substruct ( "()", {3, 3}); +%! idx2 = substruct ( "()", {2:2:5, 2:2:5}); +%! idx3 = substruct ( "()", {":", [1,5]}); +%! assert (subsref (a, idx1), 13) +%! assert (subsref (a, idx2), [7 17; 9 19]) +%! assert (subsref (a, idx3), [1:5; 21:25]') +%! a = subsasgn (a, idx1, 0); +%! a = subsasgn (a, idx2, 0); +%! a = subsasgn (a, idx3, 0); +%! b = [0 6 11 16 0 +%! 0 0 12 0 0 +%! 0 8 0 18 0 +%! 0 0 14 0 0 +%! 0 10 15 20 0]; +%! assert (a,b); + +%!test +%! c = num2cell (reshape ([1:25],5,5)); +%! idx1 = substruct ( "{}", {3, 3}); +%! idx2 = substruct ( "()", {2:2:5, 2:2:5}); +%! idx3 = substruct ( "()", {":", [1,5]}); +%! idx2p = substruct ( "{}", {2:2:5, 2:2:5}); +%! idx3p = substruct ( "{}", {":", [1,5]}); +%! assert ({ subsref(c, idx1) }, {13}) +%! assert ({ subsref(c, idx2p) }, {7 9 17 19}) +%! assert ({ subsref(c, idx3p) }, num2cell ([1:5, 21:25])) +%! c = subsasgn (c, idx1, 0); +%! c = subsasgn (c, idx2, 0); +%! c = subsasgn (c, idx3, 0); +%! d = {0 6 11 16 0 +%! 0 0 12 0 0 +%! 0 8 0 18 0 +%! 0 0 14 0 0 +%! 0 10 15 20 0}; +%! assert (c,d); + +%!test +%! s.a = "ohai"; +%! s.b = "dere"; +%! s.c = 42; +%! idx1 = substruct (".", "a"); +%! idx2 = substruct (".", "b"); +%! idx3 = substruct (".", "c"); +%! assert (subsref (s, idx1), "ohai") +%! assert (subsref (s, idx2), "dere") +%! assert (subsref (s, idx3), 42) +%! s = subsasgn (s, idx1, "Hello"); +%! s = subsasgn (s, idx2, "There"); +%! s = subsasgn (s, idx3, 163); +%! t.a = "Hello"; +%! t.b = "There"; +%! t.c = 163; +%! assert (s, t) + +*/ + +DEFUN (is_sq_string, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_sq_string (@var{x})\n\ +Return true if @var{x} is a single-quoted character string.\n\ +@seealso{is_dq_string, ischar}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_sq_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (is_sq_string ('foo'), true); +%!assert (is_sq_string ("foo"), false); +%!assert (is_sq_string (1.0), false); +%!assert (is_sq_string ({2.0}), false); +%!error is_sq_string () +%!error is_sq_string ('foo', 2) +*/ + +DEFUN (is_dq_string, args, , + "-*- texinfo -*-\n\ +@deftypefn {Built-in Function} {} is_dq_string (@var{x})\n\ +Return true if @var{x} is a double-quoted character string.\n\ +@seealso{is_sq_string, ischar}\n\ +@end deftypefn") +{ + octave_value retval; + + if (args.length () == 1) + retval = args(0).is_dq_string (); + else + print_usage (); + + return retval; +} + +/* +%!assert (is_dq_string ("foo"), true); +%!assert (is_dq_string ('foo'), false); +%!assert (is_dq_string (1.0), false); +%!assert (is_dq_string ({2.0}), false); +%!error is_dq_string () +%!error is_dq_string ("foo", 2) +*/
--- a/src/ov.h +++ b/src/ov.h @@ -279,7 +279,9 @@ octave_value (const octave_map& m); octave_value (const octave_scalar_map& m); octave_value (const Octave_map& m); - octave_value (const Octave_map& m, const std::string& id); + octave_value (const Octave_map& m, const std::string& id, + const std::list<std::string>& plist + = std::list<std::string> ()); octave_value (const octave_value_list& m, bool = false); octave_value (octave_value::magic_colon); @@ -654,6 +656,9 @@ bool is_function_handle (void) const { return rep->is_function_handle (); } + bool is_anonymous_function (void) const + { return rep->is_anonymous_function (); } + bool is_inline_function (void) const { return rep->is_inline_function (); } @@ -987,9 +992,8 @@ bool print_name_tag (std::ostream& os, const std::string& name) const { return rep->print_name_tag (os, name); } - void print_with_name (std::ostream& os, const std::string& name, - bool print_padding = true) const - { rep->print_with_name (os, name, print_padding); } + void print_with_name (std::ostream& os, const std::string& name) const + { rep->print_with_name (os, name, true); } int type_id (void) const { return rep->type_id (); } @@ -1367,4 +1371,13 @@ DEF_VALUE_EXTRACTOR (SparseBoolMatrix, sparse_bool_matrix) #undef DEF_VALUE_EXTRACTOR +#define DEF_DUMMY_VALUE_EXTRACTOR(VALUE,DEFVAL) \ +template<> \ +inline VALUE octave_value_extract<VALUE> (const octave_value&) \ + { assert (false); return DEFVAL; } + +DEF_DUMMY_VALUE_EXTRACTOR (char, 0) +DEF_DUMMY_VALUE_EXTRACTOR (octave_value, octave_value ()) +#undef DEF_DUMMY_VALUE_EXTRACTOR + #endif
--- a/src/pager.cc +++ b/src/pager.cc @@ -334,6 +334,29 @@ pb->set_diary_skip (); } +// Reinitialize the pager buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_pager_stream::reset (void) +{ + if (! instance) + instance = new octave_pager_stream (); + + instance->do_reset (); +} + +void +octave_pager_stream::do_reset (void) +{ + delete pb; + pb = new octave_pager_buf (); + rdbuf (pb); + setf (unitbuf); +} + octave_diary_stream *octave_diary_stream::instance = 0; octave_diary_stream::octave_diary_stream (void) : std::ostream (0), db (0) @@ -358,6 +381,29 @@ return *instance; } +// Reinitialize the diary buffer to avoid hanging on to large internal +// buffers when they might not be needed. This function should only be +// called when the pager is not in use. For example, just before +// getting command-line input. + +void +octave_diary_stream::reset (void) +{ + if (! instance) + instance = new octave_diary_stream (); + + instance->do_reset (); +} + +void +octave_diary_stream::do_reset (void) +{ + delete db; + db = new octave_diary_buf (); + rdbuf (db); + setf (unitbuf); +} + void flush_octave_stdout (void) {
--- a/src/pager.h +++ b/src/pager.h @@ -68,8 +68,12 @@ static octave_pager_stream& stream (void); + static void reset (void); + private: + void do_reset (void); + static octave_pager_stream *instance; octave_pager_buf *pb; @@ -108,8 +112,12 @@ static octave_diary_stream& stream (void); + static void reset (void); + private: + void do_reset (void); + static octave_diary_stream *instance; octave_diary_buf *db;
--- a/src/pr-output.cc +++ b/src/pr-output.cc @@ -103,7 +103,7 @@ static int bit_format = 0; // TRUE means don't put newlines around the column number headers. -static bool compact_format = false; +bool Vcompact_format = false; // TRUE means use an e format. static bool print_e = false; @@ -1658,7 +1658,7 @@ << std::resetiosflags (std::ios::scientific|std::ios::left) << " *\n"; - if (! compact_format) + if (! Vcompact_format) os << "\n"; } } @@ -1671,7 +1671,7 @@ { if (col != 0) { - if (compact_format) + if (Vcompact_format) os << "\n"; else os << "\n\n"; @@ -1688,7 +1688,7 @@ else os << " Columns " << col + 1 << " through " << lim << ":\n"; - if (! compact_format) + if (! Vcompact_format) os << "\n"; } } @@ -1956,7 +1956,10 @@ } else { - os << "Diagonal Matrix\n\n"; + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + pr_scale_header (os, scale); // kluge. Get the true width of a number. @@ -1999,80 +2002,82 @@ } } } -#define PRINT_ND_ARRAY(os, nda, NDA_T, ELT_T, MAT_T) \ - do \ - { \ - if (nda.is_empty ()) \ - print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); \ - else \ - { \ - \ - int ndims = nda.ndims (); \ - \ - dim_vector dims = nda.dims (); \ - \ - Array<octave_idx_type> ra_idx (dim_vector (ndims, 1), 0);\ - \ - octave_idx_type m = 1; \ - \ - for (int i = 2; i < ndims; i++) \ - m *= dims(i); \ - \ - octave_idx_type nr = dims(0); \ - octave_idx_type nc = dims(1); \ - \ - for (octave_idx_type i = 0; i < m; i++) \ - { \ - octave_quit (); \ - \ - std::string nm = "ans"; \ - \ - if (m > 1) \ - { \ - nm += "(:,:,"; \ - \ - std::ostringstream buf; \ - \ - for (int k = 2; k < ndims; k++) \ - { \ - buf << ra_idx(k) + 1; \ - \ - if (k < ndims - 1) \ - buf << ","; \ - else \ - buf << ")"; \ - } \ - \ - nm += buf.str (); \ - } \ - \ - Array<idx_vector> idx (dim_vector (ndims, 1)); \ - \ - idx(0) = idx_vector (':'); \ - idx(1) = idx_vector (':'); \ - \ - for (int k = 2; k < ndims; k++) \ - idx(k) = idx_vector (ra_idx(k)); \ - \ - octave_value page \ - = MAT_T (Array<ELT_T> (nda.index (idx), dim_vector (nr, nc))); \ - \ - if (i != m - 1) \ - { \ - page.print_with_name (os, nm); \ - } \ - else \ - { \ - page.print_name_tag (os, nm); \ - page.print_raw (os); \ - } \ - \ - if (i < m) \ - NDA_T::increment_index (ra_idx, dims, 2); \ - } \ - } \ - } \ - while (0) + +template <typename NDA_T, typename ELT_T, typename MAT_T> +void print_nd_array(std::ostream& os, const NDA_T& nda, + bool pr_as_read_syntax) +{ + + if (nda.is_empty ()) + print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); + else + { + + int ndims = nda.ndims (); + + dim_vector dims = nda.dims (); + + Array<octave_idx_type> ra_idx (dim_vector (ndims, 1), 0); + + octave_idx_type m = 1; + + for (int i = 2; i < ndims; i++) + m *= dims(i); + + octave_idx_type nr = dims(0); + octave_idx_type nc = dims(1); + + for (octave_idx_type i = 0; i < m; i++) + { + octave_quit (); + + std::string nm = "ans"; + + if (m > 1) + { + nm += "(:,:,"; + + std::ostringstream buf; + + for (int k = 2; k < ndims; k++) + { + buf << ra_idx(k) + 1; + + if (k < ndims - 1) + buf << ","; + else + buf << ")"; + } + + nm += buf.str (); + } + + Array<idx_vector> idx (dim_vector (ndims, 1)); + + idx(0) = idx_vector (':'); + idx(1) = idx_vector (':'); + + for (int k = 2; k < ndims; k++) + idx(k) = idx_vector (ra_idx(k)); + + octave_value page + = MAT_T (Array<ELT_T> (nda.index (idx), dim_vector (nr, nc))); + + if (i != m - 1) + { + page.print_with_name (os, nm); + } + else + { + page.print_name_tag (os, nm); + page.print_raw (os); + } + + if (i < m) + NDA_T::increment_index (ra_idx, dims, 2); + } + } +} void octave_print_internal (std::ostream& os, const NDArray& nda, @@ -2087,7 +2092,7 @@ break; default: - PRINT_ND_ARRAY (os, nda, NDArray, double, Matrix); + print_nd_array <NDArray, double, Matrix> (os, nda, pr_as_read_syntax); break; } } @@ -2367,7 +2372,10 @@ } else { - os << "Diagonal Matrix\n\n"; + os << "Diagonal Matrix\n"; + if (! Vcompact_format) + os << "\n"; + pr_scale_header (os, scale); // kluge. Get the true width of a number. @@ -2512,7 +2520,9 @@ } else { - os << "Permutation Matrix\n\n"; + os << "Permutation Matrix\n"; + if (! Vcompact_format) + os << "\n"; for (octave_idx_type col = 0; col < nc; col += inc) { @@ -2555,7 +2565,8 @@ break; default: - PRINT_ND_ARRAY (os, nda, ComplexNDArray, Complex, ComplexMatrix); + print_nd_array <ComplexNDArray, Complex, + ComplexMatrix> (os, nda, pr_as_read_syntax); break; } } @@ -2756,7 +2767,8 @@ break; default: - PRINT_ND_ARRAY (os, nda, boolNDArray, bool, boolMatrix); + print_nd_array<boolNDArray, bool, + boolMatrix> (os, nda, pr_as_read_syntax); break; } } @@ -2822,7 +2834,8 @@ break; default: - PRINT_ND_ARRAY (os, nda, charNDArray, char, charMatrix); + print_nd_array <charNDArray, char, + charMatrix> (os, nda, pr_as_read_syntax); break; } } @@ -2840,8 +2853,8 @@ octave_print_internal (std::ostream& os, const Array<std::string>& nda, bool pr_as_read_syntax, int /* extra_indent */) { - // FIXME -- this mostly duplicates the code in the - // PRINT_ND_ARRAY macro. + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. if (nda.is_empty ()) print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); @@ -2904,7 +2917,9 @@ octave_idx_type n_rows = page.rows (); octave_idx_type n_cols = page.cols (); - os << nm << " =\n\n"; + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; for (octave_idx_type ii = 0; ii < n_rows; ii++) { @@ -3109,8 +3124,8 @@ octave_print_internal_template (std::ostream& os, const intNDArray<T>& nda, bool pr_as_read_syntax, int extra_indent) { - // FIXME -- this mostly duplicates the code in the - // PRINT_ND_ARRAY macro. + // FIXME -- this mostly duplicates the code in the print_nd_array<> + // function. Can fix this with std::is_same from C++11. if (nda.is_empty ()) print_empty_nd_array (os, nda.dims (), pr_as_read_syntax); @@ -3152,7 +3167,9 @@ nm += buf.str (); - os << nm << " =\n\n"; + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; } Array<idx_vector> idx (dim_vector (ndims, 1)); @@ -3257,7 +3274,9 @@ nm += buf.str (); - os << nm << " =\n\n"; + os << nm << " =\n"; + if (! Vcompact_format) + os << "\n"; } Array<idx_vector> idx (dim_vector (ndims, 1)); @@ -3528,6 +3547,21 @@ %! endfor %! endfor %! fclose (fd); + +%!test +%! foo.real = pi * ones (3,20,3); +%! foo.complex = pi * ones (3,20,3) + 1i; +%! foo.char = repmat ("- Hello World -", [3, 20]); +%! foo.cell = {foo.real, foo.complex, foo.char}; +%! fields = fieldnames (foo); +%! for f = 1:numel(fields) +%! format loose +%! loose = disp (foo.(fields{f})); +%! format compact +%! compact = disp (foo.(fields{f})); +%! expected = strrep (loose, "\n\n", "\n"); +%! assert (expected, compact) +%! endfor */ static void @@ -3539,7 +3573,7 @@ bank_format = false; hex_format = 0; bit_format = 0; - compact_format = false; + Vcompact_format = false; print_e = false; print_big_e = false; print_g = false; @@ -3714,11 +3748,11 @@ } else if (arg == "compact") { - compact_format = true; + Vcompact_format = true; } else if (arg == "loose") { - compact_format = false; + Vcompact_format = false; } else error ("format: unrecognized format state `%s'", arg.c_str ()); @@ -3890,12 +3924,12 @@ \n\ @table @code\n\ @item compact\n\ -Remove extra blank space around column number labels producing more compact\n\ -output with more data per page.\n\ +Remove blank lines around column number labels and between\n\ +matrices producing more compact output with more data per page.\n\ \n\ @item loose\n\ -Insert blank lines above and below column number labels to produce a more\n\ -readable output with less data per page. (default).\n\ +Insert blank lines above and below column number labels and between matrices\n\ +to produce a more readable output with less data per page. (default).\n\ @end table\n\ @seealso{fixed_point_format, output_max_field_width, output_precision, split_long_rows, rats}\n\ @end deftypefn")
--- a/src/pr-output.h +++ b/src/pr-output.h @@ -256,4 +256,7 @@ // like this: x = [](2x0). extern bool Vprint_empty_dimensions; +// TRUE means don't put empty lines in output +extern bool Vcompact_format; + #endif
new file mode 100644 --- /dev/null +++ b/src/profiler.cc @@ -0,0 +1,470 @@ +/* + +Copyright (C) 2011 Daniel Kraft + +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 +<http://www.gnu.org/licenses/>. + +*/ + +#ifdef HAVE_CONFIG_H +#include <config.h> +#endif + +#include <iostream> + +#include "defun.h" +#include "oct-time.h" +#include "ov-struct.h" +#include "pager.h" +#include "profiler.h" + +profile_data_accumulator::enter::enter (profile_data_accumulator& a, + const std::string& f) + : acc (a) +{ + if (acc.is_active ()) + { + fcn = f; + acc.enter_function (fcn); + } + else + fcn = ""; +} + +profile_data_accumulator::enter::~enter () +{ + if (fcn != "") + acc.exit_function (fcn); +} + +profile_data_accumulator::stats::stats () + : time (0.0), calls (0), recursive (false), + parents (), children () +{} + +octave_value +profile_data_accumulator::stats::function_set_value (const function_set& list) +{ + const octave_idx_type n = list.size (); + + RowVector retval (n); + octave_idx_type i = 0; + for (function_set::const_iterator p = list.begin (); p != list.end (); ++p) + { + retval(i) = *p; + ++i; + } + assert (i == n); + + return retval; +} + +profile_data_accumulator::tree_node::tree_node (tree_node* p, octave_idx_type f) + : parent (p), fcn_id (f), children (), time (0.0), calls (0) +{} + +profile_data_accumulator::tree_node::~tree_node () +{ + for (child_map::iterator i = children.begin (); i != children.end (); ++i) + delete i->second; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::enter (octave_idx_type fcn) +{ + tree_node* retval; + + child_map::iterator pos = children.find (fcn); + if (pos == children.end ()) + { + retval = new tree_node (this, fcn); + children[fcn] = retval; + } + else + retval = pos->second; + + ++retval->calls; + return retval; +} + +profile_data_accumulator::tree_node* +profile_data_accumulator::tree_node::exit (octave_idx_type fcn) +{ + assert (parent); + assert (fcn_id == fcn); + + return parent; +} + +void +profile_data_accumulator::tree_node::build_flat (flat_profile& data) const +{ + // If this is not the top-level node, update profile entry for this function. + if (fcn_id != 0) + { + stats& entry = data[fcn_id - 1]; + + entry.time += time; + entry.calls += calls; + + assert (parent); + if (parent->fcn_id != 0) + { + entry.parents.insert (parent->fcn_id); + data[parent->fcn_id - 1].children.insert (fcn_id); + } + + if (!entry.recursive) + for (const tree_node* i = parent; i; i = i->parent) + if (i->fcn_id == fcn_id) + { + entry.recursive = true; + break; + } + } + + // Recurse on children. + for (child_map::const_iterator i = children.begin (); + i != children.end (); ++i) + i->second->build_flat (data); +} + +octave_value +profile_data_accumulator::tree_node::get_hierarchical (double* total) const +{ + /* Note that we don't generate the entry just for this node, but rather + a struct-array with entries for all children. This way, the top-node + (for which we don't want a real entry) generates already the final + hierarchical profile data. */ + + const octave_idx_type n = children.size (); + + Cell rv_indices (n, 1); + Cell rv_times (n, 1); + Cell rv_totals (n, 1); + Cell rv_calls (n, 1); + Cell rv_children (n, 1); + + octave_idx_type i = 0; + for (child_map::const_iterator p = children.begin (); + p != children.end (); ++p) + { + const tree_node& entry = *p->second; + double child_total = entry.time; + + rv_indices(i) = octave_value (p->first); + rv_times(i) = octave_value (entry.time); + rv_calls(i) = octave_value (entry.calls); + rv_children(i) = entry.get_hierarchical (&child_total); + rv_totals(i) = octave_value (child_total); + + if (total) + *total += child_total; + + ++i; + } + assert (i == n); + + octave_map retval; + + retval.assign ("Index", rv_indices); + retval.assign ("SelfTime", rv_times); + retval.assign ("TotalTime", rv_totals); + retval.assign ("NumCalls", rv_calls); + retval.assign ("Children", rv_children); + + return retval; +} + +profile_data_accumulator::profile_data_accumulator () + : known_functions (), fcn_index (), + enabled (false), call_tree (NULL), last_time (-1.0) +{} + +profile_data_accumulator::~profile_data_accumulator () +{ + if (call_tree) + delete call_tree; +} + +void +profile_data_accumulator::set_active (bool value) +{ + if (value) + { + // Create a call-tree top-node if there isn't yet one. + if (!call_tree) + call_tree = new tree_node (NULL, 0); + + // Let the top-node be the active one. This ensures we have a clean + // fresh start collecting times. + active_fcn = call_tree; + } + else + { + // Make sure we start with fresh timing if we're re-enabled later. + last_time = -1.0; + } + + enabled = value; +} + +void +profile_data_accumulator::enter_function (const std::string& fcn) +{ + // The enter class will check and only call us if the profiler is active. + assert (is_active ()); + assert (call_tree); + + // If there is already an active function, add to its time before + // pushing the new one. + if (active_fcn != call_tree) + add_current_time (); + + // Map the function's name to its index. + octave_idx_type fcn_idx; + fcn_index_map::iterator pos = fcn_index.find (fcn); + if (pos == fcn_index.end ()) + { + known_functions.push_back (fcn); + fcn_idx = known_functions.size (); + fcn_index[fcn] = fcn_idx; + } + else + fcn_idx = pos->second; + + active_fcn = active_fcn->enter (fcn_idx); + last_time = query_time (); +} + +void +profile_data_accumulator::exit_function (const std::string& fcn) +{ + assert (call_tree); + assert (active_fcn != call_tree); + + // Usually, if we are disabled this function is not even called. But the + // call disabling the profiler is an exception. So also check here + // and only record the time if enabled. + if (is_active ()) + add_current_time (); + + fcn_index_map::iterator pos = fcn_index.find (fcn); + assert (pos != fcn_index.end ()); + active_fcn = active_fcn->exit (pos->second); + + // If this was an "inner call", we resume executing the parent function + // up the stack. So note the start-time for this! + last_time = query_time (); +} + +void +profile_data_accumulator::reset (void) +{ + if (is_active ()) + { + error ("Can't reset active profiler."); + return; + } + + known_functions.clear (); + fcn_index.clear (); + + if (call_tree) + { + delete call_tree; + call_tree = NULL; + } + + last_time = -1.0; +} + +octave_value +profile_data_accumulator::get_flat (void) const +{ + octave_value retval; + + const octave_idx_type n = known_functions.size (); + + flat_profile flat (n); + + if (call_tree) + { + call_tree->build_flat (flat); + + Cell rv_names (n, 1); + Cell rv_times (n, 1); + Cell rv_calls (n, 1); + Cell rv_recursive (n, 1); + Cell rv_parents (n, 1); + Cell rv_children (n, 1); + + for (octave_idx_type i = 0; i != n; ++i) + { + rv_names(i) = octave_value (known_functions[i]); + rv_times(i) = octave_value (flat[i].time); + rv_calls(i) = octave_value (flat[i].calls); + rv_recursive(i) = octave_value (flat[i].recursive); + rv_parents(i) = stats::function_set_value (flat[i].parents); + rv_children(i) = stats::function_set_value (flat[i].children); + } + + octave_map m; + + m.assign ("FunctionName", rv_names); + m.assign ("TotalTime", rv_times); + m.assign ("NumCalls", rv_calls); + m.assign ("IsRecursive", rv_recursive); + m.assign ("Parents", rv_parents); + m.assign ("Children", rv_children); + + retval = m; + } + else + { + static const char *fn[] = + { + "FunctionName", + "TotalTime", + "NumCalls", + "IsRecursive", + "Parents", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +octave_value +profile_data_accumulator::get_hierarchical (void) const +{ + octave_value retval; + + if (call_tree) + retval = call_tree->get_hierarchical (); + else + { + static const char *fn[] = + { + "Index", + "SelfTime", + "NumCalls", + "Children", + 0 + }; + + static octave_map m (dim_vector (0, 1), string_vector (fn)); + + retval = m; + } + + return retval; +} + +double +profile_data_accumulator::query_time (void) const +{ + octave_time now; + // FIXME -- this should be removed at some point... See bug 34210. +#if defined (__CYGWIN__) || defined (__MINGW32__) + volatile +#endif + double dnow = now.double_value (); + return dnow; +} + +void +profile_data_accumulator::add_current_time (void) +{ + const double t = query_time (); + assert (last_time >= 0.0 && last_time <= t); + + assert (call_tree && active_fcn != call_tree); + active_fcn->add_time (t - last_time); +} + +profile_data_accumulator profiler; + +// Enable or disable the profiler data collection. +DEFUN (__profiler_enable__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_enable ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + + const int nargin = args.length (); + if (nargin > 0) + { + if (nargin > 1) + { + print_usage (); + return retval; + } + + profiler.set_active (args(0).bool_value ()); + } + + retval(0) = profiler.is_active (); + + return retval; +} + +// Clear all collected profiling data. +DEFUN (__profiler_reset__, args, , + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_reset ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_reset: ignoring extra arguments"); + + profiler.reset (); + + return retval; +} + +// Query the timings collected by the profiler. +DEFUN (__profiler_data__, args, nargout, + "-*- texinfo -*-\n\ +@deftypefn {Function File} __profiler_data ()\n\ +Undocumented internal function.\n\ +@end deftypefn") +{ + octave_value_list retval; + const int nargin = args.length (); + + if (nargin > 0) + warning ("profiler_data: ignoring extra arguments"); + + retval(0) = profiler.get_flat (); + if (nargout > 1) + retval(1) = profiler.get_hierarchical (); + + return retval; +}
new file mode 100644 --- /dev/null +++ b/src/profiler.h @@ -0,0 +1,190 @@ +/* + +Copyright (C) 2011 Daniel Kraft + +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 +<http://www.gnu.org/licenses/>. + +*/ + +#if !defined (octave_profiler_h) +#define octave_profiler_h 1 + +#include <cstddef> +#include <map> +#include <set> +#include <string> +#include <vector> + +class octave_value; + +class +OCTINTERP_API +profile_data_accumulator +{ +public: + + // This is a utility class that can be used to call the enter/exit + // functions in a manner protected from stack unwinding. + class enter + { + private: + + profile_data_accumulator& acc; + std::string fcn; + + public: + + enter (profile_data_accumulator&, const std::string&); + virtual ~enter (void); + + private: + + // No copying! + enter (const enter&); + enter& operator = (const enter&); + }; + + profile_data_accumulator (void); + virtual ~profile_data_accumulator (); + + bool is_active (void) const { return enabled; } + void set_active (bool); + + void reset (void); + + octave_value get_flat (void) const; + octave_value get_hierarchical (void) const; + +private: + + // One entry in the flat profile (i.e., a collection of data for a single + // function). This is filled in when building the flat profile from the + // hierarchical call tree. + struct stats + { + stats (); + + double time; + unsigned calls; + + bool recursive; + + typedef std::set<octave_idx_type> function_set; + function_set parents; + function_set children; + + // Convert a function_set list to an Octave array of indices. + static octave_value function_set_value (const function_set&); + }; + + typedef std::vector<stats> flat_profile; + + // Store data for one node in the call-tree of the hierarchical profiler + // data we collect. + class tree_node + { + public: + + tree_node (tree_node*, octave_idx_type); + virtual ~tree_node (); + + void add_time (double dt) { time += dt; } + + // Enter a child function. It is created in the list of children if it + // wasn't already there. The now-active child node is returned. + tree_node* enter (octave_idx_type); + + // Exit function. As a sanity-check, it is verified that the currently + // active function actually is the one handed in here. Returned is the + // then-active node, which is our parent. + tree_node* exit (octave_idx_type); + + void build_flat (flat_profile&) const; + + // Get the hierarchical profile for this node and its children. If total + // is set, accumulate total time of the subtree in that variable as + // additional return value. + octave_value get_hierarchical (double* total = NULL) const; + + private: + + tree_node* parent; + octave_idx_type fcn_id; + + typedef std::map<octave_idx_type, tree_node*> child_map; + child_map children; + + // This is only time spent *directly* on this level, excluding children! + double time; + + unsigned calls; + + // No copying! + tree_node (const tree_node&); + tree_node& operator = (const tree_node&); + }; + + // Each function we see in the profiler is given a unique index (which + // simply counts starting from 1). We thus have to map profiler-names to + // those indices. For all other stuff, we identify functions by their index. + + typedef std::vector<std::string> function_set; + typedef std::map<std::string, octave_idx_type> fcn_index_map; + + function_set known_functions; + fcn_index_map fcn_index; + + bool enabled; + + tree_node* call_tree; + tree_node* active_fcn; + + // Store last timestamp we had, when the currently active function was called. + double last_time; + + // These are private as only the unwind-protecting inner class enter + // should be allowed to call them. + void enter_function (const std::string&); + void exit_function (const std::string&); + + // Query a timestamp, used for timing calls (obviously). + // This is not static because in the future, maybe we want a flag + // in the profiler or something to choose between cputime, wall-time, + // user-time, system-time, ... + double query_time () const; + + // Add the time elapsed since last_time to the function we're currently in. + // This is called from two different positions, thus it is useful to have + // it as a seperate function. + void add_current_time (void); + + // No copying! + profile_data_accumulator (const profile_data_accumulator&); + profile_data_accumulator& operator = (const profile_data_accumulator&); +}; + +// The instance used. +extern OCTINTERP_API profile_data_accumulator profiler; + +// Helper macro to profile a block of code. +#define BEGIN_PROFILER_BLOCK(name) \ + { \ + profile_data_accumulator::enter pe (profiler, (name)); +#define END_PROFILER_BLOCK \ + } + +#endif
--- a/src/pt-binop.cc +++ b/src/pt-binop.cc @@ -28,6 +28,7 @@ #include "defun.h" #include "oct-obj.h" #include "ov.h" +#include "profiler.h" #include "pt-binop.h" #include "pt-bp.h" #include "pt-walk.h" @@ -120,10 +121,20 @@ if (! error_state && b.is_defined ()) { + BEGIN_PROFILER_BLOCK ("binary " + oper ()) + + // Note: The profiler does not catch the braindead + // short-circuit evaluation code above, but that should be + // ok. The evaluation of operands and the operator itself + // is entangled and it's not clear where to start/stop + // timing the operator to make it reasonable. + retval = ::do_binary_op (etype, a, b); if (error_state) retval = octave_value (); + + END_PROFILER_BLOCK } } } @@ -183,6 +194,11 @@ bool result = false; + // This evaluation is not caught by the profiler, since we can't find + // a reasonable place where to time. Note that we don't want to + // include evaluation of LHS or RHS into the timing, but this is + // entangled together with short-circuit evaluation here. + if (op_lhs) { octave_value a = op_lhs->rvalue1 (); @@ -279,3 +295,19 @@ { return SET_INTERNAL_VARIABLE (do_braindead_shortcircuit_evaluation); } + +/* + +%!test +%! x = 0; +%! do_braindead_shortcircuit_evaluation (0); +%! if (1 | (x = 1)) +%! endif +%! assert (x, 1); +%! do_braindead_shortcircuit_evaluation (1); +%! if (1 | (x = 0)) +%! endif +%! assert (x, 1); + +*/ +
--- a/src/pt-cbinop.cc +++ b/src/pt-cbinop.cc @@ -84,7 +84,9 @@ static octave_value::compound_binary_op simplify_mul_op (tree_expression *&a, tree_expression *&b) { - octave_value::compound_binary_op retop; + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + octave_value::unary_op opa = strip_trans_herm (a); if (opa == octave_value::op_hermitian) @@ -99,8 +101,6 @@ retop = octave_value::op_mul_herm; else if (opb == octave_value::op_transpose) retop = octave_value::op_mul_trans; - else - retop = octave_value::unknown_compound_binary_op; } return retop; @@ -111,15 +111,15 @@ static octave_value::compound_binary_op simplify_ldiv_op (tree_expression *&a, tree_expression *&) { - octave_value::compound_binary_op retop; + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + octave_value::unary_op opa = strip_trans_herm (a); if (opa == octave_value::op_hermitian) retop = octave_value::op_herm_ldiv; else if (opa == octave_value::op_transpose) retop = octave_value::op_trans_ldiv; - else - retop = octave_value::unknown_compound_binary_op; return retop; } @@ -129,7 +129,9 @@ static octave_value::compound_binary_op simplify_and_or_op (tree_expression *&a, tree_expression *&b, octave_value::binary_op op) { - octave_value::compound_binary_op retop; + octave_value::compound_binary_op retop + = octave_value::unknown_compound_binary_op; + octave_value::unary_op opa = strip_not (a); if (opa == octave_value::op_not) @@ -150,8 +152,6 @@ else if (op == octave_value::op_el_or) retop = octave_value::op_el_or_not; } - else - retop = octave_value::unknown_compound_binary_op; } return retop;
--- a/src/pt-check.cc +++ b/src/pt-check.cc @@ -154,6 +154,11 @@ if (expr) expr->accept (*this); + tree_expression *maxproc = cmd.maxproc_expr (); + + if (maxproc) + maxproc->accept (*this); + tree_statement_list *list = cmd.body (); if (list)
--- a/src/pt-eval.cc +++ b/src/pt-eval.cc @@ -281,18 +281,6 @@ return quit; } -#define DO_SIMPLE_FOR_LOOP_ONCE(VAL) \ - do \ - { \ - ult.assign (octave_value::op_asn_eq, VAL); \ - \ - if (! error_state && loop_body) \ - loop_body->accept (*this); \ - \ - quit = quit_loop_now (); \ - } \ - while (0) - void tree_evaluator::visit_simple_for_command (tree_simple_for_command& cmd) { @@ -302,6 +290,9 @@ if (debug_mode) do_breakpoint (cmd.is_breakpoint ()); + // FIXME -- need to handle PARFOR loops here using cmd.in_parallel () + // and cmd.maxproc_expr (); + unwind_protect frame; frame.protect_var (in_loop_command); @@ -347,17 +338,24 @@ octave_value val (b + i * increment); - DO_SIMPLE_FOR_LOOP_ONCE (val); + ult.assign (octave_value::op_asn_eq, val); - if (quit) + if (! error_state && loop_body) + loop_body->accept (*this); + + if (quit_loop_now ()) break; } } else if (rhs.is_scalar_type ()) { - bool quit = false; + ult.assign (octave_value::op_asn_eq, rhs); - DO_SIMPLE_FOR_LOOP_ONCE (rhs); + if (! error_state && loop_body) + loop_body->accept (*this); + + // Maybe decrement break and continue states. + quit_loop_now (); } else if (rhs.is_matrix_type () || rhs.is_cell () || rhs.is_string () || rhs.is_map ()) @@ -397,9 +395,13 @@ // do_index_op expects one-based indices. idx(iidx) = i; octave_value val = arg.do_index_op (idx); - DO_SIMPLE_FOR_LOOP_ONCE (val); + + ult.assign (octave_value::op_asn_eq, val); - if (quit) + if (! error_state && loop_body) + loop_body->accept (*this); + + if (quit_loop_now ()) break; } } @@ -1202,6 +1204,17 @@ return SET_INTERNAL_VARIABLE (max_recursion_depth); } +/* +%!error (max_recursion_depth (1, 2)); +%!test +%! orig_val = max_recursion_depth (); +%! old_val = max_recursion_depth (2*orig_val); +%! assert (orig_val, old_val); +%! assert (max_recursion_depth (), 2*orig_val); +%! max_recursion_depth (orig_val); +%! assert (max_recursion_depth (), orig_val); +*/ + DEFUN (silent_functions, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} silent_functions ()\n\ @@ -1214,3 +1227,14 @@ { return SET_INTERNAL_VARIABLE (silent_functions); } + +/* +%!error (silent_functions (1, 2)); +%!test +%! orig_val = silent_functions (); +%! old_val = silent_functions (! orig_val); +%! assert (orig_val, old_val); +%! assert (silent_functions (), ! orig_val); +%! silent_functions (orig_val); +%! assert (silent_functions (), orig_val); +*/
--- a/src/pt-fcn-handle.cc +++ b/src/pt-fcn-handle.cc @@ -124,9 +124,14 @@ parent_scope = curr_fcn->scope (); uf->stash_parent_fcn_scope (parent_scope); + + if (curr_fcn->is_class_method () || curr_fcn->is_class_constructor ()) + uf->stash_dispatch_class (curr_fcn->dispatch_class ()); } - uf->mark_as_inline_function (); + uf->mark_as_anonymous_function (); + uf->stash_fcn_file_name (file_name); + uf->stash_fcn_location (line (), column ()); octave_value ov_fcn (uf);
--- a/src/pt-fcn-handle.h +++ b/src/pt-fcn-handle.h @@ -92,13 +92,14 @@ public: tree_anon_fcn_handle (int l = -1, int c = -1) - : tree_expression (l, c), fcn (0) { } + : tree_expression (l, c), fcn (0), file_name () { } tree_anon_fcn_handle (tree_parameter_list *pl, tree_parameter_list *rl, tree_statement_list *cl, symbol_table::scope_id sid, int l = -1, int c = -1) : tree_expression (l, c), - fcn (new octave_user_function (sid, pl, rl, cl)) { } + fcn (new octave_user_function (sid, pl, rl, cl)), + file_name () { } ~tree_anon_fcn_handle (void) { delete fcn; } @@ -135,11 +136,16 @@ void accept (tree_walker& tw); + void stash_file_name (const std::string& file) { file_name = file; } + private: // The function. octave_user_function *fcn; + // Filename where the handle was defined. + std::string file_name; + // No copying! tree_anon_fcn_handle (const tree_anon_fcn_handle&);
--- a/src/pt-loop.cc +++ b/src/pt-loop.cc @@ -92,6 +92,7 @@ tree_simple_for_command::~tree_simple_for_command (void) { delete expr; + delete maxproc; delete list; delete lead_comm; delete trail_comm; @@ -101,12 +102,13 @@ tree_simple_for_command::dup (symbol_table::scope_id scope, symbol_table::context_id context) const { - return new tree_simple_for_command (lhs ? lhs->dup (scope, context) : 0, - expr ? expr->dup (scope, context) : 0, - list ? list->dup (scope, context) : 0, - lead_comm ? lead_comm->dup () : 0, - trail_comm ? trail_comm->dup () : 0, - line (), column ()); + return new tree_simple_for_command + (parallel, lhs ? lhs->dup (scope, context) : 0, + expr ? expr->dup (scope, context) : 0, + maxproc ? maxproc->dup (scope, context) : 0, + list ? list->dup (scope, context) : 0, + lead_comm ? lead_comm->dup () : 0, + trail_comm ? trail_comm->dup () : 0, line (), column ()); } void
--- a/src/pt-loop.h +++ b/src/pt-loop.h @@ -145,23 +145,30 @@ public: tree_simple_for_command (int l = -1, int c = -1) - : tree_command (l, c), lhs (0), expr (0), list (0), lead_comm (0), - trail_comm (0) { } + : tree_command (l, c), parallel (false), lhs (0), expr (0), + maxproc (0), list (0), lead_comm (0), trail_comm (0) { } - tree_simple_for_command (tree_expression *le, tree_expression *re, + tree_simple_for_command (bool parallel_arg, tree_expression *le, + tree_expression *re, + tree_expression *maxproc_arg, tree_statement_list *lst, octave_comment_list *lc = 0, octave_comment_list *tc = 0, int l = -1, int c = -1) - : tree_command (l, c), lhs (le), expr (re), list (lst), + : tree_command (l, c), parallel (parallel_arg), lhs (le), + expr (re), maxproc (maxproc_arg), list (lst), lead_comm (lc), trail_comm (tc) { } ~tree_simple_for_command (void); + bool in_parallel (void) { return parallel; } + tree_expression *left_hand_side (void) { return lhs; } tree_expression *control_expr (void) { return expr; } + tree_expression *maxproc_expr (void) { return maxproc; } + tree_statement_list *body (void) { return list; } octave_comment_list *leading_comment (void) { return lead_comm; } @@ -175,12 +182,20 @@ private: + // TRUE means operate in parallel (subject to the value of the + // maxproc expression). + bool parallel; + // Expression to modify. tree_expression *lhs; // Expression to evaluate. tree_expression *expr; + // Expression to tell how many processors should be used (only valid + // if parallel is TRUE). + tree_expression *maxproc; + // List of commands to execute. tree_statement_list *list;
--- a/src/pt-mat.cc +++ b/src/pt-mat.cc @@ -28,6 +28,7 @@ #include "quit.h" +#include "data.h" #include "defun.h" #include "error.h" #include "oct-obj.h" @@ -68,15 +69,17 @@ : count (1), dv (0, 0), all_str (false), all_sq_str (false), all_dq_str (false), some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_sparse (false), any_class (false), - all_1x1 (false), class_nm (), ok (false) + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), all_1x1 (false), + first_elem_is_struct (false), class_nm (), ok (false) { } tm_row_const_rep (const tree_argument_list& row) : count (1), dv (0, 0), all_str (false), all_sq_str (false), some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_sparse (false), any_class (false), - all_1x1 (! row.empty ()), class_nm (), ok (false) + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), all_1x1 (! row.empty ()), + first_elem_is_struct (false), class_nm (), ok (false) { init (row); } ~tm_row_const_rep (void) { } @@ -92,18 +95,22 @@ bool all_real; bool all_cmplx; bool all_mt; + bool any_cell; bool any_sparse; bool any_class; bool all_1x1; + bool first_elem_is_struct; std::string class_nm; bool ok; - bool do_init_element (tree_expression *, const octave_value&, bool&); + void do_init_element (const octave_value&, bool&); void init (const tree_argument_list&); + void cellify (void); + private: tm_row_const_rep (const tm_row_const_rep&); @@ -169,12 +176,16 @@ bool all_real_p (void) const { return rep->all_real; } bool all_complex_p (void) const { return rep->all_cmplx; } bool all_empty_p (void) const { return rep->all_mt; } + bool any_cell_p (void) const { return rep->any_cell; } bool any_sparse_p (void) const { return rep->any_sparse; } bool any_class_p (void) const { return rep->any_class; } bool all_1x1_p (void) const { return rep->all_1x1; } + bool first_elem_struct_p (void) const { return rep->first_elem_is_struct; } std::string class_name (void) const { return rep->class_nm; } + void cellify (void) { rep->cellify (); } + operator bool () const { return (rep && rep->ok); } iterator begin (void) { return rep->begin (); } @@ -199,6 +210,8 @@ retval = c2; else if (c2.empty ()) retval = c1; + else if (c1 == "class" || c2 == "class") + retval = "class"; else { bool c1_is_int = (c1 == "int8" || c1 == "uint8" @@ -232,7 +245,11 @@ // Order is important here... - if (c1_is_char && c2_is_built_in_type) + if (c1 == "struct" && c2 == c1) + retval = c1; + else if (c1 == "cell" || c2 == "cell") + retval = "cell"; + else if (c1_is_char && c2_is_built_in_type) retval = c1; else if (c2_is_char && c1_is_built_in_type) retval = c2; @@ -250,54 +267,38 @@ retval = c2; else if (c1_is_logical && c2_is_logical) retval = c1; - else if (c1 == "struct" && c2 == c1) - retval = c1; - else if (c1 == "cell" && c2 == c1) - retval = c1; } return retval; } static void -eval_error (const char *msg, int l, int c, - const dim_vector& x, const dim_vector& y) +eval_error (const char *msg, const dim_vector& x, const dim_vector& y) { - if (l == -1 && c == -1) - { - ::error ("%s (%s vs %s)", msg, x.str ().c_str (), y.str ().c_str ()); - } - else - { - ::error ("%s (%s vs %s) near line %d, column %d", msg, - x.str ().c_str (), y.str ().c_str (), l, c); - } + ::error ("%s (%s vs %s)", msg, x.str ().c_str (), y.str ().c_str ()); } -bool -tm_row_const::tm_row_const_rep::do_init_element (tree_expression *elt, - const octave_value& val, +void +tm_row_const::tm_row_const_rep::do_init_element (const octave_value& val, bool& first_elem) { - std::string this_elt_class_nm = val.class_name (); + std::string this_elt_class_nm + = val.is_object () ? std::string ("class") : val.class_name (); + + class_nm = get_concat_class (class_nm, this_elt_class_nm); dim_vector this_elt_dv = val.dims (); - class_nm = get_concat_class (class_nm, this_elt_class_nm); - if (! this_elt_dv.zero_by_zero ()) { all_mt = false; if (first_elem) { + if (val.is_map ()) + first_elem_is_struct = true; + first_elem = false; - dv = this_elt_dv; - } - else if (! dv.hvcat (this_elt_dv, 1)) - { - eval_error ("horizontal dimensions mismatch", elt->line (), elt->column (), dv, this_elt_dv); - return false; } } @@ -321,6 +322,9 @@ if (all_cmplx && ! (val.is_complex_type () || val.is_real_type ())) all_cmplx = false; + if (!any_cell && val.is_cell ()) + any_cell = true; + if (!any_sparse && val.is_sparse_type ()) any_sparse = true; @@ -328,8 +332,6 @@ any_class = true; all_1x1 = all_1x1 && val.numel () == 1; - - return true; } void @@ -340,6 +342,7 @@ all_dq_str = true; all_real = true; all_cmplx = true; + any_cell = false; any_sparse = false; any_class = false; @@ -356,7 +359,10 @@ octave_value tmp = elt->rvalue1 (); if (error_state || tmp.is_undefined ()) - break; + { + ok = ! error_state; + return; + } else { if (tmp.is_cs_list ()) @@ -367,21 +373,91 @@ { octave_quit (); - if (! do_init_element (elt, tlst(i), first_elem)) - goto done; + do_init_element (tlst(i), first_elem); } } else + do_init_element (tmp, first_elem); + } + } + + if (any_cell && ! any_class && ! first_elem_is_struct) + cellify (); + + first_elem = true; + + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + octave_value val = *p; + + dim_vector this_elt_dv = val.dims (); + + if (! this_elt_dv.zero_by_zero ()) + { + all_mt = false; + + if (first_elem) { - if (! do_init_element (elt, tmp, first_elem)) - goto done; + first_elem = false; + dv = this_elt_dv; + } + else if (! dv.hvcat (this_elt_dv, 1)) + { + eval_error ("horizontal dimensions mismatch", dv, this_elt_dv); + break; } } } - done: + ok = ! error_state; +} + +void +tm_row_const::tm_row_const_rep::cellify (void) +{ + bool elt_changed = false; + + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + if (! p->is_cell ()) + { + elt_changed = true; + + *p = Cell (*p); + } + } + + if (elt_changed) + { + bool first_elem = true; - ok = ! error_state; + for (iterator p = begin (); p != end (); p++) + { + octave_quit (); + + octave_value val = *p; + + dim_vector this_elt_dv = val.dims (); + + if (! this_elt_dv.zero_by_zero ()) + { + if (first_elem) + { + first_elem = false; + dv = this_elt_dv; + } + else if (! dv.hvcat (this_elt_dv, 1)) + { + eval_error ("horizontal dimensions mismatch", dv, this_elt_dv); + break; + } + } + } + } } void @@ -403,8 +479,8 @@ tm_const (const tree_matrix& tm) : dv (0, 0), all_str (false), all_sq_str (false), all_dq_str (false), some_str (false), all_real (false), all_cmplx (false), - all_mt (true), any_sparse (false), any_class (false), - class_nm (), ok (false) + all_mt (true), any_cell (false), any_sparse (false), + any_class (false), class_nm (), ok (false) { init (tm); } ~tm_const (void) { } @@ -421,6 +497,7 @@ bool all_real_p (void) const { return all_real; } bool all_complex_p (void) const { return all_cmplx; } bool all_empty_p (void) const { return all_mt; } + bool any_cell_p (void) const { return any_cell; } bool any_sparse_p (void) const { return any_sparse; } bool any_class_p (void) const { return any_class; } bool all_1x1_p (void) const { return all_1x1; } @@ -440,6 +517,7 @@ bool all_real; bool all_cmplx; bool all_mt; + bool any_cell; bool any_sparse; bool any_class; bool all_1x1; @@ -465,11 +543,13 @@ all_dq_str = true; all_real = true; all_cmplx = true; + any_cell = false; any_sparse = false; any_class = false; - all_1x1 = ! empty (); + all_1x1 = ! tm.empty (); bool first_elem = true; + bool first_elem_is_struct = false; // Just eval and figure out if what we have is complex or all // strings. We can't check columns until we know that this is a @@ -484,6 +564,13 @@ tm_row_const tmp (*elt); + if (first_elem) + { + first_elem_is_struct = tmp.first_elem_struct_p (); + + first_elem = false; + } + if (tmp && ! tmp.empty ()) { if (all_str && ! tmp.all_strings_p ()) @@ -507,6 +594,9 @@ if (all_mt && ! tmp.all_empty_p ()) all_mt = false; + if (!any_cell && tmp.any_cell_p ()) + any_cell = true; + if (!any_sparse && tmp.any_sparse_p ()) any_sparse = true; @@ -523,11 +613,23 @@ if (! error_state) { - for (iterator p = begin (); p != end (); p++) + if (any_cell && ! any_class && ! first_elem_is_struct) + { + for (iterator q = begin (); q != end (); q++) + { + octave_quit (); + + q->cellify (); + } + } + + first_elem = true; + + for (iterator q = begin (); q != end (); q++) { octave_quit (); - tm_row_const elt = *p; + tm_row_const elt = *q; octave_idx_type this_elt_nr = elt.rows (); octave_idx_type this_elt_nc = elt.cols (); @@ -556,8 +658,7 @@ } else if (! dv.hvcat (this_elt_dv, 0)) { - eval_error ("vertical dimensions mismatch", -1, -1, - dv, this_elt_dv); + eval_error ("vertical dimensions mismatch", dv, this_elt_dv); return; } } @@ -833,17 +934,54 @@ return result; } +static octave_value +do_class_concat (tm_const& tmc) +{ + octave_value retval; + + octave_value_list rows (tmc.length (), octave_value ()); + + octave_idx_type j = 0; + for (tm_const::iterator p = tmc.begin (); p != tmc.end (); p++) + { + octave_quit (); + + tm_row_const tmrc = *p; + + if (tmrc.length () == 1) + rows(j++) = *(tmrc.begin ()); + else + { + octave_value_list row (tmrc.length (), octave_value ()); + + octave_idx_type i = 0; + for (tm_row_const::iterator q = tmrc.begin (); q != tmrc.end (); q++) + row(i++) = *q; + + rows(j++) = do_class_concat (row, "horzcat", 1); + } + } + + if (! error_state) + { + if (rows.length () == 1) + retval = rows(0); + else + retval = do_class_concat (rows, "vertcat", 0); + } + + return retval; +} + octave_value tree_matrix::rvalue1 (int) { octave_value retval = Matrix (); - bool all_strings_p = false; bool all_sq_strings_p = false; bool all_dq_strings_p = false; bool all_empty_p = false; bool all_real_p = false; - bool all_complex_p = false; bool any_sparse_p = false; bool any_class_p = false; bool frc_str_conv = false; @@ -853,12 +991,10 @@ if (tmp && ! tmp.empty ()) { dim_vector dv = tmp.dims (); - all_strings_p = tmp.all_strings_p (); all_sq_strings_p = tmp.all_sq_strings_p (); all_dq_strings_p = tmp.all_dq_strings_p (); all_empty_p = tmp.all_empty_p (); all_real_p = tmp.all_real_p (); - all_complex_p = tmp.all_complex_p (); any_sparse_p = tmp.any_sparse_p (); any_class_p = tmp.any_class_p (); frc_str_conv = tmp.some_strings_p (); @@ -869,64 +1005,7 @@ if (any_class_p) { - octave_value_list tmp3 (tmp.length (), octave_value ()); - - int j = 0; - for (tm_const::iterator p = tmp.begin (); p != tmp.end (); p++) - { - octave_quit (); - - tm_row_const row = *p; - - if (row.length () == 1) - tmp3 (j++) = *(row.begin ()); - else - { - octave_value_list tmp1 (row.length (), octave_value ()); - - int i = 0; - for (tm_row_const::iterator q = row.begin (); - q != row.end (); q++) - tmp1 (i++) = *q; - - octave_value_list tmp2; - octave_value fcn = - symbol_table::find_function ("horzcat", tmp1); - - if (fcn.is_defined ()) - { - tmp2 = fcn.do_multi_index_op (1, tmp1); - - if (error_state) - goto done; - - tmp3 (j++) = tmp2 (0); - } - else - { - ::error ("cannot find overloaded horzcat function"); - goto done; - } - } - } - - if (tmp.length () == 1) - retval = tmp3 (0); - else - { - octave_value_list tmp2; - octave_value fcn = symbol_table::find_function ("vertcat", tmp3); - - if (fcn.is_defined ()) - { - tmp2 = fcn.do_multi_index_op (1, tmp3); - - if (! error_state) - retval = tmp2 (0); - } - else - ::error ("cannot find overloaded vertcat function"); - } + retval = do_class_concat (tmp); } else if (result_type == "double") { @@ -1125,6 +1204,201 @@ tw.visit_matrix (*this); } +/* +%% test concatenation with all zero matrices +%!assert([ '' 65*ones(1,10) ], 'AAAAAAAAAA'); +%!assert([ 65*ones(1,10) '' ], 'AAAAAAAAAA'); + +%!test +%! c = {'foo'; 'bar'; 'bazoloa'}; +%! assert ([c; 'a'; 'bc'; 'def'], {'foo'; 'bar'; 'bazoloa'; 'a'; 'bc'; 'def'}); + +%!assert (class ([int64(1), int64(1)]), 'int64') +%!assert (class ([int64(1), int32(1)]), 'int64') +%!assert (class ([int64(1), int16(1)]), 'int64') +%!assert (class ([int64(1), int8(1)]), 'int64') +%!assert (class ([int64(1), uint64(1)]), 'int64') +%!assert (class ([int64(1), uint32(1)]), 'int64') +%!assert (class ([int64(1), uint16(1)]), 'int64') +%!assert (class ([int64(1), uint8(1)]), 'int64') +%!assert (class ([int64(1), single(1)]), 'int64') +%!assert (class ([int64(1), double(1)]), 'int64') +%!assert (class ([int64(1), cell(1)]), 'cell') +%!assert (class ([int64(1), true]), 'int64') +%!assert (class ([int64(1), 'a']), 'char') + +%!assert (class ([int32(1), int64(1)]), 'int32') +%!assert (class ([int32(1), int32(1)]), 'int32') +%!assert (class ([int32(1), int16(1)]), 'int32') +%!assert (class ([int32(1), int8(1)]), 'int32') +%!assert (class ([int32(1), uint64(1)]), 'int32') +%!assert (class ([int32(1), uint32(1)]), 'int32') +%!assert (class ([int32(1), uint16(1)]), 'int32') +%!assert (class ([int32(1), uint8(1)]), 'int32') +%!assert (class ([int32(1), single(1)]), 'int32') +%!assert (class ([int32(1), double(1)]), 'int32') +%!assert (class ([int32(1), cell(1)]), 'cell') +%!assert (class ([int32(1), true]), 'int32') +%!assert (class ([int32(1), 'a']), 'char') + +%!assert (class ([int16(1), int64(1)]), 'int16') +%!assert (class ([int16(1), int32(1)]), 'int16') +%!assert (class ([int16(1), int16(1)]), 'int16') +%!assert (class ([int16(1), int8(1)]), 'int16') +%!assert (class ([int16(1), uint64(1)]), 'int16') +%!assert (class ([int16(1), uint32(1)]), 'int16') +%!assert (class ([int16(1), uint16(1)]), 'int16') +%!assert (class ([int16(1), uint8(1)]), 'int16') +%!assert (class ([int16(1), single(1)]), 'int16') +%!assert (class ([int16(1), double(1)]), 'int16') +%!assert (class ([int16(1), cell(1)]), 'cell') +%!assert (class ([int16(1), true]), 'int16') +%!assert (class ([int16(1), 'a']), 'char') + +%!assert (class ([int8(1), int64(1)]), 'int8') +%!assert (class ([int8(1), int32(1)]), 'int8') +%!assert (class ([int8(1), int16(1)]), 'int8') +%!assert (class ([int8(1), int8(1)]), 'int8') +%!assert (class ([int8(1), uint64(1)]), 'int8') +%!assert (class ([int8(1), uint32(1)]), 'int8') +%!assert (class ([int8(1), uint16(1)]), 'int8') +%!assert (class ([int8(1), uint8(1)]), 'int8') +%!assert (class ([int8(1), single(1)]), 'int8') +%!assert (class ([int8(1), double(1)]), 'int8') +%!assert (class ([int8(1), cell(1)]), 'cell') +%!assert (class ([int8(1), true]), 'int8') +%!assert (class ([int8(1), 'a']), 'char') + +%!assert (class ([uint64(1), int64(1)]), 'uint64') +%!assert (class ([uint64(1), int32(1)]), 'uint64') +%!assert (class ([uint64(1), int16(1)]), 'uint64') +%!assert (class ([uint64(1), int8(1)]), 'uint64') +%!assert (class ([uint64(1), uint64(1)]), 'uint64') +%!assert (class ([uint64(1), uint32(1)]), 'uint64') +%!assert (class ([uint64(1), uint16(1)]), 'uint64') +%!assert (class ([uint64(1), uint8(1)]), 'uint64') +%!assert (class ([uint64(1), single(1)]), 'uint64') +%!assert (class ([uint64(1), double(1)]), 'uint64') +%!assert (class ([uint64(1), cell(1)]), 'cell') +%!assert (class ([uint64(1), true]), 'uint64') +%!assert (class ([uint64(1), 'a']), 'char') + +%!assert (class ([uint32(1), int64(1)]), 'uint32') +%!assert (class ([uint32(1), int32(1)]), 'uint32') +%!assert (class ([uint32(1), int16(1)]), 'uint32') +%!assert (class ([uint32(1), int8(1)]), 'uint32') +%!assert (class ([uint32(1), uint64(1)]), 'uint32') +%!assert (class ([uint32(1), uint32(1)]), 'uint32') +%!assert (class ([uint32(1), uint16(1)]), 'uint32') +%!assert (class ([uint32(1), uint8(1)]), 'uint32') +%!assert (class ([uint32(1), single(1)]), 'uint32') +%!assert (class ([uint32(1), double(1)]), 'uint32') +%!assert (class ([uint32(1), cell(1)]), 'cell') +%!assert (class ([uint32(1), true]), 'uint32') +%!assert (class ([uint32(1), 'a']), 'char') + +%!assert (class ([uint16(1), int64(1)]), 'uint16') +%!assert (class ([uint16(1), int32(1)]), 'uint16') +%!assert (class ([uint16(1), int16(1)]), 'uint16') +%!assert (class ([uint16(1), int8(1)]), 'uint16') +%!assert (class ([uint16(1), uint64(1)]), 'uint16') +%!assert (class ([uint16(1), uint32(1)]), 'uint16') +%!assert (class ([uint16(1), uint16(1)]), 'uint16') +%!assert (class ([uint16(1), uint8(1)]), 'uint16') +%!assert (class ([uint16(1), single(1)]), 'uint16') +%!assert (class ([uint16(1), double(1)]), 'uint16') +%!assert (class ([uint16(1), cell(1)]), 'cell') +%!assert (class ([uint16(1), true]), 'uint16') +%!assert (class ([uint16(1), 'a']), 'char') + +%!assert (class ([uint8(1), int64(1)]), 'uint8') +%!assert (class ([uint8(1), int32(1)]), 'uint8') +%!assert (class ([uint8(1), int16(1)]), 'uint8') +%!assert (class ([uint8(1), int8(1)]), 'uint8') +%!assert (class ([uint8(1), uint64(1)]), 'uint8') +%!assert (class ([uint8(1), uint32(1)]), 'uint8') +%!assert (class ([uint8(1), uint16(1)]), 'uint8') +%!assert (class ([uint8(1), uint8(1)]), 'uint8') +%!assert (class ([uint8(1), single(1)]), 'uint8') +%!assert (class ([uint8(1), double(1)]), 'uint8') +%!assert (class ([uint8(1), cell(1)]), 'cell') +%!assert (class ([uint8(1), true]), 'uint8') +%!assert (class ([uint8(1), 'a']), 'char') + +%!assert (class ([single(1), int64(1)]), 'int64') +%!assert (class ([single(1), int32(1)]), 'int32') +%!assert (class ([single(1), int16(1)]), 'int16') +%!assert (class ([single(1), int8(1)]), 'int8') +%!assert (class ([single(1), uint64(1)]), 'uint64') +%!assert (class ([single(1), uint32(1)]), 'uint32') +%!assert (class ([single(1), uint16(1)]), 'uint16') +%!assert (class ([single(1), uint8(1)]), 'uint8') +%!assert (class ([single(1), single(1)]), 'single') +%!assert (class ([single(1), double(1)]), 'single') +%!assert (class ([single(1), cell(1)]), 'cell') +%!assert (class ([single(1), true]), 'single') +%!assert (class ([single(1), 'a']), 'char') + +%!assert (class ([double(1), int64(1)]), 'int64') +%!assert (class ([double(1), int32(1)]), 'int32') +%!assert (class ([double(1), int16(1)]), 'int16') +%!assert (class ([double(1), int8(1)]), 'int8') +%!assert (class ([double(1), uint64(1)]), 'uint64') +%!assert (class ([double(1), uint32(1)]), 'uint32') +%!assert (class ([double(1), uint16(1)]), 'uint16') +%!assert (class ([double(1), uint8(1)]), 'uint8') +%!assert (class ([double(1), single(1)]), 'single') +%!assert (class ([double(1), double(1)]), 'double') +%!assert (class ([double(1), cell(1)]), 'cell') +%!assert (class ([double(1), true]), 'double') +%!assert (class ([double(1), 'a']), 'char') + +%!assert (class ([cell(1), int64(1)]), 'cell') +%!assert (class ([cell(1), int32(1)]), 'cell') +%!assert (class ([cell(1), int16(1)]), 'cell') +%!assert (class ([cell(1), int8(1)]), 'cell') +%!assert (class ([cell(1), uint64(1)]), 'cell') +%!assert (class ([cell(1), uint32(1)]), 'cell') +%!assert (class ([cell(1), uint16(1)]), 'cell') +%!assert (class ([cell(1), uint8(1)]), 'cell') +%!assert (class ([cell(1), single(1)]), 'cell') +%!assert (class ([cell(1), double(1)]), 'cell') +%!assert (class ([cell(1), cell(1)]), 'cell') +%!assert (class ([cell(1), true]), 'cell') +%!assert (class ([cell(1), 'a']), 'cell') + +%!assert (class ([true, int64(1)]), 'int64') +%!assert (class ([true, int32(1)]), 'int32') +%!assert (class ([true, int16(1)]), 'int16') +%!assert (class ([true, int8(1)]), 'int8') +%!assert (class ([true, uint64(1)]), 'uint64') +%!assert (class ([true, uint32(1)]), 'uint32') +%!assert (class ([true, uint16(1)]), 'uint16') +%!assert (class ([true, uint8(1)]), 'uint8') +%!assert (class ([true, single(1)]), 'single') +%!assert (class ([true, double(1)]), 'double') +%!assert (class ([true, cell(1)]), 'cell') +%!assert (class ([true, true]), 'logical') +%!assert (class ([true, 'a']), 'char') + +%!assert (class (['a', int64(1)]), 'char') +%!assert (class (['a', int32(1)]), 'char') +%!assert (class (['a', int16(1)]), 'char') +%!assert (class (['a', int8(1)]), 'char') +%!assert (class (['a', int64(1)]), 'char') +%!assert (class (['a', int32(1)]), 'char') +%!assert (class (['a', int16(1)]), 'char') +%!assert (class (['a', int8(1)]), 'char') +%!assert (class (['a', single(1)]), 'char') +%!assert (class (['a', double(1)]), 'char') +%!assert (class (['a', cell(1)]), 'cell') +%!assert (class (['a', true]), 'char') +%!assert (class (['a', 'a']), 'char') + +%!assert (class ([cell(1), struct('foo', 'bar')]), 'cell') +%!error [struct('foo', 'bar'), cell(1)]; +*/ + DEFUN (string_fill_char, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} string_fill_char ()\n\ @@ -1146,3 +1420,18 @@ { return SET_INTERNAL_VARIABLE (string_fill_char); } + +/* +%!error (string_fill_char (1, 2)); +%% string_fill_char() function call must be outside of %!test block +%% due to the way a %!test block is wrapped inside a function +%!shared orig_val, old_val +%! orig_val = string_fill_char (); +%! old_val = string_fill_char ("X"); +%!test +%! assert (orig_val, old_val); +%! assert (string_fill_char (), "X"); +%! assert (["these"; "are"; "strings"], ["theseXX"; "areXXXX"; "strings"]); +%! string_fill_char (orig_val); +%! assert (string_fill_char (), orig_val); +*/
--- a/src/pt-pr-code.cc +++ b/src/pt-pr-code.cc @@ -214,10 +214,15 @@ indent (); - os << "for "; + os << (cmd.in_parallel () ? "parfor " : "for "); tree_expression *lhs = cmd.left_hand_side (); + tree_expression *maxproc = cmd.maxproc_expr (); + + if (maxproc) + os << "("; + if (lhs) lhs->accept (*this); @@ -228,6 +233,13 @@ if (expr) expr->accept (*this); + if (maxproc) + { + os << ", "; + maxproc->accept (*this); + os << ")"; + } + newline (); tree_statement_list *list = cmd.body (); @@ -245,7 +257,7 @@ indent (); - os << "endfor"; + os << (cmd.in_parallel () ? "endparfor" : "endfor"); } void @@ -529,16 +541,10 @@ print_parens (expr, "("); - bool expr_has_parens = false; - tree_expression *e = expr.expression (); if (e) - { - e->accept (*this); - - expr_has_parens = e->is_postfix_indexed (); - } + e->accept (*this); std::list<tree_argument_list *> arg_lists = expr.arg_lists (); std::string type_tags = expr.type_tags ();
--- a/src/pt-unop.cc +++ b/src/pt-unop.cc @@ -28,6 +28,7 @@ #include "oct-obj.h" #include "oct-lvalue.h" #include "ov.h" +#include "profiler.h" #include "pt-bp.h" #include "pt-unop.h" #include "pt-walk.h" @@ -72,10 +73,14 @@ if (! error_state) { + BEGIN_PROFILER_BLOCK ("prefix " + oper ()) + ref.do_unary_op (etype); if (! error_state) retval = ref.value (); + + END_PROFILER_BLOCK } } else @@ -84,6 +89,8 @@ if (! error_state && val.is_defined ()) { + BEGIN_PROFILER_BLOCK ("prefix " + oper ()) + // Attempt to do the operation in-place if it is unshared // (a temporary expression). if (val.get_count () == 1) @@ -93,6 +100,8 @@ if (error_state) retval = octave_value (); + + END_PROFILER_BLOCK } } } @@ -153,7 +162,9 @@ { retval = ref.value (); + BEGIN_PROFILER_BLOCK ("postfix " + oper ()) ref.do_unary_op (etype); + END_PROFILER_BLOCK } } else @@ -162,10 +173,14 @@ if (! error_state && val.is_defined ()) { + BEGIN_PROFILER_BLOCK ("postfix " + oper ()) + retval = ::do_unary_op (etype, val); if (error_state) retval = octave_value (); + + END_PROFILER_BLOCK } } }
--- a/src/sighandlers.cc +++ b/src/sighandlers.cc @@ -945,6 +945,12 @@ return retval; } +/* +%!error SIG (1); +%!assert (isstruct (SIG ())); +%!assert (! isempty (SIG ())); +*/ + DEFUN (debug_on_interrupt, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} debug_on_interrupt ()\n\ @@ -958,6 +964,17 @@ return SET_INTERNAL_VARIABLE (debug_on_interrupt); } +/* +%!error (debug_on_interrupt (1, 2)); +%!test +%! orig_val = debug_on_interrupt (); +%! old_val = debug_on_interrupt (! orig_val); +%! assert (orig_val, old_val); +%! assert (debug_on_interrupt (), ! orig_val); +%! debug_on_interrupt (orig_val); +%! assert (debug_on_interrupt (), orig_val); +*/ + DEFUN (sighup_dumps_octave_core, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} sighup_dumps_octave_core ()\n\ @@ -970,6 +987,17 @@ return SET_INTERNAL_VARIABLE (sighup_dumps_octave_core); } +/* +%!error (sighup_dumps_octave_core (1, 2)); +%!test +%! orig_val = sighup_dumps_octave_core (); +%! old_val = sighup_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sighup_dumps_octave_core (), ! orig_val); +%! sighup_dumps_octave_core (orig_val); +%! assert (sighup_dumps_octave_core (), orig_val); +*/ + DEFUN (sigterm_dumps_octave_core, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{val} =} sigterm_dumps_octave_core ()\n\ @@ -981,3 +1009,14 @@ { return SET_INTERNAL_VARIABLE (sigterm_dumps_octave_core); } + +/* +%!error (sigterm_dumps_octave_core (1, 2)); +%!test +%! orig_val = sigterm_dumps_octave_core (); +%! old_val = sigterm_dumps_octave_core (! orig_val); +%! assert (orig_val, old_val); +%! assert (sigterm_dumps_octave_core (), ! orig_val); +%! sigterm_dumps_octave_core (orig_val); +%! assert (sigterm_dumps_octave_core (), orig_val); +*/
--- a/src/strfns.cc +++ b/src/strfns.cc @@ -80,10 +80,12 @@ int nargin = args.length (); - if (nargin == 1) + if (nargin == 0) + retval = ""; + else if (nargin == 1) retval = args(0).convert_to_str (true, true, args(0).is_dq_string () ? '"' : '\''); - else if (nargin > 1) + else { int n_elts = 0; @@ -144,14 +146,12 @@ retval = octave_value (result, '\''); } - else - print_usage (); return retval; } /* -%!error <Invalid call to char> char() +%!assert (char (), ''); %!assert (char (100) == "d"); %!assert (all(char (100,100) == ["d";"d"])); %!assert (all(char ({100,100}) == ["d";"d"])); @@ -162,6 +162,13 @@ %!assert (all(char ({100,{100, {""}}}) == ["d";"d";" "])) %!assert (all(char (["a";"be"], {"c", 100}) == ["a";"be";"c";"d"])) %!assert(strcmp (char ("a", "bb", "ccc"), ["a "; "bb "; "ccc"])); +%!assert(strcmp (char ([65, 83, 67, 73, 73]), "ASCII")); + +%!test +%! x = char ("foo", "bar", "foobar"); +%! assert((strcmp (x(1,:), "foo ") +%! && strcmp (x(2,:), "bar ") +%! && strcmp (x(3,:), "foobar"))); */ DEFUN (strvcat, args, , @@ -314,14 +321,20 @@ } /* - %!assert (ischar ("a"), logical (1)); %!assert (ischar (["ab";"cd"]), logical (1)); %!assert (ischar ({"ab"}), logical (0)); %!assert (ischar (1), logical (0)); +%!assert(ischar ([1, 2]), logical (0)); +%!assert(ischar ([]), logical (0)); +%!assert(ischar ([1, 2; 3, 4]), logical (0)); +%!assert(ischar (""), logical (1)); +%!assert(ischar ("test"), logical (1)); +%!assert(ischar (["test"; "ing"]), logical (1)); +%!assert(ischar (struct ("foo", "bar")), logical (0)); %!error <Invalid call to ischar.*> ischar (); - - */ +%!error <Invalid call to ischar.*> ischar ("test", 1); +*/ static octave_value do_strcmp_fun (const octave_value& arg0, const octave_value& arg1, @@ -576,12 +589,15 @@ } /* +%!error <Invalid call to strcmp.*> strcmp (); +%!error <Invalid call to strcmp.*> strcmp ("foo", "bar", 3); +%! %!shared x %! x = char (zeros (0, 2)); %!assert (strcmp ('', x) == false); %!assert (strcmp (x, '') == false); %!assert (strcmp (x, x) == true); -## %!assert (strcmp ({''}, x) == false); +## %!assert (strcmp ({''}, x) == true); ## %!assert (strcmp ({x}, '') == false); ## %!assert (strcmp ({x}, x) == true); ## %!assert (strcmp ('', {x}) == false); @@ -608,14 +624,16 @@ %!assert (all (strcmp ('', {y}) == [true; true])); %!assert (all (strcmp (y, {''}) == [true; true])); %!assert (all (strcmp (y, {y}) == [true; true])); -## %!assert (all (strcmp ({y; y}, '') == [false; false])); -## %!assert (all (strcmp ({y; y}, {''}) == [false; false])); -## %!assert (all (strcmp ('', {y; y}) == [false; false])); -## %!assert (all (strcmp ({''}, {y; y}) == [false; false])); +%!assert (all (strcmp ({y; y}, '') == [true; true])); +%!assert (all (strcmp ({y; y}, {''}) == [true; true])); +%!assert (all (strcmp ('', {y; y}) == [true; true])); +%!assert (all (strcmp ({''}, {y; y}) == [true; true])); %!assert (all (strcmp ({'foo'}, y) == [false; false])); %!assert (all (strcmp ({'foo'}, y) == [false; false])); %!assert (all (strcmp (y, {'foo'}) == [false; false])); %!assert (all (strcmp (y, {'foo'}) == [false; false])); +%!assert (strcmp ("foobar", "foobar"), true); +%!assert (strcmp ("fooba", "foobar"), false); */ // Apparently, Matlab ignores the dims with strncmp. It also
--- a/src/symtab.cc +++ b/src/symtab.cc @@ -575,13 +575,16 @@ // variable // subfunction // private function +// class method // class constructor -// class method // legacy dispatch // command-line function // autoload function // function on the path // built-in function +// +// Matlab documentation states that constructors have higher precedence +// than methods, but that does not seem to be the case. octave_value symbol_table::fcn_info::fcn_info_rep::find (const octave_value_list& args, @@ -687,6 +690,18 @@ } } + // Class methods. + + if (! args.empty ()) + { + std::string dispatch_type = get_dispatch_type (args); + + octave_value fcn = find_method (dispatch_type); + + if (fcn.is_defined ()) + return fcn; + } + // Class constructors. The class name and function name are the same. str_val_iterator q = class_constructors.find (name); @@ -716,18 +731,6 @@ } } - // Class methods. - - if (! args.empty ()) - { - std::string dispatch_type = get_dispatch_type (args); - - octave_value fcn = find_method (dispatch_type); - - if (fcn.is_defined ()) - return fcn; - } - // Legacy dispatch. if (! args.empty () && ! dispatch_map.empty ()) @@ -1463,7 +1466,9 @@ { octave_value retval; - if (nargout > 0) + int nargin = args.length (); + + if (nargout > 0 || nargin == 0) { switch (Vignore_function_time_stamp) { @@ -1481,8 +1486,6 @@ } } - int nargin = args.length (); - if (nargin == 1) { std::string sval = args(0).string_value (); @@ -1507,6 +1510,25 @@ return retval; } +/* +%!shared old_state +%! old_state = ignore_function_time_stamp (); +%!test +%! state = ignore_function_time_stamp ("all"); +%! assert (state, old_state); +%! assert (ignore_function_time_stamp (), "all"); +%! state = ignore_function_time_stamp ("system"); +%! assert (state, "all"); +%! assert (ignore_function_time_stamp (), "system"); +%! ignore_function_time_stamp (old_state); + +%% Test input validation +%!error (ignore_function_time_stamp ("all", "all")) +%!error (ignore_function_time_stamp ("UNKNOWN_VALUE")) +%!error (ignore_function_time_stamp (42)) + +*/ + DEFUN (__current_scope__, , , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {[@var{scope}, @var{context}]} __dump_symtab_info__ ()\n\
--- a/src/symtab.h +++ b/src/symtab.h @@ -790,6 +790,11 @@ return rep->built_in_function; } + octave_value find_cmdline_function (void) const + { + return rep->cmdline_function; + } + octave_value find_autoload (void) { return rep->find_autoload (); @@ -1787,6 +1792,25 @@ return retval; } + static std::list<std::string> cmdline_function_names (void) + { + std::list<std::string> retval; + + for (fcn_table_const_iterator p = fcn_table.begin (); + p != fcn_table.end (); p++) + { + octave_value fcn = p->second.find_cmdline_function (); + + if (fcn.is_defined ()) + retval.push_back (p->first); + } + + if (! retval.empty ()) + retval.sort (); + + return retval; + } + static bool is_local_variable (const std::string& name) { if (xcurrent_scope == xglobal_scope)
--- a/src/sysdep.cc +++ b/src/sysdep.cc @@ -101,28 +101,43 @@ #endif #if defined (__WIN32__) && ! defined (_POSIX_VERSION) + +#define WIN32_LEAN_AND_MEAN +#include <tlhelp32.h> + static void w32_set_octave_home (void) { - int n = 1024; + std::string bin_dir; - std::string bin_dir (n, '\0'); + HANDLE h = CreateToolhelp32Snapshot (TH32CS_SNAPMODULE | + TH32CS_SNAPMODULE32, 0); - while (true) + if (h != INVALID_HANDLE_VALUE) { - HMODULE hMod = GetModuleHandle ("octinterp"); - int status = GetModuleFileName (hMod, &bin_dir[0], n); + MODULEENTRY32 mod_info; + + ZeroMemory (&mod_info, sizeof (mod_info)); + mod_info.dwSize = sizeof (mod_info); - if (status < n) - { - bin_dir.resize (status); - break; - } - else - { - n *= 2; - bin_dir.resize (n); - } + if (Module32First (h, &mod_info)) + { + do + { + std::string mod_name (mod_info.szModule); + + if (mod_name.find ("octinterp") != std::string::npos) + { + bin_dir = mod_info.szExePath; + if (bin_dir[bin_dir.length () - 1] != '\\') + bin_dir.append (1, '\\'); + break; + } + } + while (Module32Next (h, &mod_info)); + } + + CloseHandle (h); } if (! bin_dir.empty ()) @@ -586,8 +601,16 @@ return retval; } + DEFALIAS (setenv, putenv); +/* +%!assert (ischar (getenv ("OCTAVE_HOME"))); +%!test +%! setenv ("dummy_variable_that_cannot_matter", "foobar"); +%! assert (getenv ("dummy_variable_that_cannot_matter"), "foobar"); +*/ + // FIXME -- perhaps kbhit should also be able to print a prompt? DEFUN (kbhit, args, , @@ -695,6 +718,12 @@ return retval; } +/* +%!error (pause (1, 2)); +%!test +%! pause (1); +*/ + DEFUN (sleep, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} sleep (@var{seconds})\n\ @@ -724,6 +753,13 @@ return retval; } +/* +%!error (sleep ()); +%!error (sleep (1, 2)); +%!test +%! sleep (1); +*/ + DEFUN (usleep, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} usleep (@var{microseconds})\n\ @@ -760,6 +796,13 @@ return retval; } +/* +%!error (usleep ()); +%!error (usleep (1, 2)); +%!test +%! usleep (1000); +*/ + // FIXME -- maybe this should only return 1 if IEEE floating // point functions really work. @@ -776,6 +819,10 @@ || flt_fmt == oct_mach_info::flt_fmt_ieee_big_endian); } +/* +%!assert (islogical (isieee ())); +*/ + DEFUN (native_float_format, , , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} native_float_format ()\n\ @@ -787,6 +834,10 @@ return octave_value (oct_mach_info::float_format_as_string (flt_fmt)); } +/* +%!assert (ischar (native_float_format ())); +*/ + DEFUN (tilde_expand, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} tilde_expand (@var{string})\n\ @@ -835,3 +886,14 @@ return retval; } + +/* +%!test +%! if (isempty (getenv ("HOME"))) +%! setenv ("HOME", "foobar"); +%! endif +%! home = getenv ("HOME"); +%! assert (tilde_expand ("~/foobar"), [home filesep() "foobar"]); +%! assert (tilde_expand ("/foo/bar"), "/foo/bar"); +%! assert (tilde_expand ("foo/bar"), "foo/bar"); +*/
--- a/src/token.h +++ b/src/token.h @@ -45,11 +45,13 @@ { simple_end, classdef_end, + enumeration_end, events_end, for_end, function_end, if_end, methods_end, + parfor_end, properties_end, switch_end, while_end,
--- a/src/toplev.cc +++ b/src/toplev.cc @@ -39,6 +39,7 @@ #include <unistd.h> #include "cmd-edit.h" +#include "cmd-hist.h" #include "file-ops.h" #include "lo-error.h" #include "lo-mappers.h" @@ -1001,6 +1002,20 @@ DEFALIAS (shell_cmd, system); +/* +%!error (system ()); +%!error (system (1, 2, 3)); +%!test +%! if (ispc ()) +%! cmd = "dir"; +%! else +%! cmd = "ls"; +%! endif +%! [status, output] = system (cmd); +%! assert (ischar (output)); +%! assert (! isempty (output)); +*/ + // FIXME -- this should really be static, but that causes // problems on some systems. std::list<std::string> octave_atexit_functions; @@ -1039,7 +1054,7 @@ SAFE_CALL (octave_history_write_timestamp, ()) - if (Vsaving_history) + if (! command_history::ignoring_entries ()) SAFE_CALL (command_history::clean_up_and_save, ()) SAFE_CALL (close_files, ()) @@ -1285,6 +1300,10 @@ { false, "MAGICK_LDFLAGS", OCTAVE_CONF_MAGICK_LDFLAGS }, { false, "MAGICK_LIBS", OCTAVE_CONF_MAGICK_LIBS }, { false, "MKOCTFILE_DL_LDFLAGS", OCTAVE_CONF_MKOCTFILE_DL_LDFLAGS }, + { false, "OCTAVE_LINK_DEPS", OCTAVE_CONF_OCTAVE_LINK_DEPS }, + { false, "OCTAVE_LINK_OPTS", OCTAVE_CONF_OCTAVE_LINK_OPTS }, + { false, "OCT_LINK_DEPS", OCTAVE_CONF_OCT_LINK_DEPS }, + { false, "OCT_LINK_OPTS", OCTAVE_CONF_OCT_LINK_OPTS }, { false, "OPENGL_LIBS", OCTAVE_CONF_OPENGL_LIBS }, { false, "PTHREAD_CFLAGS", OCTAVE_CONF_PTHREAD_CFLAGS }, { false, "PTHREAD_LIBS", OCTAVE_CONF_PTHREAD_LIBS }, @@ -1298,7 +1317,6 @@ { false, "RDYNAMIC_FLAG", OCTAVE_CONF_RDYNAMIC_FLAG }, { false, "READLINE_LIBS", OCTAVE_CONF_READLINE_LIBS }, { false, "REGEX_LIBS", OCTAVE_CONF_REGEX_LIBS }, - { false, "RLD_FLAG", OCTAVE_CONF_RLD_FLAG }, { false, "SED", OCTAVE_CONF_SED }, { false, "SHARED_LIBS", OCTAVE_CONF_SHARED_LIBS }, { false, "SHLEXT", OCTAVE_CONF_SHLEXT }, @@ -1439,6 +1457,15 @@ return retval; } +/* +%!error octave_config_info (1, 2); +%!assert (ischar (octave_config_info ("version"))); +%!test +%! x = octave_config_info (); +%! assert (isstruct (x)); +%! assert (! isempty (x)); +*/ + #if defined (__GNUG__) && defined (DEBUG_NEW_DELETE) int debug_new_delete = 0;
--- a/src/txt-eng-ft.cc +++ b/src/txt-eng-ft.cc @@ -36,6 +36,33 @@ #include "pr-output.h" #include "txt-eng-ft.h" +// FIXME -- maybe issue at most one warning per glyph/font/size/weight +// combination. + +static void +gripe_missing_glyph (char c) +{ + warning_with_id ("Octave:missing-glyph", + "ft_render: skipping missing glyph for character `%c'", + c); +} + +static void +gripe_glyph_render (char c) +{ + warning_with_id ("Octave:glyph-render", + "ft_render: unable to render glyph for character `%c'", + c); +} + +#ifdef _MSC_VER +// This is just a trick to avoid multiply symbols definition. +// PermMatrix.h contains a dllexport'ed Array<octave_idx_type> +// that will make MSVC not to generate new instantiation and +// use the imported one. +#include "PermMatrix.h" +#endif + class ft_manager { @@ -202,7 +229,8 @@ ft_render::ft_render (void) : text_processor (), face (0), bbox (1, 4, 0.0), - xoffset (0), yoffset (0), mode (MODE_BBOX), + xoffset (0), yoffset (0), multiline_halign (0), + multiline_align_xoffsets(), mode (MODE_BBOX), red (0), green (0), blue (0) { } @@ -270,25 +298,47 @@ { if (face) { + int line_index = 0; + FT_UInt box_line_width = 0; std::string str = e.string_value (); FT_UInt glyph_index, previous = 0; + if (mode == MODE_BBOX) + multiline_align_xoffsets.clear(); + else if (mode == MODE_RENDER) + xoffset += multiline_align_xoffsets[line_index]; + for (size_t i = 0; i < str.length (); i++) { glyph_index = FT_Get_Char_Index (face, str[i]); - if (! glyph_index - || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) - ::warning ("ft_render: skipping missing glyph for character `%c'", - str[i]); + if (str[i] != '\n' + && (! glyph_index + || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT))) + gripe_missing_glyph (str[i]); else { switch (mode) { case MODE_RENDER: - if (FT_Render_Glyph (face->glyph, FT_RENDER_MODE_NORMAL)) - ::warning ("ft_render: unable to render glyph for character `%c'", - str[i]); + if (str[i] == '\n') + { + glyph_index = FT_Get_Char_Index(face, ' '); + if (!glyph_index || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) + { + gripe_missing_glyph (' '); + } + else + { + line_index++; + xoffset = multiline_align_xoffsets[line_index]; + yoffset -= (face->size->metrics.height >> 6); + } + } + else if (FT_Render_Glyph (face->glyph, FT_RENDER_MODE_NORMAL)) + { + gripe_glyph_render (str[i]); + } else { FT_Bitmap& bitmap = face->glyph->bitmap; @@ -304,6 +354,14 @@ x0 = xoffset+face->glyph->bitmap_left; y0 = yoffset+face->glyph->bitmap_top; + + // 'w' seems to have a negative -1 + // face->glyph->bitmap_left, this is so we don't + // index out of bound, and assumes we we allocated + // the right amount of horizontal space in the bbox. + if (x0 < 0) + x0 = 0; + for (int r = 0; r < bitmap.rows; r++) for (int c = 0; c < bitmap.width; c++) { @@ -327,43 +385,89 @@ break; case MODE_BBOX: - // width - if (previous) + if (str[i] == '\n') { - FT_Vector delta; - - FT_Get_Kerning (face, previous, glyph_index, FT_KERNING_DEFAULT, &delta); - bbox(2) += (delta.x >> 6); - } - bbox(2) += (face->glyph->advance.x >> 6); - - int asc, desc; - - if (false /*tight*/) - { - desc = face->glyph->metrics.horiBearingY - face->glyph->metrics.height; - asc = face->glyph->metrics.horiBearingY; + glyph_index = FT_Get_Char_Index(face, ' '); + if (! glyph_index + || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) + { + gripe_missing_glyph (' '); + } + else + { + multiline_align_xoffsets.push_back(box_line_width); + // Reset the pixel width for this newline, so we don't + // allocate a bounding box larger than the horizontal + // width of the multi-line + box_line_width = 0; + bbox(1) -= (face->size->metrics.height >> 6); + } } else { - asc = face->size->metrics.ascender; - desc = face->size->metrics.descender; - } + // width + if (previous) + { + FT_Vector delta; - asc = yoffset + (asc >> 6); - desc = yoffset + (desc >> 6); + FT_Get_Kerning (face, previous, glyph_index, + FT_KERNING_DEFAULT, &delta); + + box_line_width += (delta.x >> 6); + } + + box_line_width += (face->glyph->advance.x >> 6); + + int asc, desc; - if (desc < bbox(1)) - { - bbox(3) += (bbox(1) - desc); - bbox(1) = desc; - } - if (asc > (bbox(3)+bbox(1))) - bbox(3) = asc-bbox(1); + if (false /*tight*/) + { + desc = face->glyph->metrics.horiBearingY - face->glyph->metrics.height; + asc = face->glyph->metrics.horiBearingY; + } + else + { + asc = face->size->metrics.ascender; + desc = face->size->metrics.descender; + } + + asc = yoffset + (asc >> 6); + desc = yoffset + (desc >> 6); + + if (desc < bbox(1)) + { + bbox(3) += (bbox(1) - desc); + bbox(1) = desc; + } + if (asc > (bbox(3)+bbox(1))) + bbox(3) = asc-bbox(1); + if (bbox(2) < box_line_width) + bbox(2) = box_line_width; + } break; } + if (str[i] == '\n') + previous = 0; + else + previous = glyph_index; + } + } + if (mode == MODE_BBOX) + { + /* Push last the width associated with the last line */ + multiline_align_xoffsets.push_back(box_line_width); - previous = glyph_index; + for (unsigned int i = 0; i < multiline_align_xoffsets.size(); i++) + { + /* Center align */ + if (multiline_halign == 1) + multiline_align_xoffsets[i] = (bbox(2) - multiline_align_xoffsets[i])/2; + /* Right align */ + else if (multiline_halign == 2) + multiline_align_xoffsets[i] = (bbox(2) - multiline_align_xoffsets[i]); + /* Left align */ + else + multiline_align_xoffsets[i] = 0; } } } @@ -480,7 +584,7 @@ text_element *elt = text_parser_none ().parse (txt); Matrix extent = get_extent (elt, rotation); delete elt; - + return extent; } @@ -507,6 +611,8 @@ // FIXME: clip "rotation" between 0 and 360 int rot_mode = rotation_to_mode (rotation); + multiline_halign = halign; + text_element *elt = text_parser_none ().parse (txt); pixels_ = render (elt, box, rot_mode); delete elt;
--- a/src/txt-eng-ft.h +++ b/src/txt-eng-ft.h @@ -25,6 +25,8 @@ #if HAVE_FREETYPE +#include <vector> + #include <ft2build.h> #include FT_FREETYPE_H @@ -94,6 +96,8 @@ uint8NDArray pixels; int xoffset; int yoffset; + int multiline_halign; + std::vector<int> multiline_align_xoffsets; int mode; uint8_t red, green, blue; };
--- a/src/utils.cc +++ b/src/utils.cc @@ -114,6 +114,17 @@ return retval; } +/* +%!error isvarname (); +%!error isvarname ("foo", "bar"); + +%!assert (isvarname ("foo"), true); +%!assert (isvarname ("_foo"), true); +%!assert (isvarname ("_1"), true); +%!assert (isvarname ("1foo"), false); +%!assert (isvarname (""), false); +*/ + // Return TRUE if F and G are both names for the same file. bool @@ -325,6 +336,24 @@ return retval; } +/* +%!error file_in_loadpath (); +%!error file_in_loadpath ("foo", "bar", 1); + +%!test +%! f = file_in_loadpath ("plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_loadpath ("$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); +*/ + DEFUN (file_in_path, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} file_in_path (@var{path}, @var{file})\n\ @@ -390,6 +419,25 @@ return retval; } +/* +%!error file_in_path (); +%!error file_in_path ("foo"); +%!error file_in_path ("foo", "bar", "baz", 1); + +%!test +%! f = file_in_path (path (), "plot.m"); +%! assert (ischar (f)); +%! assert (! isempty (f)); + +%!test +%! f = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$"); +%! assert (f, ""); + +%!test +%! lst = file_in_path (path (), "$$probably_!!_not_&&_a_!!_file$$", "all"); +%! assert (lst, {}); +*/ + std::string file_in_path (const std::string& name, const std::string& suffix) { @@ -623,6 +671,22 @@ return retval; } +/* +%!error do_string_escapes (); +%!error do_string_escapes ("foo", "bar"); + +%!assert (do_string_escapes ('foo\nbar'), "foo\nbar"); +%!assert (do_string_escapes ("foo\\nbar"), "foo\nbar"); +%!assert (do_string_escapes ("foo\\nbar"), ["foo", char(10), "bar"]); +%!assert ("foo\nbar", ["foo", char(10), "bar"]); + +%!assert (do_string_escapes ('\a\b\f\n\r\t\v'), "\a\b\f\n\r\t\v"); +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), "\a\b\f\n\r\t\v"); +%!assert (do_string_escapes ("\\a\\b\\f\\n\\r\\t\\v"), +%! char ([7, 8, 12, 10, 13, 9, 11])); +%!assert ("\a\b\f\n\r\t\v", char ([7, 8, 12, 10, 13, 9, 11])); +*/ + const char * undo_string_escape (char c) { @@ -729,6 +793,20 @@ return retval; } +/* +%!error undo_string_escapes (); +%!error undo_string_escapes ("foo", "bar"); + +%!assert (undo_string_escapes ("foo\nbar"), 'foo\nbar'); +%!assert (undo_string_escapes ("foo\nbar"), "foo\\nbar"); +%!assert (undo_string_escapes (["foo", char(10), "bar"]), "foo\\nbar"); + +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), '\a\b\f\n\r\t\v'); +%!assert (undo_string_escapes ("\a\b\f\n\r\t\v"), "\\a\\b\\f\\n\\r\\t\\v"); +%!assert (undo_string_escapes (char ([7, 8, 12, 10, 13, 9, 11])), +%! "\\a\\b\\f\\n\\r\\t\\v"); +*/ + DEFUN (is_absolute_filename, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} is_absolute_filename (@var{file})\n\ @@ -747,6 +825,13 @@ return retval; } +/* +%!error is_absolute_filename (); +%!error is_absolute_filename ("foo", "bar"); + +FIXME -- we need system-dependent tests here. +*/ + DEFUN (is_rooted_relative_filename, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} is_rooted_relative_filename (@var{file})\n\ @@ -765,6 +850,13 @@ return retval; } +/* +%!error is_rooted_relative_filename (); +%!error is_rooted_relative_filename ("foo", "bar"); + +FIXME -- we need system-dependent tests here. +*/ + DEFUN (make_absolute_filename, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} make_absolute_filename (@var{file})\n\ @@ -789,6 +881,13 @@ return retval; } +/* +%!error make_absolute_filename (); +%!error make_absolute_filename ("foo", "bar"); + +FIXME -- we need system-dependent tests here. +*/ + DEFUN (find_dir_in_path, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} find_dir_in_path (@var{dir})\n\ @@ -829,6 +928,13 @@ return retval; } +/* +%!error find_dir_in_path (); +%!error find_dir_in_path ("foo", "bar", 1); + +FIXME -- need to create tests using current path, pathsep, and dirsep. +*/ + DEFUNX ("errno", Ferrno, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {@var{err} =} errno ()\n\ @@ -873,6 +979,21 @@ return retval; } +/* +%!error errno ("foo", 1); + +%!assert (isnumeric (errno ())); + +%!test +%! lst = errno_list (); +%! fns = fieldnames (lst); +%! oldval = errno (fns{1}); +%! assert (isnumeric (oldval)); +%! errno (oldval); +%! newval = errno (); +%! assert (oldval, newval); +*/ + DEFUN (errno_list, args, , "-*- texinfo -*-\n\ @deftypefn {Built-in Function} {} errno_list ()\n\ @@ -889,6 +1010,12 @@ return retval; } +/* +%!error errno_list ("foo"); + +%!assert (isstruct (errno_list ())); +*/ + static void check_dimensions (octave_idx_type& nr, octave_idx_type& nc, const char *warnfor) { @@ -1243,7 +1370,9 @@ END_INTERRUPT_IMMEDIATELY_IN_FOREIGN_CODE; - if (nchars > -1 && nchars < size) + // Cast to avoid signed/unsigned comparison is safe due to + // short-circuiting + if (nchars > -1 && static_cast<size_t>(nchars) < size) break; else { @@ -1352,6 +1481,14 @@ return retval; } +/* +%!error isindex (); + +%!assert (isindex ([1, 2, 3])); +%!assert (isindex (1:3)); +%!assert (isindex ([1, 2, -3]), false); +*/ + octave_value_list do_simple_cellfun (octave_value_list (*fun) (const octave_value_list&, int), const char *fun_name, const octave_value_list& args,
--- a/src/variables.cc +++ b/src/variables.cc @@ -416,7 +416,9 @@ && var_ok && (type == "any" || type == "var") && (val.is_constant () || val.is_object () - || val.is_inline_function () || val.is_function_handle ())) + || val.is_function_handle () + || val.is_anonymous_function () + || val.is_inline_function ())) { retval = 1; } @@ -1043,11 +1045,12 @@ const std::string& expr_str = std::string (), const octave_value& expr_val = octave_value ()) : name (expr_str.empty () ? sr.name () : expr_str), + varval (expr_val.is_undefined () ? sr.varval () : expr_val), is_automatic (sr.is_automatic ()), + is_complex (varval.is_complex_type ()), is_formal (sr.is_formal ()), is_global (sr.is_global ()), - is_persistent (sr.is_persistent ()), - varval (expr_val.is_undefined () ? sr.varval () : expr_val) + is_persistent (sr.is_persistent ()) { } void display_line (std::ostream& os, @@ -1117,13 +1120,14 @@ { case 'a': { - char tmp[5]; + char tmp[6]; tmp[0] = (is_automatic ? 'a' : ' '); - tmp[1] = (is_formal ? 'f' : ' '); - tmp[2] = (is_global ? 'g' : ' '); - tmp[3] = (is_persistent ? 'p' : ' '); - tmp[4] = 0; + tmp[1] = (is_complex ? 'c' : ' '); + tmp[2] = (is_formal ? 'f' : ' '); + tmp[3] = (is_global ? 'g' : ' '); + tmp[4] = (is_persistent ? 'p' : ' '); + tmp[5] = 0; os << tmp; } @@ -1172,11 +1176,12 @@ } std::string name; + octave_value varval; bool is_automatic; + bool is_complex; bool is_formal; bool is_global; bool is_persistent; - octave_value varval; }; public: @@ -1333,6 +1338,9 @@ for (size_t i = 0; i < param_string.length (); i++) param_length(i) = param_names(i) . length (); + // The attribute column needs size 5. + param_length(pos_a) = 5; + // Calculating necessary spacing for name column, // bytes column, elements column and class column @@ -1798,6 +1806,9 @@ Automatic variable. An automatic variable is one created by the\n\ interpreter, for example @code{argn}.\n\ \n\ +@item @code{c}\n\ +Variable of complex type.\n\ +\n\ @item @code{f}\n\ Formal parameter (function argument).\n\ \n\
--- a/src/xpow.cc +++ b/src/xpow.cc @@ -49,6 +49,8 @@ #include "utils.h" #include "xpow.h" +#include "bsxfun.h" + #ifdef _OPENMP #include <omp.h> #endif @@ -1243,8 +1245,21 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun (a_dims, b_dims)) + { + //Potentially complex results + NDArray xa = octave_value_extract<NDArray> (a); + NDArray xb = octave_value_extract<NDArray> (b); + if (! xb.all_integers () && xa.any_element_is_negative ()) + return octave_value (bsxfun_pow (ComplexNDArray (xa), xb)); + else + return octave_value (bsxfun_pow (xa, xb)); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } int len = a.length (); @@ -1318,8 +1333,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun (a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } ComplexNDArray result (a_dims); @@ -1410,8 +1432,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun (a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } ComplexNDArray result (a_dims); @@ -1453,8 +1482,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun (a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } ComplexNDArray result (a_dims); @@ -2562,8 +2598,21 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun (a_dims, b_dims)) + { + //Potentially complex results + FloatNDArray xa = octave_value_extract<FloatNDArray> (a); + FloatNDArray xb = octave_value_extract<FloatNDArray> (b); + if (! xb.all_integers () && xa.any_element_is_negative ()) + return octave_value (bsxfun_pow (FloatComplexNDArray (xa), xb)); + else + return octave_value (bsxfun_pow (xa, xb)); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } int len = a.length (); @@ -2637,8 +2686,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun (a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } FloatComplexNDArray result (a_dims); @@ -2729,8 +2785,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun (a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } FloatComplexNDArray result (a_dims); @@ -2772,8 +2835,15 @@ if (a_dims != b_dims) { - gripe_nonconformant ("operator .^", a_dims, b_dims); - return octave_value (); + if (is_valid_bsxfun (a_dims, b_dims)) + { + return bsxfun_pow (a, b); + } + else + { + gripe_nonconformant ("operator .^", a_dims, b_dims); + return octave_value (); + } } FloatComplexNDArray result (a_dims);
deleted file mode 100644 --- a/test/@Blork/module.mk +++ /dev/null @@ -1,8 +0,0 @@ -at_Blork_FCN_FILES = \ - @Blork/Blork.m \ - @Blork/bleek.m \ - @Blork/display.m \ - @Blork/get.m \ - @Blork/set.m - -FCN_FILES += $(at_Blork_FCN_FILES)
deleted file mode 100644 --- a/test/@Cork/module.mk +++ /dev/null @@ -1,8 +0,0 @@ -at_Cork_FCN_FILES = \ - @Cork/Cork.m \ - @Cork/click.m \ - @Cork/display.m \ - @Cork/get.m \ - @Cork/set.m - -FCN_FILES += $(at_Cork_FCN_FILES)
deleted file mode 100644 --- a/test/@Dork/module.mk +++ /dev/null @@ -1,11 +0,0 @@ -at_Dork_FCN_FILES = \ - @Dork/Dork.m \ - @Dork/bling.m \ - @Dork/display.m \ - @Dork/gack.m \ - @Dork/get.m \ - @Dork/getStash.m \ - @Dork/set.m \ - @Dork/private/myStash.m - -FCN_FILES += $(at_Dork_FCN_FILES)
deleted file mode 100644 --- a/test/@Gork/module.mk +++ /dev/null @@ -1,11 +0,0 @@ -at_Gork_FCN_FILES = \ - @Gork/Gork.m \ - @Gork/cork.m \ - @Gork/display.m \ - @Gork/gark.m \ - @Gork/get.m \ - @Gork/set.m \ - @Gork/subsasgn.m \ - @Gork/subsref.m - -FCN_FILES += $(at_Gork_FCN_FILES)
deleted file mode 100644 --- a/test/@Pork/module.mk +++ /dev/null @@ -1,10 +0,0 @@ -at_Pork_FCN_FILES = \ - @Pork/Pork.m \ - @Pork/bling.m \ - @Pork/display.m \ - @Pork/get.m \ - @Pork/gurk.m \ - @Pork/set.m \ - @Pork/private/myStash.m - -FCN_FILES += $(at_Pork_FCN_FILES)
deleted file mode 100644 --- a/test/@Sneetch/module.mk +++ /dev/null @@ -1,5 +0,0 @@ -at_Sneetch_FCN_FILES = \ - @Sneetch/Sneetch.m \ - @Sneetch/display.m - -FCN_FILES += $(at_Sneetch_FCN_FILES)
deleted file mode 100644 --- a/test/@Snork/module.mk +++ /dev/null @@ -1,17 +0,0 @@ -at_Snork_FCN_FILES = \ - @Snork/Snork.m \ - @Snork/cack.m \ - @Snork/display.m \ - @Snork/end.m \ - @Snork/get.m \ - @Snork/getStash.m \ - @Snork/gick.m \ - @Snork/loadobj.m \ - @Snork/saveobj.m \ - @Snork/set.m \ - @Snork/subsasgn.m \ - @Snork/subsindex.m \ - @Snork/subsref.m \ - @Snork/private/myStash.m - -FCN_FILES += $(at_Snork_FCN_FILES)
deleted file mode 100644 --- a/test/@Spork/module.mk +++ /dev/null @@ -1,13 +0,0 @@ -at_Spork_FCN_FILES = \ - @Spork/Spork.m \ - @Spork/cack.m \ - @Spork/display.m \ - @Spork/geek.m \ - @Spork/get.m \ - @Spork/getStash.m \ - @Spork/loadobj.m \ - @Spork/saveobj.m \ - @Spork/set.m \ - @Spork/private/myStash.m - -FCN_FILES += $(at_Spork_FCN_FILES)
--- a/test/Makefile.am +++ b/test/Makefile.am @@ -23,7 +23,6 @@ FCN_FILES = \ fntests.m \ test_args.m \ - test_classes.m \ test_contin.m \ test_diag_perm.m \ test_error.m \ @@ -44,7 +43,6 @@ test_recursion.m \ test_return.m \ test_slice.m \ - test_string.m \ test_struct.m \ test_switch.m \ test_system.m \ @@ -53,14 +51,10 @@ test_unwind.m \ test_while.m -include @Blork/module.mk -include @Cork/module.mk -include @Dork/module.mk -include @Gork/module.mk -include @Pork/module.mk -include @Sneetch/module.mk -include @Snork/module.mk -include @Spork/module.mk +include classes/module.mk +include class-concat/module.mk +include ctor-vs-method/module.mk +include fcn-handle-derived-resolution/module.mk check: test_sparse.m test_bc_overloads.m $(top_builddir)/run-octave --norc --silent --no-history $(srcdir)/fntests.m $(srcdir)
new file mode 100644 --- /dev/null +++ b/test/class-concat/@foo/foo.m @@ -0,0 +1,3 @@ +function r = foo () + r = class (struct (), 'foo'); +endfunction
new file mode 100644 --- /dev/null +++ b/test/class-concat/module.mk @@ -0,0 +1,5 @@ +class_concat_FCN_FILES = \ + class-concat/@foo/foo.m \ + class-concat/test_class_concat.m + +FCN_FILES += $(class_concat_FCN_FILES)
new file mode 100644 --- /dev/null +++ b/test/class-concat/test_class_concat.m @@ -0,0 +1,14 @@ +%!test +%! f = foo (); +%! x = [f,f]; +%! assert (size (x), [1, 2]) +%! assert (class (x), "foo") + +%!test +%! f = foo (); +%! x = [f,f]; +%! tmp = num2cell (x); +%! assert (iscell (tmp)) +%! assert (size (tmp), [1, 2]) +%! assert (class (tmp{1}), "foo") +%! assert (class (tmp{2}), "foo")
new file mode 100644 --- /dev/null +++ b/test/classes/module.mk @@ -0,0 +1,63 @@ +classes_FCN_FILES = \ + @Blork/Blork.m \ + @Blork/bleek.m \ + @Blork/display.m \ + @Blork/get.m \ + @Blork/set.m \ + @Cork/Cork.m \ + @Cork/click.m \ + @Cork/display.m \ + @Cork/get.m \ + @Cork/set.m \ + @Dork/Dork.m \ + @Dork/bling.m \ + @Dork/display.m \ + @Dork/gack.m \ + @Dork/get.m \ + @Dork/getStash.m \ + @Dork/private/myStash.m \ + @Dork/set.m \ + @Gork/Gork.m \ + @Gork/cork.m \ + @Gork/display.m \ + @Gork/gark.m \ + @Gork/get.m \ + @Gork/set.m \ + @Gork/subsasgn.m \ + @Gork/subsref.m \ + @Pork/Pork.m \ + @Pork/bling.m \ + @Pork/display.m \ + @Pork/get.m \ + @Pork/gurk.m \ + @Pork/private/myStash.m \ + @Pork/set.m \ + @Sneetch/Sneetch.m \ + @Sneetch/display.m \ + @Snork/Snork.m \ + @Snork/cack.m \ + @Snork/display.m \ + @Snork/end.m \ + @Snork/get.m \ + @Snork/getStash.m \ + @Snork/gick.m \ + @Snork/loadobj.m \ + @Snork/private/myStash.m \ + @Snork/saveobj.m \ + @Snork/set.m \ + @Snork/subsasgn.m \ + @Snork/subsindex.m \ + @Snork/subsref.m \ + @Spork/Spork.m \ + @Spork/cack.m \ + @Spork/display.m \ + @Spork/geek.m \ + @Spork/get.m \ + @Spork/getStash.m \ + @Spork/loadobj.m \ + @Spork/private/myStash.m \ + @Spork/saveobj.m \ + @Spork/set.m \ + test_classes.m + +FCN_FILES += $(classes_FCN_FILES)
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@derived/derived.m @@ -0,0 +1,5 @@ +function r = derived (varargin) + __trace__ ('begin derived/derived'); + r = class (struct (), 'derived', parent ()); + __trace__ ('end derived/derived'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@derived/parent.m @@ -0,0 +1,9 @@ +function r = parent (a) + __trace__ ('begin derived/parent'); + if (isa (a, 'parent')) + r = parent (a.parent); + else + error ('foo'); + end + __trace__ ('end derived/parent'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@other/other.m @@ -0,0 +1,5 @@ +function r = other (varargin) + __trace__ ('begin other/other'); + r = class (struct (), 'other'); + __trace__ ('end other/other'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@other/parent.m @@ -0,0 +1,4 @@ +function r = parent (a) + __trace__ ('begin other/parent'); + __trace__ ('end other/parent'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@parent/method.m @@ -0,0 +1,5 @@ +function r = method (a) + __trace__ ('begin parent/method'); + r = parent (a); + __trace__ ('end parent/method'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/@parent/parent.m @@ -0,0 +1,15 @@ +function rot = parent (a) + __trace__ ('begin parent/parent'); + if (nargin == 0) + rot = class (struct (), 'parent'); + else + switch class (a) + case 'parent' + %% copy constructor + rot = a; + otherwise + error ('type mismatch in parent constructor') + end + end + __trace__ ('end parent/parent'); +end
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/__trace__.m @@ -0,0 +1,18 @@ +function r = __trace__ (t) + persistent history + if (isempty (history)) + history = {}; + end + if (nargin == 0) + if (nargout == 0) + history = {}; + else + r = history; + end + elseif (nargin == 1); + history = [history; t]; + else + error ('incorrect call to __trace__'); + end +end + \ No newline at end of file
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/module.mk @@ -0,0 +1,11 @@ +ctor_vs_method_FCN_FILES = \ + ctor-vs-method/@derived/derived.m \ + ctor-vs-method/@derived/parent.m \ + ctor-vs-method/@other/other.m \ + ctor-vs-method/@other/parent.m \ + ctor-vs-method/@parent/method.m \ + ctor-vs-method/@parent/parent.m \ + ctor-vs-method/__trace__.m \ + test_ctor_vs_method.m + +FCN_FILES += $(ctor_vs_method_FCN_FILES)
new file mode 100644 --- /dev/null +++ b/test/ctor-vs-method/test_ctor_vs_method.m @@ -0,0 +1,56 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +%% Test script for legacy OOP. +%% Requires the path to contain the directory ctor-vs-method. +%% +%% Note: This script and all classes are also intended to run +%% in Matlab to test compatibility. Don't break that! + +%!shared d, o +%! d = derived (); +%! o = other (); +%! +%!error method (o); + +%!test +%! ctrace = {'begin parent/method'; +%! 'begin derived/parent'; +%! 'begin parent/parent'; +%! 'end parent/parent'; +%! 'end derived/parent'; +%! 'end parent/method'}; +%! __trace__ (); %% clear call trace info +%! method (d); +%! assert (__trace__ (), ctrace); + +%!test +%! ctrace = {'begin other/parent'; +%! 'end other/parent'}; +%! __trace__ (); %% clear call trace info +%! parent (o); +%! assert (__trace__ (), ctrace); + +%!test +%! ctrace = {'begin derived/parent'; +%! 'begin parent/parent'; +%! 'end parent/parent'; +%! 'end derived/parent'}; +%! __trace__ (); %% clear call trace info +%! parent (d); +%! assert (__trace__ (), ctrace);
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@derived/derived.m @@ -0,0 +1,5 @@ +function r = derived (n) + s.a = n; + p = parent (n); + r = class (s, 'derived', p); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@other/getsize_arrayfun.m @@ -0,0 +1,3 @@ +function r = getsize_arrayfun (x) + r = arrayfun (@(i) numel (x(i).d), 1:numel(x), 'uniformoutput', true); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@other/getsize_cellfun.m @@ -0,0 +1,3 @@ +function r = getsize_cellfun (x) + r = cellfun (@numel, {x.d}); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@other/getsize_loop.m @@ -0,0 +1,7 @@ +function r = getsize_loop (x) + n = numel (x); + r = zeros (1, n); + for i = 1:n + r(i) = numel (x(i).d); + end +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@other/other.m @@ -0,0 +1,4 @@ +function r = other (n) + s.d = derived (n); + r = class (s, 'other'); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@parent/numel.m @@ -0,0 +1,3 @@ +function r = numel (x, varargin) + r = numel (x.a, varargin{:}); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/@parent/parent.m @@ -0,0 +1,4 @@ +function r = parent (n) + s.a = rand (n, 1); + r = class (s, 'parent'); +end
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/module.mk @@ -0,0 +1,11 @@ +fcn_handle_derived_resolution_FCN_FILES = \ + fcn-handle-derived-resolution/@derived/derived.m \ + fcn-handle-derived-resolution/@other/getsize_arrayfun.m \ + fcn-handle-derived-resolution/@other/getsize_cellfun.m \ + fcn-handle-derived-resolution/@other/getsize_loop.m \ + fcn-handle-derived-resolution/@other/other.m \ + fcn-handle-derived-resolution/@parent/numel.m \ + fcn-handle-derived-resolution/@parent/parent.m \ + test_fcn_handle_derived_resolution.m + +FCN_FILES += $(fcn_handle_derived_resolution_FCN_FILES)
new file mode 100644 --- /dev/null +++ b/test/fcn-handle-derived-resolution/test_fcn_handle_derived_resolution.m @@ -0,0 +1,59 @@ +## Copyright (C) 2011 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 +## <http://www.gnu.org/licenses/>. + +%% Test script for legacy OOP. +%% Requires the path to contain the directory ctor-vs-method. +%% +%% Note: This script and all classes are also intended to run +%% in Matlab to test compatibility. Don't break that! + +%!shared +%! clear -classes + +%!test +%! p = parent (7); +%! assert (numel (p), 7) + +%!test +%! d = derived (13); +%! assert (numel (d), 13) + +%!test +%! p = parent (11); +%! f = @numel; +%! assert (f (p), 11) + +%!test +%! d = parent (21); +%! f = @numel; +%! assert (f (d), 21) + +%!test +%! o(1) = other (13); +%! o(2) = other (42); +%! assert (getsize_loop (o), [13, 42]) + +%!test +%! o(1) = other (13); +%! o(2) = other (42); +%! assert (getsize_cellfun (o), [13, 42]) + +%!test +%! o(1) = other (13); +%! o(2) = other (42); +%! assert (getsize_arrayfun (o), [13, 42])
--- a/test/fntests.m +++ b/test/fntests.m @@ -91,7 +91,18 @@ if (fid >= 0) str = fread (fid, "*char")'; fclose (fid); - retval = ! isempty (regexp (str, '^%!(test|assert|error|warning)', "lineanchors")); + retval = ! isempty (regexp (str, '^%!(assert|error|fail|test|warning)', "lineanchors")); + else + error ("fopen failed: %s", f); + endif +endfunction + +function retval = has_demos (f) + fid = fopen (f); + if (fid >= 0) + str = fread (fid, "*char")'; + fclose (fid); + retval = ! isempty (regexp (str, '^%!demo', "lineanchors")); else error ("fopen failed: %s", f); endif @@ -104,24 +115,45 @@ dp = dn = dxf = dsk = 0; for i = 1:length (lst) nm = lst(i).name; - if (length (nm) > 5 && strcmp (nm(1:5), "test_") - && strcmp (nm((end-1):end), ".m")) - p = n = xf = sk = 0; - ffnm = fullfile (d, nm); - if (has_tests (ffnm)) - print_test_file_name (nm); - [p, n, xf, sk] = test (nm(1:(end-2)), "quiet", fid); - print_pass_fail (n, p); - files_with_tests(end+1) = ffnm; - else - files_with_no_tests(end+1) = ffnm; - endif + if (lst(i).isdir + && ! strcmp (nm, ".") && ! strcmp (nm, "..") + && ! strcmp (nm, "private") && nm(1) != "@" + && ! strcmp (nm, "CVS")) + [p, n, xf, sk] = run_test_dir (fid, [d, filesep, nm]); dp += p; dn += n; dxf += xf; dsk += sk; endif endfor + saved_dir = pwd (); + unwind_protect + chdir (d); + for i = 1:length (lst) + nm = lst(i).name; + if (length (nm) > 5 && strcmp (nm(1:5), "test_") + && strcmp (nm((end-1):end), ".m")) + p = n = xf = sk = 0; + ffnm = fullfile (d, nm); + if (has_tests (ffnm)) + print_test_file_name (nm); + [p, n, xf, sk] = test (nm(1:(end-2)), "quiet", fid); + print_pass_fail (n, p); + files_with_tests(end+1) = ffnm; + ##elseif (has_demos (ffnm)) + ## files_with_tests(end+1) = ffnm; + else + files_with_no_tests(end+1) = ffnm; + endif + dp += p; + dn += n; + dxf += xf; + dsk += sk; + endif + endfor + unwind_protect_cleanup + chdir (saved_dir); + end_unwind_protect endfunction function [dp, dn, dxf, dsk] = run_test_script (fid, d); @@ -135,7 +167,7 @@ nm = lst(i).name; if (lst(i).isdir && ! strcmp (nm, ".") && ! strcmp (nm, "..") && ! strcmp (nm, "CVS")) - [p, n, xf, sk] = run_test_script (fid, [d, "/", nm]); + [p, n, xf, sk] = run_test_script (fid, [d, filesep, nm]); dp += p; dn += n; dxf += xf; @@ -154,8 +186,8 @@ p = n = xf = 0; ## Only run if it contains %!test, %!assert %!error or %!warning if (has_tests (f)) - tmp = strrep (f, [topsrcdir, "/"], ""); - tmp = strrep (tmp, [topbuilddir, "/"], "../"); + tmp = strrep (f, [topsrcdir, filesep], ""); + tmp = strrep (tmp, [topbuilddir, filesep], ["..", filesep]); print_test_file_name (tmp); [p, n, xf, sk] = test (f, "quiet", fid); print_pass_fail (n, p); @@ -164,6 +196,8 @@ dxf += xf; dsk += sk; files_with_tests(end+1) = f; + ##elseif (has_demos (f)) + ## files_with_tests(end+1) = f; elseif (has_functions (f)) ## To reduce the list length, only mark .cc files that contain ## DEFUN definitions. @@ -192,16 +226,11 @@ endfunction function n = num_elts_matching_pattern (lst, pat) - n = 0; - for i = 1:length (lst) - if (! isempty (regexp (lst{i}, pat, "once"))) - n++; - endif - endfor + n = sum (cellfun (@(x) !isempty (x), regexp (lst, pat, 'once'))); endfunction function report_files_with_no_tests (with, without, typ) - pat = cstrcat ("\\", typ, "$"); + pat = cstrcat ('\', typ, "$"); n_with = num_elts_matching_pattern (with, pat); n_without = num_elts_matching_pattern (without, pat); n_tot = n_with + n_without; @@ -258,6 +287,12 @@ puts ("because the needed libraries were not present when Octave was built.\n"); endif + ## Weed out deprecated and private functions + weed_idx = cellfun (@isempty, regexp (files_with_tests, '\bdeprecated\b|\bprivate\b', 'once')); + files_with_tests = files_with_tests(weed_idx); + weed_idx = cellfun (@isempty, regexp (files_with_no_tests, '\bdeprecated\b|\bprivate\b', 'once')); + files_with_no_tests = files_with_no_tests(weed_idx); + report_files_with_no_tests (files_with_tests, files_with_no_tests, ".m"); report_files_with_no_tests (files_with_tests, files_with_no_tests, ".cc");
--- a/test/test_io.m +++ b/test/test_io.m @@ -245,6 +245,29 @@ %!assert (sscanf ('123456', '%10c'), '123456') %!assert (sscanf ('123456', '%10s'), '123456') +%!assert (sscanf (['ab'; 'cd'], '%s'), 'acbd'); + +%!test +%! [val, count, msg, pos] = sscanf ("3I2", "%f"); +%! assert (val, 3); +%! assert (count, 1); +%! assert (msg, ""); +%! assert (pos, 2); + +%!test +%! [val, count, msg, pos] = sscanf ("3In2", "%f"); +%! assert (val, 3); +%! assert (count, 1); +%! assert (msg, ""); +%! assert (pos, 2); + +%!test +%! [val, count, msg, pos] = sscanf ("3Inf2", "%f"); +%! assert (val, [3; Inf; 2]); +%! assert (count, 3); +%! assert (msg, ""); +%! assert (pos, 6); + %% test/octave.test/io/sscanf-1.m %!test %! [a, b, c] = sscanf ("1.2 3 foo", "%f%d%s", "C");
--- a/test/test_parser.m +++ b/test/test_parser.m @@ -28,142 +28,229 @@ %!assert ({1 2,{3,4}}, {1,2,{3,4}}) %!assert ({1,2,{3 4}}, {1,2,{3,4}}) -%# Tests for operator precedence as documented in section 8.8 of manual -%# There are 11 levels of precedence from "exponentiation" (highest) down to -%# "statement operators" (lowest). -%# -%# Level 11 (exponentiation) overrides all others +## Tests for operator precedence as documented in section 8.8 of manual +## There are 13 levels of precedence from "parentheses and indexing" (highest) +## down to "statement operators" (lowest). +## +## Level 13 (parentheses and indexing) +## Overrides all other levels +%!test +%! a.b = 1; +%! assert (a. b++, 1) +%! assert (a.b, 2) +%! clear a; +%! a.b = [0 1]; +%! b = 2; +%! assert (a.b', [0;1]) +%! assert (!a .b, logical ([1 0])) +%! assert (3*a .b, [0 3]) +%! assert (a. b-1, [-1 0]) +%! assert (a. b:3, 0:3) +%! assert (a. b>0.5, logical ([0 1])) +%! assert (a. b&0, logical ([0 0])) +%! assert (a. b|0, logical ([0 1])) +%! a.b = [1 2]; +%! assert (a. b&&0, false) +%! assert (a. b||0, true) +%! a.b += a. b*2; +%! assert (a.b, [3 6]) +## Level 12 (postfix increment and decrement) %!test -%! assert (-2^2, -4) -%! assert (!0^0, false); -# FIXME: This test is failing. Transpose mistakenly has higher priority. -%!# assert ([2 3].^2', [4; 9]) -%! assert (2*3^2, 18) -%! assert (2+3^2, 11) -%! assert ([1:10](1:2^2), [1 2 3 4]) -%! assert (3 > 2^2, false) -%! assert (1 & 0^0, true) -%! assert (1 && 0^0, true) +%! a = [3 5]; +%! assert (2.^a ++, [8 32]) +%! assert (a, [4 6]) +%! assert (a--', [4; 6]) +%! assert (a, [3 5]) +%! a = 0; +%! assert (!a --, true) +%! assert (-a ++, 1) +%! assert (3*a ++, 0) +%! assert (a++-2, -1) +%! assert (1:a ++, 1:2) +%! assert (4>a++, true) +%! a = [0 -1]; +%! assert ([1 1] & a++, logical ([0 1])) +%! assert ([0 0] | a++, logical ([1 0])) +%! a = 0; +%! assert (1 && a ++, false) +%! assert (0 || a --, true) +%! a = 5; b = 2; +%! b +=a ++; +%! assert (b, 7) + +## Level 11 (transpose and exponentiation) +%!test +%! assert (-2 ^2, -4) +%! assert (!0 ^0, false) +%! assert (2*3 ^2, 18) +%! assert (2+3 ^2, 11) +%! assert ([1:10](1:2 ^2), [1 2 3 4]) +%! assert (3>2 ^2, false) +%! assert (1&0 ^0, true) +%! assert (0|0 ^0, true) +%! assert (1&&0 ^0, true) +%! assert (0||0 ^0, true) %! a = 3; -%! a *= 0^0; +%! a *= 0 ^0; %! assert (a, 3) -%# Level 10 (unary plus, increment, not) +## Level 10 (unary plus/minus, prefix increment/decrement, not) %!test -# FIXME: No test for increment and transpose that I can think of. %! a = 2; -%! assert (++a*3, 9) -%! assert (a++-2, 1) -%! assert (a, 4) -%! assert ([1:10](1:++a), [1:5]) -%! assert (5 == a++, true) -%! assert (7 == ++a, true) +%! assert (++ a*3, 9) +%! assert (-- a-2, 0) +%! assert (a, 2) +%! assert (! a-2, -2) +%! assert ([1:10](++ a:5), 3:5) +%! a = [1 0]; +%! assert (! a>=[1 0], [false true]) %! a = 0; -%! assert (1 & a++, false) -%! assert (a, 1) -%! assert (1 && --a, false) +%! assert (++ a&1, true) +%! assert (-- a|0, false) +%! assert (-- a&&1, true) +%! assert (++ a||0, false) %! a = 3; -%! a *= a++; -%! assert (a, 12) -%# Level 9 (transpose) +%! a *= ++a; +%! assert (a, 16) +## Level 9 (multiply, divide) %!test -%! assert ([1 2]*[3 4]', 11) -%! assert ([1 2]'+[3 4]', [4; 6]) -%! assert (1:5', 1:5) -%! assert ([1; 2] == [1 2]', [true; true]) -%! assert ([1; 0] & [1 0]', [true; false]) -# FIXME: No test for transpose and short-circuit operator that I can think of. -%! a = [1 2]; -%! a *= [3 4]'; -%! assert (a, 11) -%# Level 8 (multiply, divide) -%!test -%! assert (3 + 4 * 5, 23) -%! assert (3 + 4 * 5, 23) -%! assert (5*1:6, [5 6]) -%! assert (3 > 1 * 5, false) -%! assert (1 & 1 * 0, false) -%! assert (1 && 1 * 0, false) +%! assert (3+4 * 5, 23) +%! assert (5 * 1:6, [5 6]) +%! assert (3>1 * 5, false) +%! assert (1&1 * 0, false) +%! assert (1|1 * 0, true) +%! assert (1&&1 * 0, false) +%! assert (1||1 * 0, true) %! a = 3; %! a /= a * 2; %! assert (a, 0.5) -%# Level 7 (add, subtract) +## Level 8 (add, subtract) %!test %! assert ([2 + 1:6], 3:6) -%! assert (3 > 1 + 5, false) -%! assert (1 & 1 - 1, false) -%! assert (1 && 1 - 1, false) +%! assert (3>1 + 5, false) +%! assert (1&1 - 1, false) +%! assert (0|1 - 2, true) +%! assert (1&&1 - 1, false) +%! assert (0||1 - 2, true) %! a = 3; %! a *= 1 + 1; %! assert (a, 6) -%# Level 6 (colon) +## Level 7 (colon) %!test -%! assert (5:-1: 3 > 4, [true false false]) -%! assert (1: 3 & 1, [true true true]) -%! assert (-1: 3 && 1, false) +%! assert (5:-1: 3>4, [true false false]) +%! assert (1: 3&1, [true true true]) +%! assert (1: 3|0, [true true true]) +%! assert (-1: 3&&1, false) +%! assert (-1: 3||0, false) %! a = [1:3]; %! a += 3 : 5; %! assert (a, [4 6 8]) -%# Level 5 (relational) +## Level 6 (relational) %!test -%! assert (0 == -1 & 0, false) -%! assert (0 == -1 && 0, false) +%! assert (0 == -1&0, false) +%! assert (1 == -1|0, false) +%! assert (0 == -1&&0, false) +%! assert (1 == -1||0, false) %! a = 2; %! a *= 3 > 1; %! assert (a, 2) -%# Level 4 (element-wise and, or) +## Level 5 (element-wise and) %!test -%! assert (0 & 1 || 1, true) -%! assert (0 == -1 && 0, false) +%! assert (0 & 1|1, true) +%! assert ([0 1] & 1&&1, false) +%! assert (0 & 1||1, true) %! a = 2; %! a *= 3 & 1; %! assert (a, 2) -%# Level 3 (logical and, or) +## Level 4 (element-wise or) %!test +%! assert ([0 1] | 1&&0, false) +%! assert ([0 1] | 1||0, true) +%! a = 2; +%! a *= 0 | 1; +%! assert (a, 2) +## Level 3 (logical and) +%!test +%! assert (0 && 1||1, true) %! a = 2; %! a *= 3 && 1; %! assert (a, 2) +## Level 2 (logical or) +%!test +%! a = 2; +%! a *= 0 || 1; +%! assert (a, 2) -%# Tests for operator precedence within each level where ordering should -%# be left to right except for exponents and assignments. -%# Level 11 (exponentiation) +## Tests for operator precedence within each level where ordering should +## be left to right except for postfix and assignment operators. + +## Level 13 (parentheses and indexing) %!test -%# FIXME : Exponentiation seems to work left to right, despite the -%# documentation and ordinary mathematical rules of precedence. -%!# assert (2^3**2, 512) -%# Level 10 (unary plus, increment, not) +%! a.b1 = 2; +%! assert (a.(strcat('b','1'))++, 2) +%! assert (a.b1, 3) +%! b = {1 2 3 4 5}; +%! assert (b{(a. b1 + 1)}, 4) +%! b = 1:5; +%! assert (b(a. b1 + 1), 4) +%! assert ([2 3].^2', [4; 9]) +## Level 12 (postfix increment and decrement) +## No tests possible since a++-- is not valid +## Level 11 (transpose and exponentiation) +## Note: Exponentiation works left to right for compatibility with Matlab. +%! assert (2^3**2, 64) +%! assert ([2 3].^2.', [4;9]) +%! assert ([2 3].'.^2, [4;9]) +%! assert (3*4i'.', 0 - 12i) +%! assert (3*4i.'.', 0 + 12i) +## Level 10 (unary plus/minus, prefix increment/decrement, not) %!test %! assert (+-+1, -1) -%! a = 0; -%# FIXME : Should we test for this corner case at all? -%# (unary minus)(auto-decrement operator) -%!# assert (---a, 1); %! a = -1; %! assert (!++a, true) %! assert (a, 0) %! assert (-~a, -1) -%! assert (!~a++, false) -%! assert (a, 1) -%# Level 9 (transpose) +%! assert (!~--a, true) +%! assert (a, -1) +## Level 9 (multiply, divide) %!test -%! assert (3*4i'.', 0 - 12i) -%! assert (3*4i.'.', 0 + 12i) -%# Level 8 (multiply, divide) +%! assert (3 * 4 / 5, 2.4) +%! assert (3 ./ 4 .* 5, 3.75) +%! assert (2 * 4 \ 6, 0.75) +%! assert (2 .\ 4 .* 6, 12) +## Level 8 (add, subtract) %!test -%!assert (3 * 4 / 5, 2.4) -%!assert (3 ./ 4 .* 5, 3.75) -%# Level 7 (add, subtract) -%!test -%!assert (-3 - 4 + 1 + 3 * 2, 0) -%# Level 5 (relational) +%! assert (-3 - 4 + 1 + 3 * 2, 0) +## Level 7 (colon) +## No tests possible because colon operator can't be combined with second colon operator +## Level 6 (relational) %!test %! assert (0 < 1 <= 0.5 == 0 >= 0.5 > 0, true) %! assert (1 < 1 == 0 != 0, true) %! assert (1 < 1 == 0 ~= 0, true) -%# Level 4 (element-wise and, or) +## Level 5 (element-wise and) +## No tests possible. Only one operator (&) at this precedence level and operation is associative. +## Level 4 (element-wise or) +## No tests possible. Only one operator (|) at this precedence level and operation is associative. +## Level 3 (logical and) %!test -%! assert ([ 1 0] & [0 1] | [1 0], [true false]) -%# Level 2 (assignment) +%! a = 1; +%! assert (1 && 0 && ++a, false) +%! assert (a, 1) +## Level 2 (logical or) +%!test +%! a = 1; +%! assert (0 || 1 || ++a, true) +%! assert (a, 1) +## Level 1 (assignment) %!test %! a = 2; b = 5; c = 7; %! assert (a += b *= c += 1, 42) %! assert (b == 40 && c == 8) + +%!test +%! af_in_cell = {@(x) [1 2]}; +%! assert (af_in_cell{1}(), [1, 2]); + +%!test +%! R = @(rot) [cos(rot) -sin(rot); sin(rot) cos(rot)]; +%! assert (R(pi/2), [cos(pi/2), -sin(pi/2); sin(pi/2),cos(pi/2)]);
deleted file mode 100644 --- a/test/test_string.m +++ /dev/null @@ -1,454 +0,0 @@ -## Copyright (C) 2006-2011 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 -## <http://www.gnu.org/licenses/>. - -%% test/octave.test/string/str-esc-1.m -%!test -%! x = 7; -%! if (strcmp ("\a", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-2.m -%!test -%! x = 8; -%! if (strcmp ("\b", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-3.m -%!test -%! x = 12; -%! if (strcmp ("\f", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-4.m -%!test -%! x = 10; -%! if (strcmp ("\n", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-5.m -%!test -%! x = 13; -%! if (strcmp ("\r", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-6.m -%!test -%! x = 9; -%! if (strcmp ("\t", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-7.m -%!test -%! x = 11; -%! if (strcmp ("\v", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-8.m -%!test -%! x = 92; -%! if (strcmp ("\\", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-9.m -%!test -%! x = 39; -%! if (strcmp ("\'", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-10.m -%!test -%! x = 34; -%! if (strcmp ("\"", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% test/octave.test/string/str-esc-11.m -%!test -%! x = 120; -%! fail('strcmp ("\x", setstr (x))',"warning",".*unrecognized escape sequence.*"); - -%% test/octave.test/string/str-esc-12.m -%!test -%! x = [7, 8, 12, 10, 13, 9, 11, 92, 39, 34]; -%! if (strcmp ("\a\b\f\n\r\t\v\\\'\"", setstr (x))) -%! printf_assert ("ok\n"); -%! endif -%! assert(prog_output_assert("ok")); - -%% FIXME -%% Why do the next two tests fail? -%% test/octave.test/string/string_fill_char-1.m -%!#test -%! sfc = string_fill_char; -%! string_fill_char = "X"; -%! str = ["these"; "are"; "strings"]; -%! assert(str,["theseXX"; "areXXXX"; "strings"]); -%! string_fill_char = sfc; - -%% test/octave.test/string/string_fill_char-2.m -%!#test -%! sfc = string_fill_char; -%! string_fill_char = " "; -%! str = ["these"; "are"; "strings"]; -%! assert(str,["these "; "are "; "strings"]); -%! string_fill_char = sfc; - -%% test/octave.test/string/ischar-1.m -%!assert(!(ischar (1))); - -%% test/octave.test/string/ischar-2.m -%!assert(!(ischar ([1, 2]))); - -%% test/octave.test/string/ischar-3.m -%!assert(!(ischar ([]))); - -%% test/octave.test/string/ischar-4.m -%!assert(!(ischar ([1, 2; 3, 4]))); - -%% test/octave.test/string/ischar-5.m -%!assert(ischar ("")); - -%% test/octave.test/string/ischar-6.m -%!assert(ischar ("t")); - -%% test/octave.test/string/ischar-7.m -%!assert(ischar ("test")); - -%% test/octave.test/string/ischar-8.m -%!assert(ischar (["test"; "ing"])); - -%% test/octave.test/string/ischar-9.m -%!test -%! s.a = "test"; -%! assert(!(ischar (s))); - -%% test/octave.test/string/ischar-10.m -%!error <Invalid call to ischar.*> ischar (); - -%% test/octave.test/string/ischar-11.m -%!error <Invalid call to ischar.*> ischar ("test", 1); - - -%% test/octave.test/string/char-1.m -%!assert(strcmp (char ([65, 83, 67, 73, 73]), "ASCII")); - -%% test/octave.test/string/char-2.m -%!error <Invalid call to char.*> char (); - -%% test/octave.test/string/char-3.m -%!test -%! x = char ("foo", "bar", "foobar"); -%! assert((strcmp (x(1,:), "foo ") -%! && strcmp (x(2,:), "bar ") -%! && strcmp (x(3,:), "foobar"))); - - -%% test/octave.test/string/strcmp-1.m -%!assert(strcmp ("foobar", "foobar") && strcmp ("fooba", "foobar") == 0); - -%% test/octave.test/string/strcmp-2.m -%!error <Invalid call to strcmp.*> strcmp (); - -%% test/octave.test/string/strcmp-3.m -%!error <Invalid call to strcmp.*> strcmp ("foo", "bar", 3); - - - -%% test/octave.test/string/undo_string_escapes-1.m -%!assert(strcmp (undo_string_escapes ("abc\a\b\n\r\t\v\f123"), -%! "abc\\a\\b\\n\\r\\t\\v\\f123")); - -%% test/octave.test/string/undo_string_escapes-2.m -%!error <Invalid call to undo_string_escapes.*> undo_string_escapes (); - -%% test/octave.test/string/undo_string_escapes-3.m -%!error <Invalid call to undo_string_escapes.*> undo_string_escapes ("string", 2); - -%% test/octave.test/string/toascii-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = 0:127; -%! -%! assert(all (toascii (charset) == result)); - -%% test/octave.test/string/toascii-3.m -%!error toascii (1, 2); - -%% test/octave.test/string/toascii-3.m -%!error toascii (1, 2); - -%% test/octave.test/string/tolower-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = charset; -%! -%! result ((toascii("A"):toascii("Z"))+1) \ -%! = result ((toascii("a"):toascii("z"))+1); -%! -%! assert(all (tolower (charset) == result)); - -%% test/octave.test/string/tolower-3.m -%!error tolower (1, 2); - -%% test/octave.test/string/tolower-3.m -%!error tolower (1, 2); - -%% test/octave.test/string/toupper-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = charset; -%! -%! result ((toascii("a"):toascii("z"))+1) \ -%! = result ((toascii("A"):toascii("Z"))+1); -%! -%! assert(all (toupper (charset) == result)); - -%% test/octave.test/string/toupper-3.m -%!error toupper (1, 2); - -%% test/octave.test/string/toupper-3.m -%!error toupper (1, 2); - -%% test/octave.test/string/isalnum-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("A"):toascii("Z"))+1) = 1; -%! result ((toascii("0"):toascii("9"))+1) = 1; -%! result ((toascii("a"):toascii("z"))+1) = 1; -%! -%! assert(all (isalnum (charset) == result)); - -%% test/octave.test/string/isalnum-2.m -%!error isalnum (1, 2); - -%% test/octave.test/string/isalnum-3.m -%!error isalnum (); - -%% test/octave.test/string/isalpha-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("A"):toascii("Z"))+1) = 1; -%! result ((toascii("a"):toascii("z"))+1) = 1; -%! -%! assert(all (isalpha (charset) == result)); - -%% test/octave.test/string/isalpha-2.m -%!error isalpha (1, 2); - -%% test/octave.test/string/isalpha-3.m -%!error isalpha (); - -%% test/octave.test/string/isascii-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = ones (1, 128); -%! -%! assert(all (isascii (charset) == result)); - -%% test/octave.test/string/isascii-2.m -%!error isascii (1, 2); - -%% test/octave.test/string/isascii-3.m -%!error isascii (); - -%% test/octave.test/string/iscntrl-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (1:32) = 1; -%! result (128) = 1; -%! -%! assert(all (iscntrl (charset) == result)); - -%% test/octave.test/string/iscntrl-2.m -%!error iscntrl (1, 2); - -%% test/octave.test/string/iscntrl-3.m -%!error iscntrl (); - -%% test/octave.test/string/isdigit-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("0"):toascii("9"))+1) = 1; -%! -%! assert(all (isdigit (charset) == result)); - -%% test/octave.test/string/isdigit-2.m -%!error isdigit (1, 2); - -%% test/octave.test/string/isdigit-3.m -%!error isdigit (); - -%% test/octave.test/string/isgraph-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (34:127) = 1; -%! -%! assert(all (isgraph (charset) == result)); - -%% test/octave.test/string/isgraph-2.m -%!error isgraph (1, 2); - -%% test/octave.test/string/isgraph-3.m -%!error isgraph (); - -%% test/octave.test/string/islower-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("a"):toascii("z"))+1) = 1; -%! -%! assert(all (islower (charset) == result)); - -%% test/octave.test/string/islower-2.m -%!error islower (1, 2); - -%% test/octave.test/string/islower-3.m -%!error islower (); - -%% test/octave.test/string/isprint-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (33:127) = 1; -%! if (ispc () && ! isunix ()) -%! result(10) = 1; -%! endif -%! -%! assert(all (isprint (charset) == result)); - -%% test/octave.test/string/isprint-2.m -%!error isprint (1, 2); - -%% test/octave.test/string/isprint-3.m -%!error isprint (); - -%% test/octave.test/string/ispunct-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (34:48) = 1; -%! result (59:65) = 1; -%! result (92:97) = 1; -%! result (124:127) = 1; -%! -%! assert(all (ispunct (charset) == result)); - -%% test/octave.test/string/ispunct-2.m -%!error ispunct (1, 2); - -%% test/octave.test/string/ispunct-3.m -%!error ispunct (); - -%% test/octave.test/string/isspace-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result (toascii (" \f\n\r\t\v")+1) = 1; -%! -%! assert(all (isspace (charset) == result)); - -%% test/octave.test/string/isspace-2.m -%!error isspace (1, 2); - -%% test/octave.test/string/isspace-3.m -%!error isspace (); - -%% test/octave.test/string/isupper-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("A"):toascii("Z"))+1) = 1; -%! -%! assert(all (isupper (charset) == result)); - -%% test/octave.test/string/isupper-2.m -%!error isupper (1, 2); - -%% test/octave.test/string/isupper-3.m -%!error isupper (); - -%% test/octave.test/string/isxdigit-1.m -%!test -%! charset = setstr (0:127); -%! -%! result = zeros (1, 128); -%! -%! result ((toascii("A"):toascii("F"))+1) = 1; -%! result ((toascii("0"):toascii("9"))+1) = 1; -%! result ((toascii("a"):toascii("f"))+1) = 1; -%! -%! assert(all (isxdigit (charset) == result)); - -%% test/octave.test/string/isxdigit-2.m -%!error isxdigit (1, 2); - -%% test/octave.test/string/isxdigit-3.m -%!error isxdigit (); - -%% test concatenation with all zero matrices -%!assert([ '' 65*ones(1,10) ], 'AAAAAAAAAA'); -%!assert([ 65*ones(1,10) '' ], 'AAAAAAAAAA'); -