Mercurial > octave-nkf
changeset 13686:3f3aa11aca41
Merge with dev
| author | Jordi Gutiérrez Hermoso <jordigh@octave.org> |
|---|---|
| date | Tue, 11 Oct 2011 14:08:38 -0500 |
| parents | 8a688c3179dd (current diff) ad9b78544a22 (diff) |
| children | 59fd35807941 abf9741be661 |
| files | configure.ac scripts/general/arrayfun.m scripts/plot/__gnuplot_drawnow__.m test/@Blork/Blork.m test/@Blork/bleek.m test/@Blork/display.m test/@Blork/get.m test/@Blork/module.mk test/@Blork/set.m test/@Cork/Cork.m test/@Cork/click.m test/@Cork/display.m test/@Cork/get.m test/@Cork/module.mk test/@Cork/set.m test/@Dork/Dork.m test/@Dork/bling.m test/@Dork/display.m test/@Dork/gack.m test/@Dork/get.m test/@Dork/getStash.m test/@Dork/module.mk test/@Dork/private/myStash.m test/@Dork/set.m test/@Gork/Gork.m test/@Gork/cork.m test/@Gork/display.m test/@Gork/gark.m test/@Gork/get.m test/@Gork/module.mk test/@Gork/set.m test/@Gork/subsasgn.m test/@Gork/subsref.m test/@Pork/Pork.m test/@Pork/bling.m test/@Pork/display.m test/@Pork/get.m test/@Pork/gurk.m test/@Pork/module.mk test/@Pork/private/myStash.m test/@Pork/set.m test/@Sneetch/Sneetch.m test/@Sneetch/display.m test/@Sneetch/module.mk test/@Snork/Snork.m test/@Snork/cack.m test/@Snork/display.m test/@Snork/end.m test/@Snork/get.m test/@Snork/getStash.m test/@Snork/gick.m test/@Snork/loadobj.m test/@Snork/module.mk test/@Snork/private/myStash.m test/@Snork/saveobj.m test/@Snork/set.m test/@Snork/subsasgn.m test/@Snork/subsindex.m test/@Snork/subsref.m test/@Spork/Spork.m test/@Spork/cack.m test/@Spork/display.m test/@Spork/geek.m test/@Spork/get.m test/@Spork/getStash.m test/@Spork/loadobj.m test/@Spork/module.mk test/@Spork/private/myStash.m test/@Spork/saveobj.m test/@Spork/set.m test/test_classes.m test/test_string.m |
| diffstat | 548 files changed, 15515 insertions(+), 8106 deletions(-) [+] |
line wrap: on
line diff
--- a/NEWS Wed Oct 05 02:19:28 2011 +0200 +++ b/NEWS Tue Oct 11 14:08:38 2011 -0500 @@ -4,8 +4,27 @@ ** 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. + 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. @@ -20,20 +39,22 @@ ** Certain string functions have been modified for greater Matlab compatibility and for 15X greater performance when operating on cell array of strings. - deblank : Now requires character or cellstr input - strtrim : Now requires character or cellstr input. + 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. - - ** New functions added. + + ** Matlab-compatible preference functions: + + addpref getpref ispref rmpref setpref - iscolumn - issrow - zscore - profile - profshow + ** Other miscellaneous new functions: + + iscolumn + issrow + zscore ** Deprecated functions. @@ -62,10 +83,15 @@ __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: ----------------------------------------------------------- - ** Octave 3.2.4 fixes some minor installation problems that affected + ** Octave 3.4.2 fixes some minor installation problems that affected version 3.4.1. Summary of important user-visible changes for version 3.4.1:
--- a/build-aux/bootstrap Wed Oct 05 02:19:28 2011 +0200 +++ b/build-aux/bootstrap Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/build-aux/bootstrap.conf Tue Oct 11 14:08:38 2011 -0500 @@ -20,6 +20,7 @@ gnulib_modules=" c-strcase copysign + closedir crypto/md5 fclose fcntl @@ -42,6 +43,7 @@ mktime nanosleep nproc + opendir pathmax progname readlink
--- a/configure.ac Wed Oct 05 02:19:28 2011 +0200 +++ b/configure.ac Tue Oct 11 14:08:38 2011 -0500 @@ -31,7 +31,7 @@ dnl PACKAGE_VERSION is set by the AC_INIT VERSION arg OCTAVE_VERSION="$PACKAGE_VERSION" -OCTAVE_API_VERSION_NUMBER="44" +OCTAVE_API_VERSION_NUMBER="45" OCTAVE_API_VERSION="api-v$OCTAVE_API_VERSION_NUMBER+" OCTAVE_RELEASE_DATE="2011-01-22" OCTAVE_COPYRIGHT="Copyright (C) 2011 John W. Eaton and others." @@ -2183,7 +2183,7 @@ OCTAVE_CXX_FLAG(-rdynamic, [RDYNAMIC_FLAG=-rdynamic]) ;; shl_load) - shl_load_api=truenn + shl_load_api=true DL_API_MSG="(shl_load)" AC_DEFINE(HAVE_SHL_LOAD_API, 1, [Define if your system has shl_load and shl_findsym for dynamic linking]) ;;
--- a/doc/interpreter/contrib.txi Wed Oct 05 02:19:28 2011 +0200 +++ b/doc/interpreter/contrib.txi Tue Oct 11 14:08:38 2011 -0500 @@ -6,12 +6,12 @@ @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 @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 @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/>. @@ -23,7 +23,7 @@ This chapter is dedicated to those who wish to contribute code to Octave. -@menu +@menu * How to Contribute:: * General Guidelines:: * Octave Sources (m-files):: @@ -56,7 +56,7 @@ @example @group hg clone http://www.octave.org/hg/octave - # make a local copy of the octave + # make a local copy of the octave # source repository cd octave # change some sources@dots{} @@ -71,13 +71,13 @@ @end example You may want to get familiar with Mercurial queues to manage your -changesets. Here is a slightly more complex example using Mercurial +changesets. Here is a slightly more complex example using Mercurial queues, where work on two unrelated changesets is done in parallel and -one of the changesets is updated after discussion on the maintainers mailing -list: +one of the changesets is updated after discussion on the maintainers +mailing list: @example -hg qnew nasty_bug # create a new patch +hg qnew nasty_bug # create a new patch # change sources@dots{} hg qref # save the changes into the patch # change even more@dots{} @@ -89,7 +89,7 @@ hg qpop # undo the application of the patch # and remove the changes from the # source tree -hg qnew doc_improvements # create an unrelated patch +hg qnew doc_improvements # create an unrelated patch # change doc sources@dots{} hg qref -m "could not find myfav.m in the doc" # save the changes into the patch @@ -122,7 +122,7 @@ ## 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 +## either version 3 of the License, or (at your option) any ## later version. ## ## Octave is distributed in the hope that it will be useful, @@ -136,40 +136,50 @@ ## see <http://www.gnu.org/licenses/>. @end example -Always include ChangeLog entries in changesets. After making your -source changes, record and briefly describe the changes in the nearest -ChangeLog file upwards in the directory tree. Use the previous entries -as a template. Your entry should contain your name and email, and the -path to the modified source file relative to the parent directory of the -ChangeLog file. If there are more functions in the file, you should -also include the name of the modified function (in parentheses after -file path). Example: +Always include commit messages in changesets. After making your source +changes, record and briefly describe the changes in your commit message. +You should have previously configured your @file{.hgrc} (or +@file{Mercurial.ini} on Windows) with your name and email, which will +get automatically added to your commit message. Your commit message +should have a brief one-line explanation of what the commit does. If you +are patching a bug, this one-line explanation should mention the bug +number at the end. If your change is small and only touches one file, +this is typically sufficient. If you are modifying several files or +several parts of one file, you should enumerate your changes roughly +following the GNU coding standards on changelogs, like the following +example: @example @group -2010-04-13 David Bateman <dbateman@@free.fr> +look for methods before constructors - * DLD-FUNCTIONS/regexp.cc (octregexp_list): Handle repeated matches - in the list of matches returned by pcre. +* symtab.cc (symbol_table::fcn_info::fcn_info_rep::find): +Look for class methods before constructors, contrary to Matlab +documentation. + +* test/ctor-vs-method: New directory of test classes. +* test/test_ctor_vs_method.m: New file. +* test/Makefile.am: Include ctor-vs-method/module.mk. +(FCN_FILES): Include test_ctor_vs_method.m in the list. @end group @end example @noindent -The ChangeLog entries should describe what is changed, not why. Any -explanation of why a change is needed should appear as comments in the -code, particularly if there is something that might not be obvious to -someone reading it later. +In this example, the names of files is mentioned, and in parentheses the +name of the function in that file that was modified. There is no need to +mention the function for m-files that only contain one function. The +commit message should describe what is changed, not why. Any explanation +of why a change is needed should appear as comments in the code, +particularly if there is something that might not be obvious to someone +reading it later. -When submitting code which addresses a known bug on the Octave bug tracker -(@url{http://bugs.octave.org}), please add '(bug #XXXXX)' to the ChangeLog -and Mercurial commit messages. Example: +When submitting code which addresses a known bug on the Octave bug +tracker (@url{http://bugs.octave.org}), please add '(bug #XXXXX)' to the +first line of the commit messages. For example: @example @group -2011-03-29 Michael Creel <michael.creel@@uab.es> - - * statistics/base/ols.m: Fix erroneous degrees of freedom when - computing the covariance estimator (bug #32892). +Fix bug for complex input for gradient (bug #34292). @end group @end example @@ -208,7 +218,7 @@ @end example @noindent -but +but @example A([1:i-1;i+1:n], XI(:,2:n-1)) @@ -223,7 +233,7 @@ @code{endswitch}) rather than generic @code{end}. Enclose the @code{if}, @code{while}, @code{until} and @code{switch} -conditions in parentheses, like in C: +conditions in parentheses, like in C: @example @group @@ -267,7 +277,7 @@ for both function definitions and function calls. Recommended indent is 2 spaces. When indenting, indent the statement -after control structures (like @code{if}, @code{while}, etc.). If there +after control structures (like @code{if}, @code{while}, etc.). If there is a compound statement, indent @emph{both} the curly braces and the body of the statement (so that the body gets indented by @emph{two} indents). Example: @@ -286,7 +296,7 @@ @noindent If you have nested @code{if} statements, use extra braces for extra -clarification. +clarification. Split long expressions in such a way that a continuation line starts with an operator rather than identifier. If the split occurs inside
--- a/doc/interpreter/debug.txi Wed Oct 05 02:19:28 2011 +0200 +++ b/doc/interpreter/debug.txi Tue Oct 11 14:08:38 2011 -0500 @@ -228,6 +228,8 @@ @DOCSTRING(profshow) +@DOCSTRING(profexplore) + @node Profiler Example @section Profiler Example
--- a/doc/interpreter/sparse.txi Wed Oct 05 02:19:28 2011 +0200 +++ b/doc/interpreter/sparse.txi Tue Oct 11 14:08:38 2011 -0500 @@ -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/stmt.txi Wed Oct 05 02:19:28 2011 +0200 +++ b/doc/interpreter/stmt.txi Tue Oct 11 14:08:38 2011 -0500 @@ -580,7 +580,7 @@ @example @group -a = [1,3;2,4]; b = cat(3, a, 2*a); +a = [1,3;2,4]; c = cat(3, a, 2*a); for i = c i endfor
--- a/etc/HACKING Wed Oct 05 02:19:28 2011 +0200 +++ b/etc/HACKING Tue Oct 11 14:08:38 2011 -0500 @@ -158,7 +158,21 @@ testfun * unit testing time * time and date functions - src -- the interpreter itself + src -- the interpreter itself plus lots of infrastructure + around it. Octave's extensive octave_value class + hierarchy for polymorphically handling all Octave + types is defined here. The built-in functions are + also defined here, so if "help foo" tells you foo is + built-in, its source will be somewhere in this + directory. + DLD-FUNCTIONS * Dynamically linked oct files. If you see "help foo" + telling you that foo is defined in foo.oct, then + foo.cc will be found here and contain the source + code. + OPERATORS * Definitions and template instantiations for + operators for all possible Octave type + combinations. + TEMPLATE-INST * Some C++ template instantiations. test -- tests for the interpreter test_*.m * fixed tests for the interpreter @@ -170,7 +184,8 @@ jwe@octave.org -Last updated: Sat Jan 22 22:00:25 PST 2011 +Last updated: Wed Sep 28 22:37:37 CDT 2011 + ################################################################################
--- a/libcruft/Makefile.am Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/Makefile.am Tue Oct 11 14:08:38 2011 -0500 @@ -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/>.
--- a/libcruft/blas-xtra/cdotc3.f Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/blas-xtra/cdotc3.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/blas-xtra/cmatm3.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/blas-xtra/ddot3.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/blas-xtra/dmatm3.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/blas-xtra/sdot3.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/blas-xtra/smatm3.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/blas-xtra/zdotc3.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/blas-xtra/zmatm3.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/lapack-xtra/crsf2csf.f Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/libcruft/lapack-xtra/zrsf2csf.f Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/liboctave/Array.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/Array.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/DASPK-opts.in Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/DASPK-opts.in Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/DASRT-opts.in Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/DASSL-opts.in Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/LSODE-opts.in Tue Oct 11 14:08:38 2011 -0500 @@ -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/MArray.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/MArray.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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; }
--- a/liboctave/MSparse.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/MSparse.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/Makefile.am Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/Makefile.am Tue Oct 11 14:08:38 2011 -0500 @@ -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/>.
--- a/liboctave/Quad-opts.in Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/Quad-opts.in Tue Oct 11 14:08:38 2011 -0500 @@ -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-perm-op-defs.h Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/Sparse-perm-op-defs.h Tue Oct 11 14:08:38 2011 -0500 @@ -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/base-lu.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/base-lu.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/base-qr.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/boolNDArray.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/bsxfun-defs.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/bsxfun-defs.cc Tue Oct 11 14:08:38 2011 -0500 @@ -134,6 +134,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, 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)
--- a/liboctave/bsxfun.h Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/bsxfun.h Tue Oct 11 14:08:38 2011 -0500 @@ -33,7 +33,31 @@ { for (int i = 0; i < std::min (dx.length (), dy.length ()); i++) { - if ( dx(i) > 1 && dy(i) > 1 && dx(i) != dy(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;
--- a/liboctave/mx-inlines.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/mx-inlines.cc Tue Oct 11 14:08:38 2011 -0500 @@ -169,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, |=) @@ -391,11 +394,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/oct-mutex.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/oct-mutex.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/oct-mutex.h Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/oct-sort.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/randgamma.h Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/randgamma.h Tue Oct 11 14:08:38 2011 -0500 @@ -29,8 +29,8 @@ extern "C" { #endif -extern double oct_randg (double a); -extern void oct_fill_randg (double a, octave_idx_type n, double *p); +extern OCTAVE_API double oct_randg (double a); +extern OCTAVE_API void oct_fill_randg (double a, octave_idx_type n, double *p); #ifdef __cplusplus }
--- a/liboctave/randmtzig.h Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/randmtzig.h Tue Oct 11 14:08:38 2011 -0500 @@ -71,21 +71,21 @@ #endif /* === Mersenne Twister === */ -extern void oct_init_by_int (uint32_t s); -extern void oct_init_by_array (uint32_t init_key[], int key_length); -extern void oct_init_by_entropy (void); -extern void oct_set_state (uint32_t save[]); -extern void oct_get_state (uint32_t save[]); +extern OCTAVE_API void oct_init_by_int (uint32_t s); +extern OCTAVE_API void oct_init_by_array (uint32_t init_key[], int key_length); +extern OCTAVE_API void oct_init_by_entropy (void); +extern OCTAVE_API void oct_set_state (uint32_t save[]); +extern OCTAVE_API void oct_get_state (uint32_t save[]); /* === Array generators === */ -extern double oct_randu (void); -extern double oct_randn (void); -extern double oct_rande (void); +extern OCTAVE_API double oct_randu (void); +extern OCTAVE_API double oct_randn (void); +extern OCTAVE_API double oct_rande (void); /* === Array generators === */ -extern void oct_fill_randu (octave_idx_type n, double *p); -extern void oct_fill_randn (octave_idx_type n, double *p); -extern void oct_fill_rande (octave_idx_type n, double *p); +extern OCTAVE_API void oct_fill_randu (octave_idx_type n, double *p); +extern OCTAVE_API void oct_fill_randn (octave_idx_type n, double *p); +extern OCTAVE_API void oct_fill_rande (octave_idx_type n, double *p); #ifdef __cplusplus }
--- a/liboctave/randpoisson.h Wed Oct 05 02:19:28 2011 +0200 +++ b/liboctave/randpoisson.h Tue Oct 11 14:08:38 2011 -0500 @@ -29,8 +29,8 @@ extern "C" { #endif -extern double oct_randp (double L); -extern void oct_fill_randp (double L, octave_idx_type n, double *p); +extern OCTAVE_API double oct_randp (double L); +extern OCTAVE_API void oct_fill_randp (double L, octave_idx_type n, double *p); #ifdef __cplusplus }
--- a/run-octave.in Wed Oct 05 02:19:28 2011 +0200 +++ b/run-octave.in Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/Makefile.am Tue Oct 11 14:08:38 2011 -0500 @@ -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/deprecated/glpkmex.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/deprecated/glpkmex.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 ();
--- a/scripts/elfun/cosd.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/elfun/cosd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/sind.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/elfun/sind.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/elfun/tand.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/accumarray.m Tue Oct 11 14:08:38 2011 -0500 @@ -19,50 +19,78 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {} accumarray (@var{subs}, @var{vals}, @var{sz}, @var{func}, @var{fillval}, @var{issparse}) -## @deftypefnx {Function File} {} accumarray (@var{csubs}, @var{vals}, @dots{}) +## @deftypefnx {Function File} {} accumarray (@var{subs}, @var{vals}, @dots{}) ## ## Create an array by accumulating the elements of a vector into the ## positions defined by their subscripts. The subscripts are defined by -## the rows of the matrix @var{subs} and the values by @var{vals}. Each row -## of @var{subs} corresponds to one of the values in @var{vals}. +## the rows of the matrix @var{subs} and the values by @var{vals}. Each +## row of @var{subs} corresponds to one of the values in @var{vals}. If +## @var{vals} is a scalar, it will be used for each of the row of +## @var{subs}. ## -## 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}. +## 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}. ## -## The default action of @code{accumarray} is to sum the elements with the -## same subscripts. This behavior can be modified by defining the @var{func} -## function. This should be a function or function handle that accepts a -## column vector and returns a scalar. The result of the function should not -## depend on the order of the subscripts. +## The default action of @code{accumarray} is to sum the elements with +## the same subscripts. This behavior can be modified by defining the +## @var{func} function. This should be a function or function handle +## that accepts a column vector and returns a scalar. The result of the +## 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. ## -## 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. +## By default @code{accumarray} returns a full matrix. If +## @var{issparse} is logically true, then a sparse matrix is returned +## instead. ## -## By default @code{accumarray} returns a full matrix. If @var{issparse} is -## logically true, then a sparse matrix is returned instead. -## -## An example of the use of @code{accumarray} is: +## The following @code{accumarray} example constructs a frequency table +## that in the first column counts how many occurrences each number in +## the second column has, taken from the vector @var{x}. Note the usage +## of @code{unique} for assigning to all repeated elements of @var{x} +## the same index (@pxref{doc-unique}). ## ## @example ## @group -## accumarray ([1,1,1;2,1,2;2,3,2;2,1,2;2,3,2], 101:105) +## x = [91, 92, 90, 92, 90, 89, 91, 89, 90, 100, 100, 100]; +## [u, ~, j] = unique (x); +## [accumarray(j', 1), u'] +## @result{} 2 89 +## 3 90 +## 2 91 +## 2 92 +## 3 100 +## @end group +## @end example +## +## Another example, where the result is a multidimensional 3D array and +## the default value (zero) appears in the output: +## +## @example +## @group +## accumarray ([1, 1, 1; +## 2, 1, 2; +## 2, 3, 2; +## 2, 1, 2; +## 2, 3, 2], 101:105) ## @result{} ans(:,:,1) = [101, 0, 0; 0, 0, 0] ## ans(:,:,2) = [0, 0, 0; 206, 0, 208] ## @end group ## @end example ## -## The complexity in the non-sparse case is generally O(M+N), where N is the -## number of -## subscripts and M is the maximum subscript (linearized in multi-dimensional -## case). -## If @var{func} is one of @code{@@sum} (default), @code{@@max}, @code{@@min} -## or @code{@@(x) @{x@}}, an optimized code path is used. -## Note that for general reduction function the interpreter overhead can play a -## major part and it may be more efficient to do multiple accumarray calls and -## compute the results in a vectorized manner. -## @seealso{accumdim} +## The complexity in the non-sparse case is generally O(M+N), where N is +## the number of subscripts and M is the maximum subscript (linearized +## in multi-dimensional case). If @var{func} is one of @code{@@sum} +## (default), @code{@@max}, @code{@@min} or @code{@@(x) @{x@}}, an +## optimized code path is used. Note that for general reduction function +## the interpreter overhead can play a major part and it may be more +## efficient to do multiple accumarray calls and compute the results in +## a vectorized manner. +## +## @seealso{accumdim, unique} ## @end deftypefn function A = accumarray (subs, vals, sz = [], func = [], fillval = [], issparse = [])
--- a/scripts/general/arrayfun.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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/blkdiag.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/blkdiag.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 @@ -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/circshift.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/circshift.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/gradient.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/gradient.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/interp1.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/interp1.m Tue Oct 11 14:08:38 2011 -0500 @@ -151,7 +151,7 @@ if (isvector (y)) y = y(:); endif - + szy = size (y); y = y(:,:); [ny, nc] = size (y); @@ -192,7 +192,7 @@ case "nearest" 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 @@ -208,7 +208,7 @@ endif case "linear" dy = diff (y); - dx = diff (x); + dx = diff (x); dx = repmat (dx, [1 size(dy)(2:end)]); coefs = [(dy./dx).'(:), y(1:nx-1, :).'(:)]; xx = x; @@ -244,7 +244,7 @@ if (nx == 2 || starmethod) x = linspace (x(1), x(nx), ny); endif - + if (ispp) y = shiftdim (reshape (y, szy), 1); yi = pchip (x, y); @@ -256,7 +256,7 @@ if (nx == 2 || starmethod) x = linspace(x(1), x(nx), ny); endif - + if (ispp) y = shiftdim (reshape (y, szy), 1); yi = spline (x, y);
--- a/scripts/general/interp2.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/interp2.m Tue Oct 11 14:08:38 2011 -0500 @@ -101,9 +101,11 @@ switch (nargin) case 1 Z = varargin{1}; + n = 1; case 2 if (ischar (varargin{2})) [Z, method] = deal (varargin{:}); + n = 1; else [Z, n] = deal (varargin{:}); endif @@ -159,6 +161,7 @@ error ("interp2: X, Y must be numeric matrices"); endif if (! isempty (n)) + ## Calculate the interleaved input vectors. p = 2^n; XI = (p:p*zc)/p; YI = (p:p*zr)'/p; @@ -337,17 +340,16 @@ endif ## Check dimensions of XI and YI - if (isvector (XI) && isvector (YI)) + if (isvector (XI) && isvector (YI) && ! size_equal (XI, YI)) XI = XI(:).'; YI = YI(:); + [XI, YI] = meshgrid (XI, YI); elseif (! size_equal (XI, YI)) error ("interp2: XI and YI must be matrices of equal size"); endif - ## FIXME bicubic/__splinen__ don't handle arbitrary XI, YI. if (strcmp (method, "cubic")) - ## Please remove the dummy zero when bicubic is fixed. - if (0 && isgriddata (XI) && isgriddata (YI')) + if (isgriddata (XI) && isgriddata (YI')) ZI = bicubic (X, Y, Z, XI (1, :), YI (:, 1), extrapval); elseif (isgriddata (X) && isgriddata (Y')) ## Allocate output @@ -589,3 +591,20 @@ %! X = meshgrid (1:4); %! assert (interp2 (X, 2.5, 2.5, 'nearest'), 3); +%!shared z, zout, tol +%! z = [1 3 5; 3 5 7; 5 7 9]; +%! zout = [1 2 3 4 5; 2 3 4 5 6; 3 4 5 6 7; 4 5 6 7 8; 5 6 7 8 9]; +%! tol = 2 * eps; +%!assert (interp2 (z), zout, tol); +%!assert (interp2 (z, "linear"), zout, tol); +%!assert (interp2 (z, "pchip"), zout, tol); +%!assert (interp2 (z, "cubic"), zout, 10 * tol); +%!assert (interp2 (z, "spline"), zout, tol); +%!assert (interp2 (z, [2 3 1], [2 2 2]', "linear"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "pchip"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "cubic"), repmat ([5, 7, 3], [3, 1]), 10 * tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "spline"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2], "linear"), [5 7 3], tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "pchip"), [5 7 3], tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "cubic"), [5 7 3], 10 * tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "spline"), [5 7 3], tol);
--- a/scripts/general/interp3.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/interp3.m Tue Oct 11 14:08:38 2011 -0500 @@ -69,14 +69,14 @@ extrapval = NA; nargs = nargin; - if (nargin < 1) + if (nargin < 1 || ! isnumeric (varargin{1})) print_usage (); endif if (ischar (varargin{end})) method = varargin{end}; nargs = nargs - 1; - elseif (ischar (varargin{end-1})) + elseif (nargs > 1 && ischar (varargin{end - 1})) if (! isnumeric (varargin{end}) || ! isscalar (varargin{end})) error ("interp3: extrapal is expected to be a numeric scalar"); endif @@ -91,8 +91,8 @@ if (ndims (v) != 3) error ("interp3: expect 3-dimensional array of values"); endif - x = varargin (2:4); - if (any (! cellfun ("isvector", x))) + x = varargin (2:end); + if (any (! cellfun (@isvector, x))) for i = 2 : 3 if (! size_equal (x{1}, x{i})) error ("interp3: dimensional mismatch"); @@ -109,7 +109,7 @@ error ("interp3: expect 3-dimensional array of values"); endif x = varargin (1:3); - if (any (! cellfun ("isvector", x))) + if (any (! cellfun (@isvector, x))) for i = 2 : 3 if (! size_equal (x{1}, x{i}) || ! size_equal (x{i}, v)) error ("interp3: dimensional mismatch"); @@ -119,7 +119,7 @@ x{1} = permute (x{1}, [2, 1, 3]); endif y = varargin (5:7); - if (any (! cellfun ("isvector", y))) + if (any (! cellfun (@isvector, y))) for i = 2 : 3 if (! size_equal (y{1}, y{i})) error ("interp3: dimensional mismatch"); @@ -146,3 +146,21 @@ %! [xxi, yyi, zzi] = ndgrid (xi, yi, zi); %! vi2 = interpn(x, y, z, v, xxi, yyi, zzi); %! assert (vi, vi2); + +%!shared z, zout, tol +%! z = zeros (3, 3, 3); +%! zout = zeros (5, 5, 5); +%! z(:,:,1) = [1 3 5; 3 5 7; 5 7 9]; +%! z(:,:,2) = z(:,:,1) + 2; +%! z(:,:,3) = z(:,:,2) + 2; +%! for n = 1:5 +%! zout(:,:,n) = [1 2 3 4 5; +%! 2 3 4 5 6; +%! 3 4 5 6 7; +%! 4 5 6 7 8; +%! 5 6 7 8 9] + (n-1); +%! end +%! tol = 10 * eps; +%!assert (interp3 (z), zout, tol) +%!assert (interp3 (z, "linear"), zout, tol) +%!assert (interp3 (z, "spline"), zout, tol)
--- a/scripts/general/interpn.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/interpn.m Tue Oct 11 14:08:38 2011 -0500 @@ -70,14 +70,14 @@ extrapval = NA; nargs = nargin; - if (nargin < 1) + if (nargin < 1 || ! isnumeric (varargin{1})) print_usage (); endif if (ischar (varargin{end})) method = varargin{end}; nargs = nargs - 1; - elseif (ischar (varargin{end - 1})) + elseif (nargs > 1 && ischar (varargin{end - 1})) if (! isnumeric (varargin{end}) || ! isscalar (varargin{end})) error ("interpn: extrapal is expected to be a numeric scalar"); endif @@ -90,9 +90,12 @@ v = varargin{1}; m = 1; if (nargs == 2) - m = varargin{2}; - if (! isnumeric (m) || ! isscalar (m) || floor (m) != m) - error ("interpn: M is expected to be a integer scalar"); + if (ischar (varargin{2})) + method = varargin{2}; + elseif (isnumeric (m) && isscalar (m) && fix (m) == m) + m = varargin{2}; + else + print_usage (); endif endif sz = size (v); @@ -103,6 +106,8 @@ x{i} = 1 : sz(i); y{i} = 1 : (1 / (2 ^ m)) : sz(i); endfor + y{1} = y{1}.'; + [y{:}] = ndgrid (y{:}); elseif (! isvector (varargin{1}) && nargs == (ndims (varargin{1}) + 1)) v = varargin{1}; sz = size (v); @@ -290,3 +295,20 @@ %! X = meshgrid (1:4); %! assert (interpn (X, 2.5, 2.5, 'nearest'), 3); +%!shared z, zout, tol +%! z = zeros (3, 3, 3); +%! zout = zeros (5, 5, 5); +%! z(:,:,1) = [1 3 5; 3 5 7; 5 7 9]; +%! z(:,:,2) = z(:,:,1) + 2; +%! z(:,:,3) = z(:,:,2) + 2; +%! for n = 1:5 +%! zout(:,:,n) = [1 2 3 4 5; +%! 2 3 4 5 6; +%! 3 4 5 6 7; +%! 4 5 6 7 8; +%! 5 6 7 8 9] + (n-1); +%! end +%! tol = 10 * eps; +%!assert (interpn (z), zout, tol) +%!assert (interpn (z, "linear"), zout, tol) +%!assert (interpn (z, "spline"), zout, tol)
--- a/scripts/general/logspace.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/logspace.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/module.mk Tue Oct 11 14:08:38 2011 -0500 @@ -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 \ @@ -61,6 +60,7 @@ general/polyarea.m \ general/postpad.m \ general/prepad.m \ + general/profexplore.m \ general/profile.m \ general/profshow.m \ general/quadgk.m \
--- a/scripts/general/num2str.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/num2str.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 @@ -144,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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/general/profexplore.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/scripts/general/profile.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/profile.m Tue Oct 11 14:08:38 2011 -0500 @@ -55,6 +55,7 @@ ## 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 @@ -136,7 +137,7 @@ %! ftbl = info.FunctionTable; %! assert (fieldnames (ftbl), {'FunctionName'; 'TotalTime'; 'NumCalls'; 'IsRecursive'; 'Parents'; 'Children'}); %! hier = info.Hierarchical; -%! assert (fieldnames (hier), {'Index'; 'SelfTime'; 'NumCalls'; 'Children'}); +%! assert (fieldnames (hier), {'Index'; 'SelfTime'; 'TotalTime'; 'NumCalls'; 'Children'}); %! profile ('clear'); %! info = profile ('info'); %! assert (isstruct (info));
--- a/scripts/general/profshow.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/profshow.m Tue Oct 11 14:08:38 2011 -0500 @@ -30,6 +30,7 @@ ## ## The attribute column shows @samp{R} for recursive functions and nothing ## otherwise. +## @seealso{profexplore, profile} ## @end deftypefn ## Built-in profiler. @@ -43,7 +44,7 @@ n = fix (n); if (! isscalar (n) || ! isreal (n) || ! (n > 0)) - error ("profile: N must be a positive integer"); + error ("profile: N must be a positive integer"); endif m = length (data.FunctionTable);
--- a/scripts/general/quadl.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/quadl.m Tue Oct 11 14:08:38 2011 -0500 @@ -209,7 +209,7 @@ %!assert (quadl (@(x,a,b) sin (a + b*x), 0, 1, [], [], 2, 3), %! cos(2)/3 - cos(5)/3, - 3e-16) -## test different tolerances. +## 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, []),
--- a/scripts/general/rot90.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/rot90.m Tue Oct 11 14:08:38 2011 -0500 @@ -60,17 +60,11 @@ if (ndims (A) > 2) error ("rot90: A must be a 2-D array"); - endif - - if (! (isscalar (k) && isreal (k) && fix (k) == k)) + elseif (! (isscalar (k) && isreal (k) && k == fix (k))) error ("rot90: K must be a single real integer"); endif - k = rem (k, 4); - - if (k < 0) - k = k + 4; - endif + k = mod (k, 4); if (k == 0) B = A; @@ -93,12 +87,12 @@ %! 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 ();
--- a/scripts/general/rotdim.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/rotdim.m Tue Oct 11 14:08:38 2011 -0500 @@ -94,7 +94,7 @@ 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
--- a/scripts/general/shift.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/shift.m Tue Oct 11 14:08:38 2011 -0500 @@ -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,7 +47,7 @@ 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 @@ -54,24 +56,22 @@ (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 = repmat ({':'}, nd, 1); - if (b >= 0) + 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]; @@ -80,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/sortrows.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/sortrows.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/structfun.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/general/triplequad.m Tue Oct 11 14:08:38 2011 -0500 @@ -50,7 +50,7 @@ print_usage (); endif - ## Allow use of empty matrix ([]) to indicate default + ## Allow use of empty matrix ([]) to indicate default if (isempty (tol)) tol = 1e-6; endif @@ -75,7 +75,7 @@ endfor endfunction - + %!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
--- a/scripts/geometry/voronoin.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/geometry/voronoin.m Tue Oct 11 14:08:38 2011 -0500 @@ -47,10 +47,10 @@ if (np > dims) if (nargin == 1) [C, F, infi] = __voronoi__ (pts); - elseif (ischar (options)) + elseif (ischar (options) || iscellstr (options)) [C, F, infi] = __voronoi__ (pts, options); else - error ("voronoin: second argument must be a string"); + error ("voronoin: second argument must be a string or cell array of strings"); endif else
--- a/scripts/help/__makeinfo__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/help/__makeinfo__.m Tue Oct 11 14:08:38 2011 -0500 @@ -17,8 +17,8 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## @deftypefn {Function File} {[@var{retval}, @var{status}] =} __makeinfo__ (@var{text}) -## @deftypefnx {Function File} {[@var{retval}, @var{status}] =} __makeinfo__ (@var{text}, @var{output_type}) +## @deftypefn {Function File} {[@var{retval}, @var{status}] =} __makeinfo__ (@var{text}, @var{output_type}) +## @deftypefnx {Function File} {[@var{retval}, @var{status}] =} __makeinfo__ (@var{text}, @var{output_type}, @var{see_also}) ## Undocumented internal function. ## @end deftypefn @@ -33,6 +33,13 @@ ## @t{"plain text"}. If @var{output_type} is @t{"texinfo"}, the @t{@@seealso} ## macro is expanded, but otherwise the text is unaltered. ## +## If the optional argument @var{see_also} is present, it is used to expand the +## Octave specific @t{@@seealso} macro. This argument must be a function handle, +## that accepts a cell array of strings as input argument (each elements of the +## array corresponds to the arguments to the @t{@@seealso} macro), and return +## the expanded string. If this argument is not given, the @t{@@seealso} macro +## will be expanded to the text +## ## @example ## See also: arg1, arg2@, ... ## @end example @@ -50,31 +57,48 @@ ## 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 < 1 || nargin > 2) + 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 + if (nargin < 3) + if (strcmpi (output_type, "plain text")) + fsee_also = @(T) strcat ... + ("\nSee also:", sprintf (" %s,", T{:})(1:end-1), "\n"); + else + fsee_also = @(T) strcat ... + ("\nSee also:", sprintf (" @ref{%s},", T{:})(1:end-1), "\n"); + endif + endif + + 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 - if (strcmpi (output_type, "plain text")) - text = regexprep (text, '@seealso *\{([^}]*)\}', "\nSee also: $1.\n\n"); - else - text = regexprep (text, '@seealso *\{([^}]*)\}', "\nSee also: @ref{$1}.\n\n"); - 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 text = regexprep (text, '@nospell *\{([^}]*)\}', "$1"); @@ -90,7 +114,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 @@ -100,11 +124,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
--- a/scripts/help/get_first_help_sentence.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/help/get_first_help_sentence.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/image/image.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/image/image.m Tue Oct 11 14:08:38 2011 -0500 @@ -164,6 +164,7 @@ endfunction %!demo +%! clf %! img = 1 ./ hilb (11); %! x = -5:5; %! y = x; @@ -186,4 +187,40 @@ %! set (h, "cdatamapping", "scaled") %! title ('image (-x, -y, img)') +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! imagesc (g, g, sin (h)); +%! hold on +%! imagesc (g, g+12, cos (h/2)); +%! axis ([0 10 0 22]) +%! hold off +%! title ("two consecutive images") +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! imagesc (g, g, sin (h)); +%! hold all +%! plot (g, 11.0 * ones (size (g))) +%! imagesc (g, g+12, cos (h/2)); +%! axis ([0 10 0 22]) +%! hold off +%! title ("image, line, image") + +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! plot (g, 10.5 * ones (size (g))) +%! hold all +%! imagesc (g, g, sin (h)); +%! plot (g, 11.0 * ones (size (g))) +%! imagesc (g, g+12, cos (h/2)); +%! plot (g, 11.5 * ones (size (g))) +%! axis ([0 10 0 22]) +%! hold off +%! title ("line, image, line, image, line") +
--- a/scripts/image/ind2rgb.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/image/ind2rgb.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/strread.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/io/strread.m Tue Oct 11 14:08:38 2011 -0500 @@ -120,7 +120,7 @@ ## @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" @@ -128,7 +128,7 @@ ## ## @item "multipledelimsasone" ## Treat a series of consecutive delimiters, without whitespace in between, -## as a single delimiter. Consecutive delimiter series need not be vertically +## as a single delimiter. Consecutive delimiter series need not be vertically ## "aligned". ## ## @item "treatasempty" @@ -144,7 +144,7 @@ ## 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{textscan, textread, load, dlmread, fscanf} @@ -220,7 +220,7 @@ 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'", + error ("strread: unknown or unrecognized comment style '%s'", varargin{n+1}); endif endswitch @@ -290,7 +290,7 @@ ## Remove comments in str if (comment_flag) ## Expand 'eol_char' here, after option processing which may have set value - comment_end = regexprep (comment_end, 'eol_char', eol_char); + 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 @@ -339,7 +339,7 @@ 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)) + if ((str(end) == 10) && (nargout > 1)) pad_out = 1; endif ## Remove repeated white_space chars. First find white_space positions @@ -384,7 +384,7 @@ 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. @@ -398,11 +398,11 @@ 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); + 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-catch because complexity of strings to read can be infinite #try ## 1. Assess "period" in the split-up words array ( < num_words_per_line). @@ -446,7 +446,7 @@ ## 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 @@ -462,7 +462,7 @@ endif elseif (iwrdp < iwrdl) ## No bordering literal to the right => field occupies (rest of) word - ++iwrd; iwrdp = 0; + ++iwrd; iwrdp = 0; if (ii < numel (fmt_words)) iwrdl = length (words{iwrd}); endif @@ -478,7 +478,7 @@ 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)]; + words = [words'; cell(num_words_padded, 1)]; endif words = reshape (words, words_period, tmp_lines); @@ -498,7 +498,7 @@ 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, :); + words(icol+1:end+1, :) = words(icol:end, :); ## Watch out for empty cells jptr = find (! cellfun ("isempty", words(icol, :))); @@ -523,7 +523,7 @@ 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), "UniformOutput", false); words(icol, jptr) = strtrunc (words(icol, jptr), wdth); else ## FIXME: this assumes char(254)/char(255) won't occur in input! @@ -566,7 +566,7 @@ #end_try_catch endif - + ## For each specifier, process corresponding column k = 1; for m = 1:num_words_per_line @@ -587,7 +587,7 @@ switch fmt_words{m}(1:min (2, length (fmt_words{m}))) case "%s" if (pad_out) - data(end+1:num_lines) = {""}; + data(end+1:num_lines) = {""}; endif varargout{k} = data'; k++; @@ -596,10 +596,10 @@ ### FIXME - erroneously formatted data lead to NaN, not an error data = str2double (data); if (! isempty (regexp (fmt_words{m}, "%[du]"))) - ## Cast to integer + ## Cast to integer ## FIXME: NaNs will be transformed into zeros data = int32 (data); - end + endif data(n) = numeric_fill_value; if (pad_out) data(end+1:num_lines) = numeric_fill_value; @@ -623,10 +623,10 @@ sprec = str2double (nfmt{2}); data = 10^-sprec * round (10^sprec * data); elseif (! isempty (regexp (fmt_words{m}, "[du]"))) - ## Cast to integer + ## Cast to integer ## FIXME: NaNs will be transformed into zeros data = int32 (data); - end + endif varargout{k} = data.'; k++; case "s" @@ -682,7 +682,7 @@ if (!isempty (out) && any (sep == text(end))) out(end) = []; endif - + ## Empty cells converted to empty cellstrings. out(cellfun ("isempty", out)) = {""};
--- a/scripts/io/textread.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/io/textread.m Tue Oct 11 14:08:38 2011 -0500 @@ -41,7 +41,7 @@ ## delimiters. ## @end itemize ## -## The optional input @var{n} specifes the number of times to use +## 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} @@ -98,9 +98,9 @@ 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"); + ## '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
--- a/scripts/io/textscan.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/io/textscan.m Tue Oct 11 14:08:38 2011 -0500 @@ -28,7 +28,7 @@ ## 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. +## @code{strread} for details. ## ## In addition to the options supported by ## @code{strread}, this function supports a few more: @@ -52,7 +52,7 @@ ## have been encountered. If set to 0 or false, return an error and no data. ## @end itemize ## -## The optional input @var{n} specifes the number of times to use +## 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 @@ -108,7 +108,7 @@ 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, + ## 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]); @@ -116,7 +116,7 @@ endif if (! any (strcmpi (args, "delimiter"))) - ## Matlab says default delimiter = whitespace. + ## Matlab says default delimiter = whitespace. ## strread() will pick this up further args(end+1:end+2) = {'delimiter', ""}; endif @@ -156,7 +156,7 @@ ## 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) = []; + args(headerlines:headerlines+1) = []; endif if (isfinite (nlines) && (nlines >= 0)) str = tmp_str = ""; @@ -183,13 +183,13 @@ ## 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})) + 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 else - error ("textscan: character value required for EndOfLine"); + error ("textscan: character value required for EndOfLine"); endif else ## Determine EOL from file. Search for EOL candidates in first 3000 chars @@ -219,7 +219,7 @@ ## 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);
--- a/scripts/linear-algebra/commutation_matrix.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/linear-algebra/commutation_matrix.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/scripts/linear-algebra/duplication_matrix.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/linear-algebra/duplication_matrix.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/scripts/linear-algebra/onenormest.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/linear-algebra/onenormest.m Tue Oct 11 14:08:38 2011 -0500 @@ -278,6 +278,7 @@ ## Only likely to be within a factor of 10. %!test %! N = 100; +%! rand ('state', 42); % Initialize to guarantee reproducible results %! A = rand (N); %! [nm1, v1, w1] = onenormest (A); %! [nminf, vinf, winf] = onenormest (A', 6);
--- a/scripts/linear-algebra/rank.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/linear-algebra/rank.m Tue Oct 11 14:08:38 2011 -0500 @@ -60,42 +60,42 @@ 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; +%! 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; +%! 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; +%! 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; +%! 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; +%! 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; +%! 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);
--- a/scripts/miscellaneous/bincoeff.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/bincoeff.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/computer.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/computer.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/getappdata.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/getappdata.m Tue Oct 11 14:08:38 2011 -0500 @@ -36,11 +36,12 @@ 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)}; - end + endfor if (nh == 1) val = val{1}; endif
--- a/scripts/miscellaneous/gzip.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/gzip.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/module.mk Tue Oct 11 14:08:38 2011 -0500 @@ -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 \
--- a/scripts/miscellaneous/private/__xzip__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/private/__xzip__.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/miscellaneous/python.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/setappdata.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/setappdata.m Tue Oct 11 14:08:38 2011 -0500 @@ -33,7 +33,7 @@ for nh = 1:numel(h) if (! isfield (get (h(nh)), "__appdata__")) addproperty ("__appdata__", h(nh), "any", struct ()); - end + endif appdata = get (h(nh), "__appdata__"); for narg = 1:2:numel(varargin) if (iscellstr (varargin{narg}))
--- a/scripts/miscellaneous/tempdir.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/tempdir.m Tue Oct 11 14:08:38 2011 -0500 @@ -47,9 +47,9 @@ %! old_tmpdir = getenv ("TMPDIR"); %! unwind_protect %! setenv ("TMPDIR", "__MY_TMP_DIR__"); -%! assert (tempdir (), ["__MY_TMP_DIR__" filesep()]); +%! assert (tempdir (), ["__MY_TMP_DIR__" filesep()]); %! unwind_protect_cleanup %! setenv ("TMPDIR", old_tmpdir); %! warning (old_wstate); -%! end_unwind_protect +%! end_unwind_protect
--- a/scripts/miscellaneous/unpack.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/miscellaneous/unpack.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/scripts/optimization/fminunc.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/optimization/fminunc.m Tue Oct 11 14:08:38 2011 -0500 @@ -359,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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/optimization/fsolve.m Tue Oct 11 14:08:38 2011 -0500 @@ -460,7 +460,7 @@ endif endfunction -%!function retval = f (p) +%!function retval = __f (p) %! x = p(1); %! y = p(2); %! z = p(3); @@ -468,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); @@ -488,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); @@ -505,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); @@ -523,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); @@ -553,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/optimset.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/optimization/optimset.m Tue Oct 11 14:08:38 2011 -0500 @@ -39,9 +39,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. @@ -90,5 +89,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/sqp.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/optimization/sqp.m Tue Oct 11 14:08:38 2011 -0500 @@ -22,7 +22,7 @@ ## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}) ## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}) ## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}, @var{maxiter}) -## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}, @var{maxiter}, @var{tolerance}) +## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}, @var{maxiter}, @var{tol}) ## Solve the nonlinear program ## @tex ## $$ @@ -62,14 +62,8 @@ ## The first argument is the initial guess for the vector @var{x0}. ## ## The second argument is a function handle pointing to the objective -## function. The objective function must be of the form -## -## @example -## @var{y} = phi (@var{x}) -## @end example -## -## @noindent -## in which @var{x} is a vector and @var{y} is a scalar. +## function @var{phi}. The objective function must accept one vector +## argument and return a scalar. ## ## The second argument may also be a 2- or 3-element cell array of ## function handles. The first element should point to the objective @@ -80,40 +74,18 @@ ## differences. If the Hessian function is not supplied, a BFGS update ## formula is used to approximate the Hessian. ## -## When supplied, the gradient function must be of the form -## -## @example -## @var{g} = gradient (@var{x}) -## @end example -## -## @noindent -## in which @var{x} is a vector and @var{g} is a vector. -## -## When supplied, the Hessian function must be of the form -## -## @example -## @var{h} = hessian (@var{x}) -## @end example +## When supplied, the gradient function @code{@var{phi}@{2@}} must accept +## one vector argument and return a vector. When supplifed, the Hessian +## function @code{@var{phi}@{3@}} must accept one vector argument and +## return a matrix. ## -## @noindent -## in which @var{x} is a vector and @var{h} is a matrix. -## -## The third and fourth arguments are function handles pointing to -## functions that compute the equality constraints and the inequality -## constraints, respectively. -## -## If the problem does not have equality (or inequality) constraints, -## then use an empty matrix ([]) for @var{cef} (or @var{cif}). -## -## When supplied, the equality and inequality constraint functions must be -## of the form -## -## @example -## @var{r} = f (@var{x}) -## @end example -## -## @noindent -## in which @var{x} is a vector and @var{r} is a vector. +## The third and fourth arguments @var{g} and @var{h} are function +## handles pointing to functions that compute the equality constraints +## and the inequality constraints, respectively. If the problem does +## not have equality (or inequality) constraints, then use an empty +## matrix ([]) for @var{g} (or @var{h}). When supplied, these equality +## and inequality constraint functions must accept one vector argument +## and return a vector. ## ## The third and fourth arguments may also be 2-element cell arrays of ## function handles. The first element should point to the constraint @@ -137,19 +109,20 @@ ## @end example ## ## @end ifnottex -## The fifth and sixth arguments contain lower and upper bounds -## on @var{x}. These must be consistent with the equality and inequality -## constraints @var{g} and @var{h}. If the arguments are vectors then -## @var{x}(i) is bound by @var{lb}(i) and @var{ub}(i). A bound can also -## be a scalar in which case all elements of @var{x} will share the same -## bound. If only one bound (lb, ub) is specified then the other will -## default to (-@var{realmax}, +@var{realmax}). +## The fifth and sixth arguments, @var{lb} and @var{ub}, contain lower +## and upper bounds on @var{x}. These must be consistent with the +## equality and inequality constraints @var{g} and @var{h}. If the +## arguments are vectors then @var{x}(i) is bound by @var{lb}(i) and +## @var{ub}(i). A bound can also be a scalar in which case all elements +## of @var{x} will share the same bound. If only one bound (lb, ub) is +## specified then the other will default to (-@var{realmax}, +## +@var{realmax}). ## -## The seventh argument specifies the maximum number of iterations. -## The default value is 100. +## The seventh argument @var{maxiter} specifies the maximum number of +## iterations. The default value is 100. ## -## The eighth argument specifies the tolerance for the stopping criteria. -## The default value is @code{sqrt(eps)}. +## The eighth argument @var{tol} specifies the tolerance for the +## stopping criteria. The default value is @code{sqrt(eps)}. ## ## The value returned in @var{info} may be one of the following: ## @@ -163,7 +136,7 @@ ## @ifnottex ## delta @var{x}, ## @end ifnottex -## is less than @code{tol * norm (x)}. +## is less than @code{@var{tol} * norm (x)}. ## ## @item 102 ## The BFGS update failed. @@ -443,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. @@ -751,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/pkg/pkg.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/pkg/pkg.m Tue Oct 11 14:08:38 2011 -0500 @@ -21,7 +21,7 @@ ## @deftypefn {Command} {} pkg @var{command} @var{pkg_name} ## @deftypefnx {Command} {} pkg @var{command} @var{option} @var{pkg_name} ## Manage packages (groups of add-on functions) for Octave. Different actions -## are available depending on the value of @var{command}. +## are available depending on the value of @var{command}. ## ## Available commands: ## @@ -55,7 +55,7 @@ ## starting Octave. This overrides any setting within the package. ## ## @item -local -## A local installation (package available only to current user) is forced, +## A local installation (package available only to current user) is forced, ## even if the user has system privileges. ## ## @item -global @@ -131,7 +131,7 @@ ## 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 ## [user_packages, system_packages] = pkg ("list") ## @end example @@ -308,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" @@ -1355,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);
--- a/scripts/plot/__gnuplot_drawnow__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/__gnuplot_drawnow__.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/scripts/plot/allchild.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/allchild.m Tue Oct 11 14:08:38 2011 -0500 @@ -50,8 +50,8 @@ endfunction %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! l = line; %! assert(get(allchild(hf),'type'),{'axes'; 'uimenu'; 'uimenu'; 'uimenu'}) %! unwind_protect_cleanup
--- a/scripts/plot/ancestor.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/ancestor.m Tue Oct 11 14:08:38 2011 -0500 @@ -76,8 +76,8 @@ endfunction %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! l = line; %! assert (ancestor (l, "axes"), gca); %! assert (ancestor (l, "figure"), hf);
--- a/scripts/plot/axis.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/axis.m Tue Oct 11 14:08:38 2011 -0500 @@ -277,8 +277,8 @@ endif for i = 1:2:len - if (ax(i) == ax(i+1)) - error ("axis: limits(%d) cannot equal limits(%d)", i, i+1); + if (ax(i) >= ax(i+1)) + error ("axis: limits(%d) must be less than limits(%d)", i, i+1); endif endfor @@ -319,9 +319,9 @@ else data = get (kids, strcat (ax, "data")); scale = get (ca, strcat (ax, "scale")); - if (strcmp (scale, "log")) + if (strcmp (scale, "log") && any (data > 0)) data(data<=0) = NaN; - end + endif if (iscell (data)) data = data (find (! cellfun ("isempty", data))); if (! isempty (data)) @@ -350,6 +350,7 @@ endfunction %!demo +%! clf %! t=0:0.01:2*pi; x=sin(t); %! %! subplot(221); @@ -372,6 +373,7 @@ %! axis("normal"); %!demo +%! clf %! t=0:0.01:2*pi; x=sin(t); %! %! subplot(121); @@ -385,6 +387,7 @@ %! axis("xy"); %!demo +%! clf %! t=0:0.01:2*pi; x=sin(t); %! %! subplot(331); @@ -433,6 +436,7 @@ %! axis("on"); %!demo +%! clf %! t=0:0.01:2*pi; x=sin(t); %! %! subplot(321); @@ -493,3 +497,8 @@ %! legend ({"x >= 1", "x <= 1"}, "location", "north") %! title ("ylim = [1, 10]") +%!demo +%! clf +%! loglog (1:20, "-s") +%! axis tight +
--- a/scripts/plot/cla.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/cla.m Tue Oct 11 14:08:38 2011 -0500 @@ -90,8 +90,8 @@ endfunction %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! plot (1:10) %! cla () %! kids = get (gca, "children");
--- a/scripts/plot/clf.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/clf.m Tue Oct 11 14:08:38 2011 -0500 @@ -77,8 +77,8 @@ endfunction %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! l = line; %! assert (!isempty (get (gcf, "children"))); %! unwind_protect_cleanup @@ -86,8 +86,8 @@ %! end_unwind_protect %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! clf; %! assert (isempty (get (gcf, "children"))); %! unwind_protect_cleanup
--- a/scripts/plot/close.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/close.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/contour.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/contour.m Tue Oct 11 14:08:38 2011 -0500 @@ -71,11 +71,22 @@ endfunction %!demo +%! clf () %! [x, y, z] = peaks (); %! contour (x, y, z); %!demo +%! clf () %! [theta, r] = meshgrid (linspace (0, 2*pi, 64), linspace(0,1,64)); %! [X, Y] = pol2cart (theta, r); %! Z = sin(2*theta).*(1-r); %! contour(X, Y, abs(Z), 10) + +%!demo +%! clf () +%! x = linspace (-2, 2); +%! [x, y] = meshgrid (x); +%! z = sqrt (x.^2 + y.^2) ./ (x.^2 + y.^2+1); +%! contourf (x, y, z, [0.4, 0.4]) +%! title ("The hole should be filled with the background color") +
--- a/scripts/plot/figure.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/figure.m Tue Oct 11 14:08:38 2011 -0500 @@ -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) = []; @@ -80,3 +80,12 @@ 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/findall.m Tue Oct 11 14:08:38 2011 -0500 @@ -44,8 +44,8 @@ endfunction %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! 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)
--- a/scripts/plot/findobj.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/findobj.m Tue Oct 11 14:08:38 2011 -0500 @@ -244,14 +244,13 @@ endfunction %!test -%! fign = 1232; -%! hf = figure (fign, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! l = line; %! obj = findobj (hf, "type", "line"); %! assert (l, obj); %! assert (gca, findobj (hf, "type", "axes")); -%! assert (fign, findobj (hf, "type", "figure")); +%! assert (hf, findobj (hf, "type", "figure")); %! assert (isempty (findobj (hf, "type", "xyzxyz"))); %! unwind_protect_cleanup %! close (hf);
--- a/scripts/plot/gca.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/gca.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/gcbf.m Tue Oct 11 14:08:38 2011 -0500 @@ -31,3 +31,6 @@ [dummy, fig] = gcbo (); endfunction + +%!test +%! assert (isempty (gcbf ));
--- a/scripts/plot/gcbo.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/gcbo.m Tue Oct 11 14:08:38 2011 -0500 @@ -41,3 +41,6 @@ endif endfunction + +%!test +%! assert (isempty (gcbo ));
--- a/scripts/plot/gcf.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/gcf.m Tue Oct 11 14:08:38 2011 -0500 @@ -55,9 +55,9 @@ endfunction %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect -%! assert (gcf, 1232); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (gcf, hf); %! unwind_protect_cleanup %! close (hf); %! end_unwind_protect
--- a/scripts/plot/ginput.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/ginput.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/gtext.m Tue Oct 11 14:08:38 2011 -0500 @@ -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);
--- a/scripts/plot/hggroup.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/hggroup.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/hold.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/isfigure.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/ishghandle.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/ishold.m Tue Oct 11 14:08:38 2011 -0500 @@ -58,3 +58,23 @@ && strcmpi (get (ax, "nextplot"), "add")); endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! 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/isprop.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/isprop.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/legend.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/line.m Tue Oct 11 14:08:38 2011 -0500 @@ -44,15 +44,16 @@ endfunction %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! 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); +%! 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/loglog.m Tue Oct 11 14:08:38 2011 -0500 @@ -71,19 +71,19 @@ %! 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 (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! a = logspace (-5, 1, 10); %! b = logspace (-5, 1, 10); %! loglog (a, b) @@ -94,8 +94,8 @@ %! end_unwind_protect %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! a = logspace (-5, 1, 10); %! b =-logspace (-5, 1, 10); %! loglog (a, b)
--- a/scripts/plot/meshgrid.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/meshgrid.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/module.mk Tue Oct 11 14:08:38 2011 -0500 @@ -46,7 +46,8 @@ 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/__uiobject_split_args__.m plot_FCN_FILES = \ plot/__gnuplot_drawnow__.m \ @@ -174,9 +175,11 @@ plot/trimesh.m \ plot/triplot.m \ plot/trisurf.m \ + plot/uicontrol.m \ plot/uigetdir.m \ plot/uigetfile.m \ plot/uimenu.m \ + plot/uipanel.m \ plot/uiputfile.m \ plot/view.m \ plot/waitforbuttonpress.m \
--- a/scripts/plot/ndgrid.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/ndgrid.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/newplot.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/patch.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/patch.m Tue Oct 11 14:08:38 2011 -0500 @@ -152,3 +152,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; 1], eps); +%! assert (get (h, "ydata"), [0; 0; 1], eps); +%! assert (isempty(get (h, "zdata"))); +%! assert (isempty(get (h, "cdata"))); +%! assert (get (h, "faces"), [1, 2, 3], eps); +%! assert (get (h, "vertices"), [0 0; 1 0; 1 1], eps); +%! assert (get (h, "type"), "patch"); +%! assert (get (h, "facecolor"), [0 0 1]); +%! 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/plotyy.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/plotyy.m Tue Oct 11 14:08:38 2011 -0500 @@ -70,6 +70,7 @@ else error ("plotyy: expecting first argument to be axes handle"); endif + oldh = gca (); else f = get (0, "currentfigure"); if (isempty (f)) @@ -78,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; @@ -93,17 +94,18 @@ elseif (isempty (ax)) ax(1) = axes (); ax(2) = axes (); + ca = ax(2); endif if (nargin < 2) varargin = {}; endif + oldh = ca; endif if (nargin < 4) print_usage (); endif - oldh = gca (); unwind_protect [ax, h1, h2] = __plotyy__ (ax, varargin{:}); unwind_protect_cleanup @@ -207,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 @@ -257,6 +255,15 @@ %! plotyy (x, 10*sin(2*pi*x), x, cos(2*pi*x)) %! axis square +%!demo +%! clf +%! x = linspace (-1, 1, 201); +%! subplot (1, 1, 1); +%! hax = plotyy (x, sin(pi*x), x, cos(pi*x)); +%! ylabel ("Blue and on the Left") +%! ylabel (hax(2), "Green and on the Right") +%! xlabel ("xlabel") + function deleteplotyy (h, d, ax2, t2) if (ishandle (ax2) && strcmp (get (ax2, "type"), "axes") && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off"))
--- a/scripts/plot/print.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/print.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/__axes_limits__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__axes_limits__.m Tue Oct 11 14:08:38 2011 -0500 @@ -44,7 +44,11 @@ if (!isnumeric (arg) && any (size(arg(:)) != [2, 1])) error ("%s: argument must be a 2 element vector", fcn); else - set (h, fcn, arg(:)); + if (arg(1) >= arg(2)) + error ("%s: axis limits must be increasing", fcn) + else + set (h, fcn, arg(:)); + endif endif endif endif
--- a/scripts/plot/private/__contour__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__contour__.m Tue Oct 11 14:08:38 2011 -0500 @@ -319,10 +319,18 @@ else ## Special case unclosed contours endif + if (isnan(cont_lev(idx))) + fc = get (ca, "color"); + if (strcmp (fc, "none")) + fc = get (ancestor (ca, "figure"), "color"); + endif + else + fc = "flat"; + endif h = [h; __go_patch__(ca, "xdata", ctmp(1, :)(:), "ydata", ctmp(2, :)(:), "vertices", ctmp.', "faces", 1:(cont_len(idx)-1), "facevertexcdata", cont_lev(idx), - "facecolor", "flat", "cdata", cont_lev(idx), + "facecolor", fc, "cdata", cont_lev(idx), "edgecolor", lc, "linestyle", ls, "linewidth", lw, "parent", hg)]; endfor
--- a/scripts/plot/private/__errplot__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__errplot__.m Tue Oct 11 14:08:38 2011 -0500 @@ -31,7 +31,7 @@ print_usage (); endif - [fmt, key] = __pltopt__ ("__errplot__", fstr); + [fmt, valid] = __pltopt__ ("__errplot__", fstr); [len, nplots] = size (varargin{1}); h = []; @@ -74,7 +74,7 @@ switch (numel(varargin)) case 2 ydata = varargin{1}(:,i); - xdata = 1:numel(ydata); + xdata = 1:numel (ydata); if (strcmp (ifmt, "xerr") || strcmp (ifmt, "box")) xldata = varargin{2}(:,i); xudata = ldata; @@ -86,12 +86,12 @@ xldata = []; xudata = []; else - error ("errorbar: 2 column errorplot is only valid or xerr or yerr"); + error ("errorbar: 2 column errorplot is only valid for xerr or yerr"); endif case 3 if (strcmp (ifmt, "boxxy") || strcmp (ifmt, "xyerr")) ydata = varargin{1}(:,i); - xdata = 1:numel(ydata); + xdata = 1:numel (ydata); xldata = varargin{2}(:,i); xudata = xldata; ldata = varargin{3}(:,i); @@ -146,7 +146,7 @@ error ("errorbar: error plot with 6 columns only valid for boxxy and xyerr"); endif otherwise - error ("errorbar: error plot requires 2, 3, 4 or 6 arguments"); + error ("errorbar: error plot requires 2, 3, 4, or 6 arguments"); endswitch addproperty ("xdata", hg, "data", xdata(:)); @@ -193,6 +193,34 @@ endfor + ## Process legend key + if (! isempty (fmt.key)) + hlegend = []; + fkids = get (gcf(), "children"); + for i = 1 : numel (fkids) + if (ishandle (fkids(i)) && strcmp (get (fkids(i), "type"), "axes") + && (strcmp (get (fkids(i), "tag"), "legend"))) + udata = get (fkids(i), "userdata"); + if (! isempty (intersect (udata.handle, gca ()))) + hlegend = fkids (i); + break; + endif + endif + endfor + + if (isempty (hlegend)) + hlgnd = []; + tlgnd = {}; + else + [hlgnd, tlgnd] = __getlegenddata__ (hlegend); + endif + + hlgnd(end+1) = hg; + tlgnd(end+1) = fmt.key; + + legend (gca(), hlgnd, tlgnd); + end + endfunction function [xdata, ydata] = errorbar_data (xdata, ydata, ldata, udata, @@ -259,8 +287,10 @@ else error ("errorbar: valid error bar types are xerr, yerr, boxxy, and xyerr"); endif + xdata = xdata.'(:); ydata = ydata.'(:); + endfunction function update_props (hg, dummy, hl)
--- a/scripts/plot/private/__getlegenddata__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__getlegenddata__.m Tue Oct 11 14:08:38 2011 -0500 @@ -26,38 +26,33 @@ text_strings = {}; ca = getfield (get (hlegend, "userdata"), "handle"); kids = []; - for i = 1 : numel (ca) - kids = [kids; get(ca (i), "children")]; + for i = 1:numel (ca) + kids = [kids; get(ca(i), "children")]; endfor - k = numel (kids); - while (k > 0) - typ = get (kids(k), "type"); - while (k > 0 - && ! (strcmp (typ, "line") || strcmp (typ, "surface") - || strcmp (typ, "patch") || strcmp (typ, "hggroup"))) - typ = get (kids(--k), "type"); - endwhile - if (k > 0) - if (strcmp (get (kids(k), "type"), "hggroup")) - hgkids = get (kids(k), "children"); + + for i = numel (kids):-1:1 + typ = get (kids(i), "type"); + if (strcmp (typ, "line") || strcmp (typ, "surface") + || strcmp (typ, "patch") || strcmp (typ, "hggroup")) + + if (strcmp (typ, "hggroup")) + hgkids = get (kids(i), "children"); for j = 1 : length (hgkids) hgobj = get (hgkids (j)); - if (isfield (hgobj, "displayname") - && ! isempty (hgobj.displayname)) + if (isfield (hgobj, "displayname") && ! isempty (hgobj.displayname)) hplots = [hplots, hgkids(j)]; text_strings = {text_strings{:}, hgobj.displayname}; break; endif endfor else - if (! isempty (get (kids (k), "displayname"))) - hplots = [hplots, kids(k)]; - text_strings = {text_strings{:}, get(kids (k), "displayname")}; + if (! isempty (get (kids (i), "displayname"))) + hplots = [hplots, kids(i)]; + text_strings = {text_strings{:}, get(kids (i), "displayname")}; endif endif - if (--k == 0) - break; - endif + endif - endwhile + endfor + endfunction
--- a/scripts/plot/private/__go_draw_axes__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__go_draw_axes__.m Tue Oct 11 14:08:38 2011 -0500 @@ -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"; + else + 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"; + else + 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"; + else + 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)) @@ -1527,6 +1589,13 @@ fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, usingclause{1}, titlespec{1}, withclause{1}); elseif (is_image_data (1)) + if (numel (is_image_data) > 1 && is_image_data(2)) + ## Remove terminating semicolon + n = max (strfind (withclause{1}, ";")); + if (! isempty(n)) + withclause{1} = withclause{1}(1:n-1); + endif + endif fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, usingclause{1}, titlespec{1}, withclause{1}); else @@ -1548,9 +1617,20 @@ fputs (plot_stream, "unset obj 2; \\\n"); fg_is_set = false; endif + if (numel (is_image_data) > i && is_image_data(i+1)) + ## Remove terminating semicolon + n = max (strfind (withclause{i}, ";")); + if (! isempty(n)) + withclause{i} = withclause{i}(1:n-1); + endif + endif + fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, + usingclause{i}, titlespec{i}, withclause{i}); + else + ## For consecutive images continue with the same plot command + fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", ",", + usingclause{i}, titlespec{i}, withclause{i}); endif - fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, - usingclause{i}, titlespec{i}, withclause{i}); elseif (is_image_data (i-1)) if (bg_is_set) fputs (plot_stream, "unset obj 1; \\\n"); @@ -1612,6 +1692,16 @@ endfunction +function x = flip (x) + if (size (x, 1) == 1) + x = fliplr (x); + elseif (size (x, 2) == 1 || ischar (x)) + x = flipup (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); @@ -1907,61 +1997,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); + 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); + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + 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); + 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); + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + 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); + 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); + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + 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); + 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); + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + 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); + 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); + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + 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); + 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); + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + 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); + 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) + fontname, fontspec, interpreter, scale, sgn, gnuplot_term) persistent warned_latex = false; if (strcmpi (interpreter, "tex")) for n = 1 : numel(labels) @@ -1974,8 +2070,15 @@ endif endif if (strcmp (scale, "log")) - fmt = "10^{%T}"; num_mtics = 10; + if (any (strcmp (gnuplot_term, {"tikz", "pstex", "pslatex", "epslatex"}))) + fmt = "$10^{%T}$"; + else + fmt = "10^{%T}"; + endif + if (sgn < 0) + fmt = strcat ("-", fmt); + endif else fmt = "%g"; num_mtics = 5;
--- a/scripts/plot/private/__line__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__line__.m Tue Oct 11 14:08:38 2011 -0500 @@ -45,16 +45,12 @@ num_data_args = 0; endif - if (rem (nvargs - num_data_args, 2) != 0) - print_usage ("line"); + if (num_data_args > 0 && ! size_equal (varargin{1:num_data_args})) + error ("line: number of X, Y, and Z points must be equal"); 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 + if (rem (nvargs - num_data_args, 2) != 0) + error ("line: invalid number of PROPERTY / VALUE pairs"); endif other_args = {}; @@ -62,6 +58,64 @@ 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__patch__.m Tue Oct 11 14:08:38 2011 -0500 @@ -31,7 +31,12 @@ failed = false; - if (isstruct (varargin{1})) + is_numeric_arg = cellfun (@isnumeric, varargin); + + if (isempty (varargin)) + args = {"xdata", [0; 1; 1], "ydata", [0; 0; 1], "facecolor", "blue"}; + 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,47 @@ 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}; z = []; + c = varargin{3}; + iarg = 4; + 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 +102,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]); @@ -105,23 +129,31 @@ args{10} = c; 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} = []; + else + if (rows (c) != rows (x) || rows (c) != length (y)) + error ("patch: size of x, y, and c must be equal"); + elseif (rows (c) == rows (x) && rows (c) == rows (y)) + args{7} = "facecolor"; + args{8} = "interp"; + args{9} = "cdata"; + args{10} = c; + else + error ("patch: color value not valid"); + endif 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]; @@ -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{:}};
--- a/scripts/plot/private/__quiver__.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__quiver__.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/private/__scatter__.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/private/__uiobject_split_args__.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,63 @@ +## 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}, @dots{}) +## @end deftypefn + +## Author: goffioul + +function [parent, args] = __uiobject_split_args__ (who, varargin) + + parent = []; + args = {}; + offset = 1; + + if (nargin > 1) + if (ishandle (varargin{1})) + parent = varargin{1}; + offset = 2; + elseif (! ischar (varargin{1})) + error ("%s: invalid parent handle.", who); + endif + + if (nargin > offset) + args = varargin(offset:end); + endif + 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 (find (strcmpi (get (parent, "type"), {"figure", "uipanel", "uibuttongroup"})))) + error ("%s: invalid parent, the parent must be a figure, uipanel or uibuttongroup handle", who); + endif + else + parent = gcf (); + endif + +endfunction
--- a/scripts/plot/rectangle.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/rectangle.m Tue Oct 11 14:08:38 2011 -0500 @@ -33,7 +33,7 @@ ## 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 @@ -44,8 +44,8 @@ ## 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/semilogx.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/semilogx.m Tue Oct 11 14:08:38 2011 -0500 @@ -69,19 +69,19 @@ %! clf (); %! a = logspace (-5, 1, 10); %! b =-logspace (-5, 1, 10); -%! +%! %! subplot (1, 2, 1) %! semilogx (b, a) %! xlabel ('semilogx (a, b)') -%! +%! %! subplot (1, 2, 2) %! semilogx (abs (b), a) %! set (gca, 'ydir', 'reverse') %! xlabel ('semilogx (a, abs (b))') %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! a = logspace (-5, 1, 10); %! b = logspace (-5, 1, 10); %! semilogx (a, b) @@ -92,8 +92,8 @@ %! end_unwind_protect %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! a = logspace (-5, 1, 10); %! b =-logspace (-5, 1, 10); %! semilogx (a, b) @@ -102,5 +102,3 @@ %! unwind_protect_cleanup %! close (hf); %! end_unwind_protect - -
--- a/scripts/plot/semilogy.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/semilogy.m Tue Oct 11 14:08:38 2011 -0500 @@ -70,19 +70,19 @@ %! clf (); %! a = logspace (-5, 1, 10); %! b =-logspace (-5, 1, 10); -%! +%! %! subplot (1, 2, 1) %! semilogy (a, b) %! xlabel ('semilogy (a, b)') -%! +%! %! subplot (1, 2, 2) %! semilogy (a, abs (b)) %! set (gca, 'ydir', 'reverse') %! xlabel ('semilogy (a, abs (b))') %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! a = logspace (-5, 1, 10); %! b = logspace (-5, 1, 10); %! semilogy (a, b) @@ -93,8 +93,8 @@ %! end_unwind_protect %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! a = logspace (-5, 1, 10); %! b =-logspace (-5, 1, 10); %! semilogy (a, b)
--- a/scripts/plot/surface.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/surface.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 @@ -158,4 +165,21 @@ ## Mark file as being tested. Tests for surface are in ## surf.m, surfc.m, surfl.m, and pcolor.m -%!assert(1) + +%!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/text.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/text.m Tue Oct 11 14:08:38 2011 -0500 @@ -164,9 +164,9 @@ %!demo %! clf %! axis ([0 8 0 8]) -%! title (["First title";"Second title"]) -%! xlabel (["First xlabel";"Second xlabel"]) -%! ylabel (["First ylabel";"Second ylabel"]) +%! title (["1st title";"2nd title"]) +%! xlabel (["1st xlabel";"2nd xlabel"]) +%! ylabel (["1st ylabel";"2nd ylabel"]) %! text (4, 4, {"Hello", "World"}, ... %! "horizontalalignment", "center", ... %! "verticalalignment", "middle") @@ -177,10 +177,10 @@ %! h = mesh (peaks, "edgecolor", 0.7 * [1 1 1], ... %! "facecolor", "none", ... %! "facealpha", 0); -%! title (["First title";"Second title"]) -%! xlabel (["First xlabel";"Second xlabel"]) -%! ylabel (["First ylabel";"Second ylabel"]) -%! zlabel (["First zlabel";"Second zlabel"]) +%! 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") @@ -218,3 +218,33 @@ %! 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/title.m Tue Oct 11 14:08:38 2011 -0500 @@ -52,5 +52,24 @@ %! title("Testing title") %! assert(get(xl,"string"),"Testing title") -## Remove from test statistics. No real tests possible. -%!assert (1) +%!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
--- a/scripts/plot/trisurf.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/trisurf.m Tue Oct 11 14:08:38 2011 -0500 @@ -81,22 +81,22 @@ %!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")
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uicontrol.m Tue Oct 11 14:08:38 2011 -0500 @@ -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{:}); + handle = __go_uicontrol__ (h, args{:}); + endif + +endfunction
--- a/scripts/plot/uigetdir.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/uigetdir.m Tue Oct 11 14:08:38 2011 -0500 @@ -51,3 +51,7 @@ %!demo %! uigetdir(pwd, "Select Directory") + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/uigetfile.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/uigetfile.m Tue Oct 11 14:08:38 2011 -0500 @@ -159,3 +159,7 @@ %!demo %! uigetfile({"*.gif;*.png;*.jpg", "Supported Picture Formats"}) + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/uimenu.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/uimenu.m Tue Oct 11 14:08:38 2011 -0500 @@ -108,3 +108,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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/plot/uipanel.m Tue Oct 11 14:08:38 2011 -0500 @@ -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{:}); + handle = __go_uipanel__ (h, args{:}); + +endfunction
--- a/scripts/plot/uiputfile.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/uiputfile.m Tue Oct 11 14:08:38 2011 -0500 @@ -96,3 +96,7 @@ %!demo %! uiputfile({"*.gif;*.png;*.jpg", "Supported Picture Formats"}) + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1);
--- a/scripts/plot/view.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/view.m Tue Oct 11 14:08:38 2011 -0500 @@ -95,9 +95,8 @@ endfunction %!test -%! fign = 1232; -%! hf = figure (fign, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! plot3 ([0,1], [0,1], [0,1]); %! [az, el] = view; %! assert ([az, el], [-37.5, 30], eps); @@ -112,9 +111,8 @@ %! end_unwind_protect %!test -%! fign = 1232; -%! hf = figure (fign, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! line; %! [az, el] = view; %! assert ([az, el], [0, 90], eps);
--- a/scripts/plot/whitebg.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/whitebg.m Tue Oct 11 14:08:38 2011 -0500 @@ -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) @@ -147,21 +147,18 @@ %!test %! dac = get (0, "defaultaxescolor"); %! dfc = get (0, "defaultfigurecolor"); -%! set (0, "defaultaxescolor", [1 1 1]); -%! set (0, "defaultfigurecolor", [1 1 1]); -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! l = line; -%! assert (get (hf, "color"), [1 1 1]); -%! assert (get (gca, "color"), [1 1 1]); -%! whitebg; -%! assert (get (hf, "color"), [0 0 0]); -%! assert (get (gca, "color"), [0 0 0]); -%! whitebg([0.2 0.2 0.2]) -%! assert (get (hf, "color"), [0 0 0]); -%! assert (get (gca, "color"), [0.2 0.2 0.2]); +%! 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); -%! set (0, "defaultaxescolor", dac); -%! set (0, "defaultfigurecolor", dfc); %! end_unwind_protect
--- a/scripts/plot/xlabel.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/xlabel.m Tue Oct 11 14:08:38 2011 -0500 @@ -53,3 +53,15 @@ 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/xlim.m Tue Oct 11 14:08:38 2011 -0500 @@ -75,8 +75,8 @@ %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! 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); @@ -86,8 +86,8 @@ %! end_unwind_protect %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! 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");
--- a/scripts/plot/ylabel.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/ylabel.m Tue Oct 11 14:08:38 2011 -0500 @@ -47,3 +47,15 @@ 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/ylim.m Tue Oct 11 14:08:38 2011 -0500 @@ -74,8 +74,8 @@ %! assert (ylim ("mode"), "auto"); %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! limy = [0, 1.1]; %! plot3 ([0,1], [0,1], [0,1]); %! ylim (limy); @@ -86,8 +86,8 @@ %! end_unwind_protect %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! 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");
--- a/scripts/plot/zlabel.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/zlabel.m Tue Oct 11 14:08:38 2011 -0500 @@ -47,3 +47,28 @@ 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/plot/zlim.m Tue Oct 11 14:08:38 2011 -0500 @@ -74,8 +74,8 @@ %! assert (zlim ("mode"), "auto"); %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! hf = figure ("visible", "off"); +%! unwind_protect %! limz = [0, 1.1]; %! plot3 ([0,1], [0,1], [0,1]); %! zlim (limz); @@ -86,8 +86,8 @@ %! end_unwind_protect %!test -%! hf = figure (1232, "visible", "off"); -%! unwind_protect +%! 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");
--- a/scripts/polynomial/conv.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/conv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/mkpp.m Tue Oct 11 14:08:38 2011 -0500 @@ -22,21 +22,21 @@ ## ## 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 +## 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 +## When @var{m} is the polynomial order @var{coefs} must be of ## size: @var{ni} x @var{m} + 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 +## over the @var{i}-th interval, ordered from highest (@var{m}) to ## lowest (@var{0}). ## ## @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}. +## 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})] } ## @@ -72,7 +72,7 @@ if (nargin == 3) pp.dim = d; pp.order /= prod (d); - endif + endif dim_vec = [pp.pieces * prod(pp.dim), pp.order]; pp.coefs = reshape (P, dim_vec);
--- a/scripts/polynomial/polyfit.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/polyfit.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/polygcd.m Tue Oct 11 14:08:38 2011 -0500 @@ -95,7 +95,7 @@ %!test %! assert (deconv (poly(1:8), polygcd (poly(1:8), poly(3:12))), poly(1:2), sqrt (eps)) -%!test +%!test %! for ii=1:10 %! p = (unique (randn (10, 1)) * 10).'; %! p1 = p(3:end);
--- a/scripts/polynomial/ppder.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/ppder.m Tue Oct 11 14:08:38 2011 -0500 @@ -32,7 +32,7 @@ m = 1; endif - if !(isstruct (pp) && strcmp (pp.form, "pp")) + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppder: PP must be a structure"); endif
--- a/scripts/polynomial/ppint.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/ppint.m Tue Oct 11 14:08:38 2011 -0500 @@ -28,7 +28,7 @@ if (nargin < 1 || nargin > 2) print_usage (); endif - if (! isstruct (pp) && strcmp (pp.form, "pp")) + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppint: PP must be a structure"); endif @@ -48,7 +48,7 @@ tmp = -cumsum (ppjumps (ppi), length (d) + 1); ppi.coefs(prod(d)+1:end, k) = tmp(:); - + endfunction %!shared x,y,pp,ppi
--- a/scripts/polynomial/ppjumps.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/ppjumps.m Tue Oct 11 14:08:38 2011 -0500 @@ -28,8 +28,8 @@ if (nargin != 1) print_usage (); endif - - if (! isstruct (pp) && strcmp (pp.form, "pp")) + + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) error ("ppjumps: PP must be a structure"); endif @@ -52,7 +52,7 @@ llim .*= dx; llim += shiftdim (reshape (P(1:(n-1) * prod (d), i), [d, n-1]), nd - 1); endfor - + rlim = shiftdim (ppval (pp, x(2:end-1)), nd - 1); jumps = shiftdim (rlim - llim, 1); endfunction
--- a/scripts/polynomial/ppval.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/ppval.m Tue Oct 11 14:08:38 2011 -0500 @@ -18,12 +18,12 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{yi} =} ppval (@var{pp}, @var{xi}) -## Evaluate piece-wise polynomial structure @var{pp} at the points @var{xi}. +## 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. +## multi-dimensional array. ## ##, the dimensions are permuted as ## in interp1, to @@ -37,19 +37,19 @@ if (nargin != 2) print_usage (); endif - if (! isstruct (pp) && strcmp (pp.form, "pp")) - error ("ppval: expects a pp-form structure"); + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) + error ("ppval: first argument must be a pp-form structure"); endif ## Extract info. [x, P, n, k, d] = unmkpp (pp); - + ## dimension checks sxi = size (xi); if (isvector (xi)) xi = xi(:).'; endif - + nd = length (d); ## Determine intervals. @@ -60,7 +60,7 @@ 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); @@ -69,7 +69,7 @@ Pidx = reshape (Pidx, [sxi, k, d]); Pidx = shiftdim (Pidx, length (sxi)); dimvec = [d, sxi]; - end + endif ndv = length (dimvec); ## Offsets. @@ -83,12 +83,12 @@ if (k > 1) yi = shiftdim (reshape (Pidx(1,:), dimvec), ndv - 1); endif - + for i = 2 : k; yi .*= dx; yi += shiftdim (reshape (Pidx(i,:), dimvec), ndv - 1); endfor - + ## Adjust shape. if ((numel (xi) > 1) || (length (d) == 1)) yi = reshape (shiftdim (yi, 1), dimvec); @@ -104,7 +104,7 @@ #if (d == 1) # yi = reshape (yi, sxi); #endif - + endfunction %!shared b,c,pp,pp2,xi,abserr
--- a/scripts/polynomial/residue.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/polynomial/residue.m Tue Oct 11 14:08:38 2011 -0500 @@ -19,8 +19,10 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{r}, @var{p}, @var{k}, @var{e}] =} residue (@var{b}, @var{a}) -## Compute the partial fraction expansion for the quotient of the -## polynomials, @var{b} and @var{a}. +## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}) +## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}, @var{e}) +## The first calling form computes the partial fraction expansion for the +## quotient of the polynomials, @var{b} and @var{a}. ## @tex ## $$ ## {B(s)\over A(s)} = \sum_{m=1}^M {r_m\over (s-p_m)^e_m} @@ -77,12 +79,11 @@ ## ## @end ifnottex ## -## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}) -## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}, @var{e}) -## Compute the reconstituted quotient of polynomials, -## @var{b}(s)/@var{a}(s), from the partial fraction expansion; -## represented by the residues, poles, and a direct polynomial specified -## by @var{r}, @var{p} and @var{k}, and the pole multiplicity @var{e}. +## The second calling form performs the inverse operation and computes +## the reconstituted quotient of polynomials, @var{b}(s)/@var{a}(s), +## from the partial fraction expansion; represented by the residues, +## poles, and a direct polynomial specified by @var{r}, @var{p} and +## @var{k}, and the pole multiplicity @var{e}. ## ## If the multiplicity, @var{e}, is not explicitly specified the multiplicity is ## determined by the function @code{mpoles}. @@ -409,3 +410,22 @@ %! [br, ar] = residue (r, p, k); %! assert ((abs (br - b) < 1e-12 %! && abs (ar - a) < 1e-12)); + +## The following test is due to Bernard Grung (bug #34266) +%!xtest +%! z1 = 7.0372976777e6; +%! p1 = -3.1415926536e9; +%! p2 = -4.9964813512e8; +%! r1 = -(1 + z1/p1)/(1 - p1/p2)/p2/p1; +%! r2 = -(1 + z1/p2)/(1 - p2/p1)/p2/p1; +%! r3 = (1 + (p2 + p1)/p2/p1*z1)/p2/p1; +%! r4 = z1/p2/p1; +%! r = [r1; r2; r3; r4]; +%! p = [p1; p2; 0; 0]; +%! k = []; +%! e = [1; 1; 1; 2]; +%! b = [1, z1]; +%! a = [1, -(p1 + p2), p1*p2, 0, 0]; +%! [br, ar] = residue (r, p, k, e); +%! assert (br, b, 1e-8); +%! assert (ar, a, 1e-8);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/addpref.m Tue Oct 11 14:08:38 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/getpref.m Tue Oct 11 14:08:38 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/ispref.m Tue Oct 11 14:08:38 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/module.mk Tue Oct 11 14:08:38 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/private/loadprefs.m Tue Oct 11 14:08:38 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/private/prefsfile.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/>. + +## -*- texinfo -*- +## @deftypefn {Function File} {} prefsfile () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = prefsfile () + + retval = "~/.octave-prefs"; + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/private/saveprefs.m Tue Oct 11 14:08:38 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/rmpref.m Tue Oct 11 14:08:38 2011 -0500 @@ -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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/prefs/setpref.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/set/ismember.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/private/validargs.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/set/private/validargs.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/set/setxor.m Tue Oct 11 14:08:38 2011 -0500 @@ -1,4 +1,4 @@ -## Copyright (C) 2008-2011 Jaroslav Hajek +## Copyright (C) 2008-2011 Jaroslav Hajek ## Copyright (C) 2000, 2006-2007 Paul Kienzle ## ## This file is part of Octave.
--- a/scripts/signal/bartlett.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/signal/bartlett.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 @@ -60,4 +60,4 @@ %!error bartlett (); %!error bartlett (0.5); %!error bartlett (-1); -%!error bartlett (ones(1,4)); \ No newline at end of file +%!error bartlett (ones(1,4));
--- a/scripts/signal/blackman.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/signal/blackman.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/scripts/signal/detrend.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/signal/detrend.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/fftshift.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/signal/fftshift.m Tue Oct 11 14:08:38 2011 -0500 @@ -24,13 +24,15 @@ ## center of the vector or matrix. ## ## If @var{x} is a vector of @math{N} elements corresponding to @math{N} -## time samples spaced of @math{Dt} each, then @code{fftshift (fft -## (@var{x}))} corresponds to frequencies +## time samples spaced by @math{dt}, then +## @code{fftshift (fft (@var{x}))} corresponds to frequencies ## ## @example -## f = ((1:N) - ceil(N/2)) / N / Dt +## f = [ -(ceil((N-1)/2):-1:1)*df 0 (1:floor((N-1)/2))*df ] ## @end example ## +## where @math{df} = 1 / @math{dt}. +## ## If @var{x} is a matrix, the same holds for rows and columns. If ## @var{x} is an array, then the same holds along each dimension. ## @@ -44,15 +46,13 @@ function retval = fftshift (x, dim) - retval = 0; - if (nargin != 1 && nargin != 2) print_usage (); endif if (nargin == 2) - if (!isscalar (dim)) - error ("fftshift: dimension must be an integer scalar"); + if (! (isscalar (dim) && dim > 0 && dim == fix (dim))) + error ("fftshift: dimension DIM must be a positive integer"); endif nd = ndims (x); sz = size (x); @@ -82,6 +82,7 @@ endfunction + %!test %! x = [0:7]; %! y = fftshift (x);
--- a/scripts/signal/hamming.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/signal/hamming.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/scripts/signal/hanning.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/signal/hanning.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- a/scripts/signal/unwrap.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/signal/unwrap.m Tue Oct 11 14:08:38 2011 -0500 @@ -89,7 +89,7 @@ endfunction -%!function t = xassert(a,b,tol) +%!function t = __xassert(a,b,tol) %! if (nargin == 1) %! t = all(a(:)); %! else @@ -104,6 +104,7 @@ %! t = 1; %! endif %! endif +%!endfunction %! %!test %! @@ -114,18 +115,18 @@ %! 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)); %!
--- a/scripts/sparse/bicg.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/bicg.m Tue Oct 11 14:08:38 2011 -0500 @@ -15,30 +15,30 @@ ## 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 +## @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 +## @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. +## @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 +## @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 +## 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 @@ -52,7 +52,7 @@ ## @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{iter} is the number of iterations performed. ## @item @var{resvec} is a vector containing the relative residual at each iteration. ## @end itemize ## @@ -64,7 +64,7 @@ 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"); @@ -105,7 +105,7 @@ error (["bicg: preconditioner is expected to " ... "be a function or matrix"]); endif - + if (nargin < 6 || isempty (M2)) M2m1x = @(x, ignore) x; M2tm1x = M2m1x; @@ -144,44 +144,44 @@ res0 = Inf; if (any (r0 != 0)) - + for k = 1:maxit - a = (s0' * Pm1x (r0)) ./ (f' * Ax (d)); + a = (s0' * Pm1x (r0)) ./ (f' * Ax (d)); - x += a * d; - y += conj (a) * f; + x += a * d; + y += conj (a) * f; - r1 = r0 - a * Ax (d); - s1 = s0 - conj (a) * Atx (f); + r1 = r0 - a * Ax (d); + s1 = s0 - conj (a) * Atx (f); - beta = (s1' * Pm1x (r1)) ./ (s0' * Pm1x (r0)); + beta = (s1' * Pm1x (r1)) ./ (s0' * Pm1x (r0)); - d = Pm1x (r1) + beta * d; - f = Ptm1x (s1) + conj (beta) * f; + d = Pm1x (r1) + beta * d; + f = Ptm1x (s1) + conj (beta) * f; - r0 = r1; - s0 = s1; + r0 = r1; + s0 = s1; - res1 = norm (b - Ax (x)) / bnorm; - if (res1 < tol) + res1 = norm (b - Ax (x)) / bnorm; + if (res1 < tol) flag = 0; if (nargout < 2) - printf ("bicg converged at iteration %i ", k); + printf ("bicg converged at iteration %i ", k); printf ("to a solution with relative residual %e\n", res1); endif - break; - endif - - if (res0 <= res1) + break; + endif + + if (res0 <= res1) flag = 3; - printf ("bicg stopped at iteration %i ", k); + 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 + break + endif res0 = res1; if (nargout > 4) resvec(k) = res0; @@ -190,7 +190,7 @@ if (k == maxit) flag = 1; - printf ("bicg stopped at iteration %i ", maxit); + 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); @@ -203,33 +203,33 @@ printf ("bicg converged after 0 interations\n"); endif endif - + else print_usage (); endif - + endfunction; %!test -%! n = 100; +%! 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; +%! 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); +%! 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); %! %!test -%! n = 100; +%! 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; +%! 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); +%! 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); %! %! function y = afun (x, t, a) %! switch t @@ -240,15 +240,15 @@ %! endswitch %! endfunction %! -%! [x, flag, relres, iter, resvec] = bicg (@(x, t) afun (x, t, A), +%! [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; +%! n = 100; +%! tol = 1e-8; %! a = sprand (n, n, .1); %! A = a' * a + 100 * eye (n); -%! b = sum (A, 2); +%! 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/bicgstab.m Tue Oct 11 14:08:38 2011 -0500 @@ -18,7 +18,7 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## +## ## @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}, ...) @@ -34,11 +34,11 @@ ## default value @code{zeros (size (b))} is used. ## @end itemize ## -## @var{A} can be passed as a matrix or as a function handle or +## @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 +## 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 @@ -52,7 +52,7 @@ ## @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{iter} is the number of iterations performed. ## @item @var{resvec} is a vector containing the relative residual at each iteration. ## @end itemize ## @@ -60,11 +60,11 @@ ## ## @end deftypefn -function [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, +function [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, M1, M2, x0) if (nargin >= 2 && nargin <= 7 && isvector (full (b))) - + if (ischar (A)) A = str2func (A); elseif (ismatrix (A)) @@ -75,7 +75,7 @@ error (["bicgstab: first argument is expected " ... "to be a function or a square matrix"]); endif - + if (nargin < 3 || isempty (tol)) tol = 1e-6; endif @@ -96,7 +96,7 @@ error (["bicgstab: preconditioner is " ... "expected to be a function or matrix"]); endif - + if (nargin < 6 || isempty (M2)) M2m1x = @(x) x; elseif (ischar (M2)) @@ -115,7 +115,7 @@ if (nargin < 7 || isempty (x0)) x0 = zeros (size (b)); endif - + ## specifies initial estimate x0 if (nargin < 7) x = zeros (rows (b), 1); @@ -206,33 +206,33 @@ %!shared A, b, n, M1, M2 %! %!test -%! n = 100; +%! 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; +%! 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); +%! 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; +%! 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, +%! [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; +%! n = 100; +%! tol = 1e-8; %! a = sprand (n, n, .1); %! A = a'*a + 100 * eye (n); -%! b = sum (A, 2); +%! 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/cgs.m Tue Oct 11 14:08:38 2011 -0500 @@ -18,7 +18,7 @@ ## <http://www.gnu.org/licenses/>. ## -*- texinfo -*- -## +## ## @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}, ...) @@ -35,10 +35,10 @@ ## default value @code{zeros (size (b))} is used. ## @end itemize ## -## @var{A} can be passed as a matrix or as a function handle or +## @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}. +## 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}. @@ -54,7 +54,7 @@ ## @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{iter} is the number of iterations performed. ## @item @var{resvec} is a vector containing the relative residual at ## each iteration. ## @end itemize @@ -65,7 +65,7 @@ function [x, flag, relres, iter, resvec] = cgs (A, b, tol, maxit, M1, M2, x0) if (nargin >= 2 && nargin <= 7 && isvector (full (b))) - + if (ischar (A)) A = str2func (A); elseif (ismatrix (A)) @@ -73,18 +73,18 @@ elseif (isa (A, "function_handle")) Ax = @(x) feval (A, x); else - error (["cgs: first argument is expected to "... + 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 - + if (nargin < 5 || isempty (M1)) M1m1x = @(x) x; elseif (ischar (M1)) @@ -96,7 +96,7 @@ else error ("cgs: preconditioner is expected to be a function or matrix"); endif - + if (nargin < 6 || isempty (M2)) M2m1x = @(x) x; elseif (ischar (M2)) @@ -115,9 +115,9 @@ x0 = zeros (size (b)); endif - + x = x0; - + res = b - Ax (x); norm_b = norm (b); ## Vector of the residual norms for each iteration. @@ -192,27 +192,27 @@ %!shared A, b, n, M %! %!test -%! n = 100; +%! 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; +%! b = sum (A, 2); +%! tol = 1e-8; %! maxit = 1000; -%! M = 4*eye (n); +%! 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; +%! 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; +%! n = 100; +%! tol = 1e-8; %! a = sprand (n, n, .1); %! A = a'*a + 100 * eye (n); -%! b = sum (A, 2); +%! 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/gmres.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/gmres.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/>. @@ -68,9 +68,9 @@ function [x, flag, presn, it] = gmres (A, b, restart, rtol, maxit, M1, M2, x0) if (nargin < 2 || nargin > 8) - print_usage (); - end - + print_usage (); + endif + if (ischar (A)) Ax = str2func (A); elseif (ismatrix (A)) @@ -104,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)) @@ -123,57 +123,57 @@ x0 = zeros (size (b)); endif - x_old = x0; + x_old = x0; x = x_old; prec_res = Pm1x (b - Ax (x_old)); 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) = presn; prec_b_norm = norm (Pm1x (b), 2); flag = 1; 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)); presn = norm (prec_res, 2); B(1) = presn; H(:) = 0; V(:, 1) = prec_res / presn; - endif - + 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)); - + 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); presn = norm (little_res, 2); - + x = x_old + V(:, 1:restart_it) * Y(1:restart_it); - + resids(iter) = presn; if (norm (x - x_old, inf) <= eps) flag = 3; break endif - restart_it++ ; + restart_it++ ; iter++; endwhile @@ -191,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/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/module.mk Tue Oct 11 14:08:38 2011 -0500 @@ -1,5 +1,8 @@ FCN_FILE_DIRS += sparse +sparse_PRIVATE_FCN_FILES = \ + sparse/private/__sprand_impl__.m + sparse_FCN_FILES = \ sparse/bicg.m \ sparse/bicgstab.m \ @@ -24,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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scripts/sparse/private/__sprand_impl__.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/spconvert.m Tue Oct 11 14:08:38 2011 -0500 @@ -49,7 +49,7 @@ %! i = [1; 3; 5]; %! j = [2; 4; 6]; %! v = [7; 8; 9]; -%! s = spconvert ([i, j, v]); +%! s = spconvert ([i, j, v]); %! assert (issparse (s)); %! [fi, fj, fv] = find (s); %! assert (isequal (i, fi) && isequal (j, fj) && isequal (v, fv));
--- a/scripts/sparse/sprand.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/sprand.m Tue Oct 11 14:08:38 2011 -0500 @@ -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,56 +44,20 @@ 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] = find (m); - [nr, nc] = size (m); - S = sparse (i, j, rand (size (i)), 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 -## FIXME: Test for density can't happen until code of sprand is improved %!test %! s = sprand (4, 10, 0.1); %! assert (size (s), [4, 10]); -##%! assert (nnz (s) / numel (s), 0.1, .01); +%! assert (nnz (s) / numel (s), 0.1); %% Test 1-input calling form %!test
--- a/scripts/sparse/sprandn.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/sprandn.m Tue Oct 11 14:08:38 2011 -0500 @@ -27,68 +27,30 @@ ## @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 && nargin != 3) + if (nargin == 1 ) + S = __sprand_impl__ (m, @randn); + elseif ( nargin == 3) + S = __sprand_impl__ (m, n, d, "sprandn", @randn); + else print_usage (); endif - if (nargin == 1) - [i, j] = find (m); - [nr, nc] = size (m); - S = sparse (i, j, randn (size (i)), 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; - 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 - endfunction -## FIXME: Test for density can't happen until code of sprandn is improved %!test %! s = sprandn (4, 10, 0.1); %! assert (size (s), [4, 10]); -##%! assert (nnz (s) / numel (s), 0.1, .01); +%! assert (nnz (s) / numel (s), 0.1); %% Test 1-input calling form %!test
--- a/scripts/sparse/sprandsym.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/sparse/sprandsym.m Tue Oct 11 14:08:38 2011 -0500 @@ -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. @@ -48,55 +46,117 @@ endif if (!(isscalar (n) && n == fix (n) && n > 0)) - error ("sprand: N must be an integer greater than 0"); + error ("sprandsym: N must be an integer greater than 0"); endif if (d < 0 || d > 1) - error ("sprand: density D must be between 0 and 1"); + error ("sprandsym: density D must be between 0 and 1"); endif - 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 nonzero entries + k = round (n^2*d); + + ## Diagonal nonzero entries, same parity as k + r = pick_rand_diag (n, k); - ## Actual number of entries in S. - k1 = min (length (idx1), k1); - j1 = floor ((idx1(1:k1)-1)/m1); - i1 = idx1(1:k1) - j1*m1; + ## Off diagonal nonzero entries + m = (k - r)/2; + + ondiag = randperm (n, r); + offdiag = randperm (n*(n - 1)/2, m); - 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; + ## Row index + i = lookup (cumsum (0:n), offdiag - 1) + 1; + + ## Column index + j = offdiag - (i - 1).*(i - 2)/2; - 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 + 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. -## FIXME: Test for density can't happen until code of sprandsym is improved + ## 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); +%! assert (nnz (s) / numel (s), 0.1, .01); %% Test 1-input calling form %!test
--- a/scripts/specfun/factorial.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/specfun/factorial.m Tue Oct 11 14:08:38 2011 -0500 @@ -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));
--- a/scripts/specfun/nthroot.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/specfun/nthroot.m Tue Oct 11 14:08:38 2011 -0500 @@ -35,7 +35,7 @@ ## @end group ## @end example ## -## @var{x} must have all real entries. @var{n} must be a scalar. +## @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}
--- a/scripts/statistics/base/mode.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/base/mode.m Tue Oct 11 14:08:38 2011 -0500 @@ -49,7 +49,7 @@ ## Find the first non-singleton dimension. (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
--- a/scripts/statistics/base/skewness.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/base/skewness.m Tue Oct 11 14:08:38 2011 -0500 @@ -61,7 +61,7 @@ ## Find the first non-singleton dimension. (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
--- a/scripts/statistics/base/statistics.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/base/statistics.m Tue Oct 11 14:08:38 2011 -0500 @@ -48,7 +48,7 @@ ## Find the first non-singleton dimension. (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
--- a/scripts/statistics/distributions/betacdf.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/betacdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/betainv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/betapdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/betarnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/binocdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/binoinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/binopdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/binornd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/cauchy_cdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/cauchy_inv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/cauchy_pdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/cauchy_rnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/chi2cdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/chi2inv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/chi2pdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/chi2rnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/discrete_cdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/discrete_inv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/discrete_pdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/discrete_rnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/empirical_cdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/empirical_inv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/empirical_pdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/empirical_rnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/expcdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/expinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/exppdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/exprnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/fcdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/finv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/fpdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/frnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/gamcdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/gaminv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/gampdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/gamrnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/geocdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/geoinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/geopdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/geornd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/hygecdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/hygeinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/hygepdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/hygernd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/kolmogorov_smirnov_cdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/laplace_cdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/laplace_inv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/laplace_pdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/laplace_rnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/logistic_cdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/logistic_inv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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,30 +32,38 @@ print_usage (); endif - if (isa (x, 'single')) - inv = zeros (size (x), 'single'); - else - inv = zeros (size (x)); + if (iscomplex (x)) + error ("logistic_inv: X must not be complex"); endif - k = find ((x < 0) | (x > 1) | isnan (x)); - if (any (k)) - inv(k) = NaN; + if (isa (x, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); endif - k = find (x == 0); - if (any (k)) - inv(k) = -Inf; - endif + k = (x == 0); + inv(k) = -Inf; - k = find (x == 1); - if (any (k)) - inv(k) = Inf; - endif + k = (x == 1); + inv(k) = Inf; - k = find ((x > 0) & (x < 1)); - if (any (k)) - inv (k) = - log (1 ./ x(k) - 1); - endif + 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/logistic_pdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/logistic_rnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/logncdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/logninv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/lognpdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/lognrnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/nbincdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/nbininv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/nbinpdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/nbinrnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/normcdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/norminv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/normpdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/normrnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/poisscdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/poissinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/poisspdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/poissrnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/stdnormal_cdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/stdnormal_inv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/stdnormal_pdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/stdnormal_rnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/tcdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/tinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/tpdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/trnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/unidcdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/unidinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/unidpdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/unidrnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/unifcdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/unifinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/unifpdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/unifrnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/wblcdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/wblinv.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/wblpdf.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/distributions/wblrnd.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/mcnemar_test.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/statistics/tests/mcnemar_test.m Tue Oct 11 14:08:38 2011 -0500 @@ -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/strings/base2dec.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/base2dec.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/bin2dec.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/blanks.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/deblank.m Tue Oct 11 14:08:38 2011 -0500 @@ -54,9 +54,18 @@ s = s(:,1:ceil (max (k) / rows (s))); endif - elseif (iscellstr (s)) + elseif (iscell (s)) - s = regexprep (s, "[\\s\v\\0]+$", ''); + 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: S argument must be a string or cellstring"); @@ -65,11 +74,12 @@ endfunction -%!assert (strcmp (deblank (" f o o \0"), " f o o")); -%!assert (deblank (' '), '') -%!assert (deblank (" "), "") -%!assert (deblank (""), "") -%!assert (deblank ({}), {}) +%!assert (deblank (" f o o \0"), " f o o"); +%!assert (deblank (' '), ''); +%!assert (deblank (" "), ""); +%!assert (deblank (""), ""); +%!assert (deblank ({}), {}); +%!assert (deblank ({" abc ", {" def "}}), {" abc", {" def"}}); %!error <Invalid call to deblank> deblank (); %!error <Invalid call to deblank> deblank ("foo", "bar");
--- a/scripts/strings/dec2base.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/dec2base.m Tue Oct 11 14:08:38 2011 -0500 @@ -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"; @@ -93,7 +98,7 @@ ## 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 @@ -112,41 +117,45 @@ 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']); +%! 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']; +%! s0 = [s0,'0']; %! end %!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))); +%! 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 %!test -%! for b=2:16 -%! assert(dec2base(0,b),'0'); +%! for b = 2:16 +%! assert (dec2base (0, b), '0'); %! end -%!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"]); %%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")
--- a/scripts/strings/dec2bin.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/dec2bin.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/dec2hex.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/findstr.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/hex2dec.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/index.m Tue Oct 11 14:08:38 2011 -0500 @@ -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); else - n = f(end); + n = f(1); endif - elseif (strcmp (direction, "first")) + elseif (strcmp (direction, "last")) if (iscell (f)) n = cellfun ("max", f); else - n = f(1); + n = f(end); 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/mat2str.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/mat2str.m Tue Oct 11 14:08:38 2011 -0500 @@ -18,20 +18,19 @@ ## -*- texinfo -*- ## @deftypefn {Function File} {@var{s} =} mat2str (@var{x}, @var{n}) -## @deftypefnx {Function File} {@var{s} =} mat2str (@dots{}, 'class') -## +## @deftypefnx {Function File} {@var{s} =} mat2str (@var{x}, @var{n}, "class") ## Format real/complex numerical matrices as strings. This function ## returns values that are suitable for the use of 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 +## 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 @@ -42,7 +41,7 @@ ## mat2str ([ -1/3 +i/7; 1/3 -i/7 ], [4 2]) ## @result{} "[-0.3333+0i,0+0.14i;0.3333+0i,-0-0.14i]" ## -## mat2str (int16([1 -1]), 'class') +## mat2str (int16([1 -1]), "class") ## @result{} "int16([1,-1])" ## @end group ## @end example @@ -54,9 +53,16 @@ function s = mat2str (x, n, cls) + if (nargin < 1 || nargin > 3 || ! (isnumeric (x) || islogical (x))) + print_usage (); + endif + + if (ndims (x) > 2) + error ("mat2str: X must be two dimensional"); + endif + if (nargin < 2 || isempty (n)) - ## Default precision - n = 15; + n = 15; # Default precision endif if (nargin < 3) @@ -68,14 +74,6 @@ endif endif - if (nargin < 1 || nargin > 3 || ! (isnumeric (x) || islogical (x))) - print_usage (); - endif - - if (ndims (x) > 2) - error ("mat2str: X must be two dimensional"); - endif - x_islogical = islogical (x); x_iscomplex = iscomplex (x); @@ -120,21 +118,32 @@ s = cstrcat ("[", s); s(end) = "]"; - ind = find (s == ","); + idx = find (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 (true), "true"); %!assert (mat2str (false), "false"); %!assert (mat2str (logical (eye (2))), "[true,false;false,true]"); -%!assert (mat2str (0.7), "0.7") + +%% 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/regexptranslate.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/rindex.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/str2num.m Tue Oct 11 14:08:38 2011 -0500 @@ -17,31 +17,33 @@ ## <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: ## ## @example ## @group -## str2num("3.141596") -## @result{} 3.141596 +## str2num ("3.141596") +## @result{} 3.141596 ## -## str2num(["1, 2, 3"; "4, 5, 6"]); -## @result{} ans = -## 1 2 3 -## 4 5 6 +## str2num (["1, 2, 3"; "4, 5, 6"]); +## @result{} ans = +## 1 2 3 +## 4 5 6 ## @end group ## @end example ## ## The optional second output, @var{state}, is logically true when the -## coversion is successful. If the conversion fails the numeric output, -## @var{n}, is empty and @var{state} is false. +## 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} instead if you want to -## avoid the use of @code{eval}. +## 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,37 @@ 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 (); endif + + if (! ischar (s)) + error ("str2num: S must be a string or string array"); + endif + + [nr, nc] = size (s); + sep = repmat (";", nr, 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 endfunction -%!assert(str2num ("-1.3e2") == -130 && str2num ("[1, 2; 3, 4]") == [1, 2; 3, 4]); + +%!assert(str2num ("-1.3e2"), -130); +%!assert(str2num ("[1, 2; 3, 4]"), [1, 2; 3, 4]); -%!error str2num (); - -%!error str2num ("string", 1); +%% Test input validation +%!error str2num () +%!error str2num ("string", 1) +%!error str2num ({"string"}) %!test %! [x, state] = str2num ("pi"); -%! assert (state) +%! assert (state); %! [x, state] = str2num (tmpnam); -%! assert (! state) +%! assert (! state);
--- a/scripts/strings/strmatch.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/strmatch.m Tue Oct 11 14:08:38 2011 -0500 @@ -27,7 +27,7 @@ ## @var{s} only needs to match @var{A} up to the length of @var{s}. ## Trailing spaces and nulls in @var{s} and @var{A} are ignored when matching. ## option. -## +## ## For example: ## ## @example
--- a/scripts/strings/strtrim.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/strtrim.m Tue Oct 11 14:08:38 2011 -0500 @@ -54,9 +54,18 @@ s = s(:, ceil (min (k) / rows (s)):ceil (max (k) / rows (s))); endif - elseif (iscellstr (s)) + elseif (iscell (s)) - s = regexprep (s, "^[\\s\v]+|[\\s\v]+$", ''); + 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 or cellstring"); @@ -70,6 +79,7 @@ %!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");
--- a/scripts/strings/strtrunc.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/strtrunc.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/substr.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/strings/untabify.m Tue Oct 11 14:08:38 2011 -0500 @@ -57,13 +57,13 @@ 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
--- a/scripts/testfun/demo.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/testfun/demo.m Tue Oct 11 14:08:38 2011 -0500 @@ -97,7 +97,7 @@ n = 0; elseif (ischar (n)) n = str2double (n); - endif + endif [code, idx] = test (name, "grabdemo"); if (isempty (idx))
--- a/scripts/testfun/example.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/testfun/example.m Tue Oct 11 14:08:38 2011 -0500 @@ -45,7 +45,7 @@ n = 0; elseif (ischar (n)) n = str2double (n); - endif + endif [code, idx] = test (name, "grabdemo"); if (nargout > 0)
--- a/scripts/testfun/speed.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/testfun/speed.m Tue Oct 11 14:08:38 2011 -0500 @@ -30,10 +30,10 @@ ## ## @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]}. ## @@ -60,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} @@ -68,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 ## @@ -117,7 +117,7 @@ ## @example ## @group ## speed ("sum (x)", "", [10000, 100000], ... -## "v = 0; for i = 1:length (x), v += x(i); end") +## "v = 0; for i = 1:length (x), v += x(i); endfor") ## @end group ## @end example ## @@ -137,38 +137,28 @@ ## ## 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; @@ -179,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. @@ -199,60 +190,75 @@ 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); if (do_display) - printf ("n%i = %i ",k, n); + printf ("n%i = %i ", k, n); fflush (stdout); endif - eval (cstrcat ("__t = time();", __f1, "; __v1=ans; __t = time()-__t;")); + + 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); @@ -261,19 +267,32 @@ if (do_display) figure; + ## Strip semicolon added to code fragments before displaying + __init(end) = ""; + __f1(end) = ""; + if (! isempty (__f2)) + __f2(end) = ""; + endif endif - if (do_display && ! 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); @@ -281,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 (do_display) - - loglog (__test_n, __tnew*1000, "*-g;execution time;"); - xlabel ("test length"); - ylabel ("best execution time (ms)"); - title (cstrcat (__f1, " init: ", __init)); - endif 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)); @@ -320,75 +340,78 @@ time = sprintf ("%g ns", dt*1e9); endif - if (do_display) - ## Display nicely formatted complexity. - printf ("\nFor %s:\n", __f1); - printf (" asymptotic power: %s\n", order); - printf (" approximate time per operation: %s\n", time); - endif + ## Display nicely formatted complexity. + printf ("\nFor %s:\n", __f1); + printf (" asymptotic power: %s\n", order); + printf (" approximate time per operation: %s\n", time); endif 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 -%! -%! disp("-----------------------"); -%! type build_orig; -%! disp("-----------------------"); -%! type 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 -%!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 +%% 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 ("-----------------------"); +%! 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 ("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 +%! 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("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 - -%!error speed (); -%!error speed (1, 2, 3, 4, 5, 6, 7); +%! 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 ("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]); @@ -396,20 +419,26 @@ %! assert (size (order), [1, 1]); %! assert (fieldnames (order), {"p"; "a"}); %! assert (isnumeric (n)); -%! assert (size (n), [1, 15]); -%! assert (isnumeric (T_f1)); -%! assert (size (T_f1), [1, 15]); +%! assert (length (n) > 10); %! assert (isnumeric (T_f1)); -%! assert (size (T_f2), [1, 15]); +%! assert (size (T_f1), size (n)); +%! assert (isnumeric (T_f2)); +%! assert (length (T_f2) > 10); -%!test -%! [order, n, T_f1, T_f2] = speed ("sum (x)", "", [100, 1000], "v = 0; for i = 1:length (x), v += x(i); end"); +%% 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 (size (n), [1, 15]); +%! assert (length (n) > 10); %! assert (isnumeric (T_f1)); -%! assert (size (T_f1), [1, 15]); -%! assert (isnumeric (T_f1)); -%! assert (size (T_f2), [1, 15]); +%! 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/testfun/test.m Tue Oct 11 14:08:38 2011 -0500 @@ -364,6 +364,14 @@ 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")) @@ -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/weekday.m Wed Oct 05 02:19:28 2011 +0200 +++ b/scripts/time/weekday.m Tue Oct 11 14:08:38 2011 -0500 @@ -61,7 +61,7 @@ if (nargout > 1) if (strcmpi (format, "long")) - names = {"Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" + names = {"Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" \ "Friday" "Saturday"}; else names = {"Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"}; @@ -96,6 +96,12 @@ %!assert(weekday('7-Feb-2008'),5) ## Test fractional dates %!assert(weekday(728647.1),2) +## Test "long" option +%!test +%! [a, b] = weekday ("25-Dec-1994", "long"); +%! assert (a, 1); +%! assert (b, "Sunday"); + # demos %!demo %! [n, s] = weekday (now ())
--- a/src/DLD-FUNCTIONS/__init_fltk__.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/__init_fltk__.cc Tue Oct 11 14:08:38 2011 -0500 @@ -1789,6 +1789,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"))
--- a/src/DLD-FUNCTIONS/__voronoi__.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/__voronoi__.cc Tue Oct 11 14:08:38 2011 -0500 @@ -73,20 +73,25 @@ return retval; } - const char *options; + std::string options = "qhull v Fv T0"; if (nargin == 2) { - if (! args (1).is_string ()) + if (args(1).is_cellstr ()) { - error ("__voronoi__: OPTIONS argument must be a string"); + Array<std::string> tmp = args(1).cellstr_value (); + + for (octave_idx_type i = 0; i < tmp.numel (); i++) + options += " " + tmp(i); + } + else if (args(1).is_string ()) + options += " " + args(1).string_value (); + else + { + error ("__voronoi__: OPTIONS argument must be a string or cellstr"); return retval; } - - options = args (1).string_value().c_str (); } - else - options = ""; Matrix p (args(0).matrix_value ()); @@ -107,17 +112,17 @@ 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. FILE *outfile = 0; FILE *errfile = stderr; + // Qhull flags argument is not const char*... + OCTAVE_LOCAL_BUFFER (char, flags, options.length () + 1); + + strcpy (flags, options.c_str ()); + if (! qh_new_qhull (dim, np, pt_array, ismalloc, flags, outfile, errfile)) { facetT *facet;
--- a/src/DLD-FUNCTIONS/ccolamd.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/ccolamd.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/cellfun.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 @@ -76,11 +77,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) @@ -93,6 +99,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\ @@ -235,130 +390,49 @@ 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; + } - 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 ()) { - // 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 ()) @@ -368,6 +442,7 @@ // 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; } @@ -376,57 +451,18 @@ if (f.is_defined ()) func = f; } - nevermind: - unwind_protect frame; - frame.protect_var (buffer_error_messages); + 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 ()); @@ -440,8 +476,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++) { @@ -475,9 +511,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); @@ -486,7 +527,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++) { @@ -494,59 +535,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; + } + } } } } @@ -557,6 +610,7 @@ } retval.resize (nargout1); + for (int j = 0; j < nargout1; j++) { if (nargout > 0 && retv[j].is_undefined ()) @@ -568,10 +622,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++) { @@ -579,31 +636,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 @@ -614,6 +683,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)); @@ -883,6 +981,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,
--- a/src/DLD-FUNCTIONS/colamd.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/colamd.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/conv2.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/conv2.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/eigs.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/eigs.cc Tue Oct 11 14:08:38 2011 -0500 @@ -335,7 +335,6 @@ ColumnVector resid; ComplexColumnVector cresid; octave_idx_type info = 1; - char bmat = 'I'; warned_imaginary = false; @@ -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++; } }
--- a/src/DLD-FUNCTIONS/filter.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/filter.cc Tue Oct 11 14:08:38 2011 -0500 @@ -727,7 +727,7 @@ %! x(1,1,:,:) = [1 2 3 4; 5 6 7 8; 9 10 11 12]; %! y0 = [1 1 6 2 15 3 2 1 8 2 18 3 3 1 10 2 21 3 4 1 12 2 24 3]; %! y0 = reshape (y0, size (x)); -%! y = filter([1 1 1], 1, x, [], 3); +%! y = filter([1 1 1], 1, x, [], 3); %! assert (y, y0); */
--- a/src/DLD-FUNCTIONS/find.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/find.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/hex2num.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/hex2num.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/mgorth.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/mgorth.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/quadcc.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/quadcc.cc Tue Oct 11 14:08:38 2011 -0500 @@ -1569,7 +1569,7 @@ /* 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]; @@ -1636,7 +1636,7 @@ else { nivals = 1 + args(4).length (); - if (nivals > cquad_heapsize) + if (nivals > cquad_heapsize) { error ("quadcc: maximum number of singular points is limited to %i", cquad_heapsize-1); @@ -1766,7 +1766,6 @@ /* Initialize some global values. */ igral_final = 0.0; err_final = 0.0; - err_excess = 0.0; /* Main loop. */ @@ -2243,7 +2242,7 @@ } -/* +/* %!assert (quadcc(@sin,-pi,pi), 0, 1e-6) %!assert (quadcc(inline('sin'),-pi,pi), 0, 1e-6)
--- a/src/DLD-FUNCTIONS/rand.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/rand.cc Tue Oct 11 14:08:38 2011 -0500 @@ -26,7 +26,7 @@ #endif #include <ctime> - +#include <tr1/unordered_map> #include <string> #include "f77-fcn.h" @@ -1019,10 +1019,11 @@ @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") { @@ -1033,54 +1034,76 @@ { 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; + std::tr1::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)); @@ -1093,6 +1116,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/regexp.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/regexp.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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,79 @@ 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)) + error ("%s: unrecognized option", nm.c_str ()); } if (!error_state) @@ -187,11 +189,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 +204,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 +213,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 +258,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 +272,7 @@ brackets--; } + tmp_pos1++; } @@ -274,17 +284,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 +305,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 +316,7 @@ } else buf << pattern.substr (pos, tmp_pos1 - pos); + pos = tmp_pos1; } } @@ -314,27 +328,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,58 +358,63 @@ 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) @@ -409,58 +428,64 @@ 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 +498,7 @@ } } - pcre_free(re); + pcre_free (re); } return sz; @@ -484,11 +509,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) @@ -500,53 +526,63 @@ 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(); + retval(4) = sz ? lst.front ().t : Cell (); else { - Cell t (dim_vector(1, sz)); + Cell t (dim_vector (1, sz)); + i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) + 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(); + retval(3) = sz ? lst.front ().m : std::string (); else { - Cell m (dim_vector(1, sz)); + Cell m (dim_vector (1, sz)); + i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) + 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(); + retval(2) = sz ? lst.front ().te : Matrix (); else { - Cell te (dim_vector(1, sz)); + Cell te (dim_vector (1, sz)); + i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) + for (const_iterator p = lst.begin (); p != lst.end (); p++) te(i++) = p->te; + retval(2) = te; } @@ -555,14 +591,16 @@ if (sz) retval(1) = lst.front ().e; else - retval(1) = Matrix(); + retval(1) = Matrix (); } else { - NDArray e (dim_vector(1, sz)); + NDArray e (dim_vector (1, sz)); + i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) + for (const_iterator p = lst.begin (); p != lst.end (); p++) e(i++) = p->e; + retval(1) = e; } @@ -571,15 +609,16 @@ if (sz) retval(0) = lst.front ().s; else - retval(0) = Matrix(); + retval(0) = Matrix (); } else { - NDArray s (dim_vector(1, sz)); + NDArray s (dim_vector (1, sz)); i = 0; - for (const_iterator p = lst.begin(); p != lst.end(); p++) + for (const_iterator p = lst.begin (); p != lst.end (); p++) s(i++) = p->s; + retval(0) = s; } @@ -588,7 +627,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,30 +636,30 @@ 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; new_retval(n++) = retval(k); @@ -648,24 +687,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 +721,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 +741,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 +773,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 +793,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 +816,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); @@ -975,11 +1018,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); @@ -1171,11 +1215,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,25 +1366,33 @@ 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") @@ -1347,24 +1400,26 @@ 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 +1428,7 @@ // Perform replacement std::string rep; + if (tokens > 0) { std::list<regexp_elem> lst; @@ -1390,56 +1446,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 +1505,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 +1528,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 +1597,7 @@ @end deftypefn") { octave_value_list retval; - int nargin = args.length(); + int nargin = args.length (); if (nargin < 3) { @@ -1549,56 +1605,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");
--- a/src/DLD-FUNCTIONS/schur.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/schur.cc Tue Oct 11 14:08:38 2011 -0500 @@ -60,8 +60,10 @@ DEFUN_DLD (schur, args, nargout, "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {@var{S} =} schur (@var{A})\n\ +@deftypefnx {Loadable Function} {@var{S} =} schur (@var{A}, \"real\")\n\ @deftypefnx {Loadable Function} {@var{S} =} schur (@var{A}, \"complex\")\n\ -@deftypefnx {Loadable Function} {[@var{U}, @var{S}] =} schur (@var{A}, @var{opt})\n\ +@deftypefnx {Loadable Function} {@var{S} =} schur (@var{A}, @var{opt})\n\ +@deftypefnx {Loadable Function} {[@var{U}, @var{S}] =} schur (@var{A}, @dots{})\n\ @cindex Schur decomposition\n\ Compute the Schur@tie{}decomposition of @var{A}\n\ @tex\n\ @@ -104,7 +106,8 @@ @end ifnottex\n\ blocks, when appropriate) are the eigenvalues of @var{A} and @var{S}.\n\ \n\ -A complex decomposition may be forced by passing \"complex\" as @var{opt}.\n\ +The default for real matrices is a real Schur@tie{}decomposition.\n\ +A complex decomposition may be forced by passing the flag \"complex\".\n\ \n\ The eigenvalues are optionally ordered along the diagonal according to\n\ the value of @var{opt}. @code{@var{opt} = \"a\"} indicates that all\n\ @@ -150,7 +153,11 @@ bool force_complex = false; - if (ord == "complex") + if (ord == "real") + { + ord = std::string (); + } + else if (ord == "complex") { force_complex = true; ord = std::string ();
--- a/src/DLD-FUNCTIONS/str2double.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/DLD-FUNCTIONS/str2double.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/Makefile.am Wed Oct 05 02:19:28 2011 +0200 +++ b/src/Makefile.am Tue Oct 11 14:08:38 2011 -0500 @@ -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 \ @@ -568,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
--- a/src/OPERATORS/op-cell.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/OPERATORS/op-cell.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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-fcm-fcm.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/OPERATORS/op-fcm-fcm.cc Tue Oct 11 14:08:38 2011 -0500 @@ -214,7 +214,9 @@ DEFNDASSIGNOP_FN (assign, float_complex_matrix, float_complex_matrix, float_complex_array, assign) -DEFNDASSIGNOP_FN (dbl_assign, float_complex_matrix, complex_matrix, +DEFNDASSIGNOP_FN (dbl_clx_assign, float_complex_matrix, complex_matrix, + float_complex_array, assign) +DEFNDASSIGNOP_FN (dbl_assign, float_complex_matrix, matrix, float_complex_array, assign) DEFNULLASSIGNOP_FN (null_assign, float_complex_matrix, delete_elements) @@ -308,7 +310,9 @@ INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_float_complex_matrix, assign); INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, - octave_complex_matrix, dbl_assign); + octave_complex_matrix, dbl_clx_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, + octave_matrix, dbl_assign); INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_null_matrix, null_assign);
--- a/src/OPERATORS/op-m-s.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/OPERATORS/op-m-s.cc Tue Oct 11 14:08:38 2011 -0500 @@ -29,6 +29,7 @@ #include "ov.h" #include "ov-re-mat.h" #include "ov-flt-re-mat.h" +#include "ov-flt-cx-mat.h" #include "ov-scalar.h" #include "ov-typeinfo.h" #include "ops.h" @@ -106,6 +107,7 @@ DEFNDASSIGNOP_FN (assign, matrix, scalar, scalar, assign) DEFNDASSIGNOP_FN (sgl_assign, float_matrix, scalar, float_scalar, assign) +DEFNDASSIGNOP_FN (clx_sgl_assign, float_complex_matrix, scalar, float_complex, assign) DEFNDASSIGNOP_OP (assign_add, matrix, scalar, scalar, +=) DEFNDASSIGNOP_OP (assign_sub, matrix, scalar, scalar, -=) @@ -144,6 +146,7 @@ INSTALL_ASSIGNOP (op_asn_eq, octave_matrix, octave_scalar, assign); INSTALL_ASSIGNOP (op_asn_eq, octave_float_matrix, octave_scalar, sgl_assign); + INSTALL_ASSIGNOP (op_asn_eq, octave_float_complex_matrix, octave_scalar, clx_sgl_assign); INSTALL_ASSIGNOP (op_add_eq, octave_matrix, octave_scalar, assign_add); INSTALL_ASSIGNOP (op_sub_eq, octave_matrix, octave_scalar, assign_sub);
--- a/src/data.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/data.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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" @@ -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\
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/data.h Tue Oct 11 14:08:38 2011 -0500 @@ -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/file-io.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/file-io.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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/genprops.awk Wed Oct 05 02:19:28 2011 +0200 +++ b/src/genprops.awk Tue Oct 11 14:08:38 2011 -0500 @@ -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,7 @@ 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" \ - || type[i] == "text_label_property") + 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"); @@ -318,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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/gl-render.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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,18 @@ 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")) + /* 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 +588,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 +639,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 @@ -849,7 +882,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 @@ -1074,7 +1107,7 @@ int wmax = 0, hmax = 0; bool tick_along_z = nearhoriz || xisinf (fx); bool mirror = props.is_box () && ystate != AXE_ANY_DIR - && (props.get_tag () != "plotyy"); + && (! props.has_property ("__plotyy_axes__")); set_color (props.get_ycolor_rgb ()); @@ -1270,7 +1303,7 @@ yPlaneN, yPlaneN, signum(xPlane-xPlaneN)*fx*zticklen/2, 0., 0., 2, false); - } + } } gh_manager::get_object (props.get_zlabel ()).set ("visible", "on"); @@ -2374,7 +2407,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 ())); } } @@ -2449,7 +2482,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 (); @@ -2593,16 +2625,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); }
--- a/src/gl-render.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/gl-render.h Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/gl2ps-renderer.cc Tue Oct 11 14:08:38 2011 -0500 @@ -230,7 +230,7 @@ std::string s = sv.join ("\n"); - gl2psTextOpt (s.c_str (), fontname.c_str (), fontsize, + gl2psTextOpt (s.c_str (), fontname.c_str (), fontsize, alignment_to_mode (halign, valign), props.get_rotation ()); }
--- a/src/gl2ps.c Wed Oct 05 02:19:28 2011 +0200 +++ b/src/gl2ps.c Tue Oct 11 14:08:38 2011 -0500 @@ -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: @@ -50,7 +50,7 @@ #include <png.h> #endif -/********************************************************************* +/********************************************************************* * * Private definitions, data structures and prototypes * @@ -167,6 +167,7 @@ written to the file or not, and 'format' indicates if it is visible or not */ GLenum format, type; + GLfloat zoom_x, zoom_y; GLfloat *pixels; } GL2PSimage; @@ -227,7 +228,7 @@ GLboolean zerosurfacearea; GL2PSbsptree2d *imagetree; GL2PSprimitive *primitivetoadd; - + /* PDF-specific */ int streamlength; GL2PSlist *pdfprimlist, *pdfgrouplist; @@ -265,7 +266,7 @@ static GLint gl2psPrintPrimitives(void); -/********************************************************************* +/********************************************************************* * * Utility routines * @@ -282,7 +283,7 @@ case GL2PS_ERROR : fprintf(stderr, "GL2PS error: "); break; } va_start(args, fmt); - vfprintf(stderr, fmt, args); + vfprintf(stderr, fmt, args); va_end(args); fprintf(stderr, "\n"); } @@ -304,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; @@ -319,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; } @@ -359,16 +362,16 @@ static int gl2psAllocCompress(unsigned int srcsize) { gl2psFreeCompress(); - + if(!gl2ps->compress || !srcsize) return GL2PS_ERROR; - + gl2ps->compress->srcLen = srcsize; gl2ps->compress->destLen = (int)ceil(1.001 * gl2ps->compress->srcLen + 12); gl2ps->compress->src = (Bytef*)gl2psMalloc(gl2ps->compress->srcLen); gl2ps->compress->start = gl2ps->compress->src; gl2ps->compress->dest = (Bytef*)gl2psMalloc(gl2ps->compress->destLen); - + return GL2PS_SUCCESS; } @@ -376,25 +379,25 @@ { if(!gl2ps->compress || !srcsize) return NULL; - + if(srcsize < gl2ps->compress->srcLen) return gl2ps->compress->start; - + gl2ps->compress->srcLen = srcsize; gl2ps->compress->destLen = (int)ceil(1.001 * gl2ps->compress->srcLen + 12); - gl2ps->compress->src = (Bytef*)gl2psRealloc(gl2ps->compress->src, + gl2ps->compress->src = (Bytef*)gl2psRealloc(gl2ps->compress->src, gl2ps->compress->srcLen); gl2ps->compress->start = gl2ps->compress->src; - gl2ps->compress->dest = (Bytef*)gl2psRealloc(gl2ps->compress->dest, + gl2ps->compress->dest = (Bytef*)gl2psRealloc(gl2ps->compress->dest, gl2ps->compress->destLen); - + 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; @@ -406,8 +409,8 @@ { /* For compatibility with older zlib versions, we use compress(...) instead of compress2(..., Z_BEST_COMPRESSION) */ - return compress(gl2ps->compress->dest, &gl2ps->compress->destLen, - gl2ps->compress->start, gl2ps->compress->srcLen); + return compress(gl2ps->compress->dest, &gl2ps->compress->destLen, + gl2ps->compress->start, gl2ps->compress->srcLen); } #endif @@ -440,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 */ @@ -455,10 +458,10 @@ /* add the gzip file header */ fwrite(tmp, 10, 1, gl2ps->stream); } -#endif -} - -static void gl2psPrintGzipFooter() +#endif +} + +static void gl2psPrintGzipFooter(void) { #if defined(GL2PS_HAVE_ZLIB) int n; @@ -476,7 +479,7 @@ n += 4; /* DICTID */ } /* write the data, without the zlib header and footer */ - fwrite(gl2ps->compress->dest+n, gl2ps->compress->destLen-(n+4), + fwrite(gl2ps->compress->dest+n, gl2ps->compress->destLen-(n+4), 1, gl2ps->stream); /* add the gzip file footer */ crc = crc32(0L, gl2ps->compress->start, gl2ps->compress->srcLen); @@ -495,7 +498,7 @@ gl2psFree(gl2ps->compress); gl2ps->compress = NULL; } -#endif +#endif } /* The list handling routines */ @@ -544,7 +547,7 @@ static void gl2psListDelete(GL2PSlist *list) { - if(!list) return; + if(!list) return; gl2psFree(list->array); gl2psFree(list); } @@ -617,7 +620,7 @@ static void gl2psEncodeBase64Block(unsigned char in[3], unsigned char out[4], int len) { - static const char cb64[] = + static const char cb64[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; out[0] = cb64[ in[0] >> 2 ]; @@ -670,7 +673,7 @@ return GL_FALSE; return GL_TRUE; } - + static GLboolean gl2psVertsSameColor(const GL2PSprimitive *prim) { int i; @@ -689,20 +692,20 @@ int i; if(n < 2) return GL_TRUE; - + for(i = 1; i < n; i++){ if(fabs(rgba[0][0] - rgba[i][0]) > threshold[0] || fabs(rgba[0][1] - rgba[i][1]) > threshold[1] || fabs(rgba[0][2] - rgba[i][2]) > threshold[2]) return GL_FALSE; } - + return GL_TRUE; } static void gl2psSetLastColor(GL2PSrgba rgba) { - int i; + int i; for(i = 0; i < 3; ++i){ gl2ps->lastrgba[i] = rgba[i]; } @@ -711,13 +714,13 @@ static GLfloat gl2psGetRGB(GL2PSimage *im, GLuint x, GLuint y, GLfloat *red, GLfloat *green, GLfloat *blue) { - + GLsizei width = im->width; GLsizei height = im->height; GLfloat *pixels = im->pixels; GLfloat *pimag; - /* OpenGL image is from down to up, PS image is up to down */ + /* OpenGL image is from down to up, PS image is up to down */ switch(im->format){ case GL_RGBA: pimag = pixels + 4 * (width * (height - 1 - y) + x); @@ -740,11 +743,13 @@ { int size; GL2PSimage *image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); - + image->width = im->width; image->height = im->height; image->format = im->format; image->type = im->type; + image->zoom_x = im->zoom_x; + image->zoom_y = im->zoom_y; switch(image->format){ case GL_RGBA: @@ -758,7 +763,7 @@ image->pixels = (GLfloat*)gl2psMalloc(size); memcpy(image->pixels, im->pixels, size); - + return image; } @@ -780,12 +785,13 @@ { unsigned int i; GL2PSlist *png = (GL2PSlist*)png_get_io_ptr(png_ptr); - for(i = 0; i < length; i++) + for(i = 0; i < length; i++) gl2psListAdd(png, &data[i]); } static void gl2psUserFlushPNG(png_structp png_ptr) { + (void) png_ptr; /* not used */ } static void gl2psConvertPixmapToPNG(GL2PSimage *pixmap, GL2PSlist *png) @@ -798,21 +804,21 @@ if(!(png_ptr = png_create_write_struct(PNG_LIBPNG_VER_STRING, NULL, NULL, NULL))) return; - + if(!(info_ptr = png_create_info_struct(png_ptr))){ png_destroy_write_struct(&png_ptr, NULL); return; } - + if(setjmp(png_jmpbuf(png_ptr))) { png_destroy_write_struct(&png_ptr, &info_ptr); return; } - + png_set_write_fn(png_ptr, (void *)png, gl2psUserWritePNG, gl2psUserFlushPNG); png_set_compression_level(png_ptr, Z_DEFAULT_COMPRESSION); - png_set_IHDR(png_ptr, info_ptr, pixmap->width, pixmap->height, 8, - PNG_COLOR_TYPE_RGB, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_BASE, + png_set_IHDR(png_ptr, info_ptr, pixmap->width, pixmap->height, 8, + PNG_COLOR_TYPE_RGB, PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_BASE, PNG_FILTER_TYPE_BASE); png_write_info(png_ptr, info_ptr); @@ -836,7 +842,7 @@ /* Helper routines for text strings */ -static GLint gl2psAddText(GLint type, const char *str, const char *fontname, +static GLint gl2psAddText(GLint type, const char *str, const char *fontname, GLshort fontsize, GLint alignment, GLfloat angle) { GLfloat pos[4]; @@ -868,7 +874,7 @@ glGetFloatv(GL_CURRENT_RASTER_COLOR, prim->verts[0].rgba); prim->data.text = (GL2PSstring*)gl2psMalloc(sizeof(GL2PSstring)); prim->data.text->str = (char*)gl2psMalloc((strlen(str)+1)*sizeof(char)); - strcpy(prim->data.text->str, str); + strcpy(prim->data.text->str, str); prim->data.text->fontname = (char*)gl2psMalloc((strlen(fontname)+1)*sizeof(char)); strcpy(prim->data.text->fontname, fontname); prim->data.text->fontsize = fontsize; @@ -877,7 +883,7 @@ gl2psListAdd(gl2ps->auxprimitives, &prim); glPassThrough(GL2PS_TEXT_TOKEN); - + return GL2PS_SUCCESS; } @@ -885,13 +891,13 @@ { GL2PSstring *text = (GL2PSstring*)gl2psMalloc(sizeof(GL2PSstring)); text->str = (char*)gl2psMalloc((strlen(t->str)+1)*sizeof(char)); - strcpy(text->str, t->str); + strcpy(text->str, t->str); text->fontname = (char*)gl2psMalloc((strlen(t->fontname)+1)*sizeof(char)); strcpy(text->fontname, t->fontname); text->fontsize = t->fontsize; text->alignment = t->alignment; text->angle = t->angle; - + return text; } @@ -911,7 +917,7 @@ /* returns TRUE if gl2ps supports the argument combination: only two blending modes have been implemented so far */ - if( (sfactor == GL_SRC_ALPHA && dfactor == GL_ONE_MINUS_SRC_ALPHA) || + if( (sfactor == GL_SRC_ALPHA && dfactor == GL_ONE_MINUS_SRC_ALPHA) || (sfactor == GL_ONE && dfactor == GL_ZERO) ) return GL_TRUE; return GL_FALSE; @@ -931,7 +937,7 @@ v->rgba[3] = 1.0F; return; } - + switch(gl2ps->blendfunc[0]){ case GL_ONE: v->rgba[3] = 1.0F; @@ -952,9 +958,9 @@ a remarkable amount of PDF handling code inside this file depends on it if activated */ /* - t->prop = T_CONST_COLOR; + t->prop = T_CONST_COLOR; for(i = 0; i < 3; ++i){ - if(!GL2PS_ZERO(t->vertex[0].rgba[i] - t->vertex[1].rgba[i]) || + if(!GL2PS_ZERO(t->vertex[0].rgba[i] - t->vertex[1].rgba[i]) || !GL2PS_ZERO(t->vertex[1].rgba[i] - t->vertex[2].rgba[i])){ t->prop = T_VAR_COLOR; break; @@ -962,7 +968,7 @@ } */ - if(!GL2PS_ZERO(t->vertex[0].rgba[3] - t->vertex[1].rgba[3]) || + if(!GL2PS_ZERO(t->vertex[0].rgba[3] - t->vertex[1].rgba[3]) || !GL2PS_ZERO(t->vertex[1].rgba[3] - t->vertex[2].rgba[3])){ t->prop |= T_VAR_ALPHA; } @@ -1005,7 +1011,7 @@ } prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); - + prim->type = p->type; prim->numverts = p->numverts; prim->boundary = p->boundary; @@ -1041,17 +1047,17 @@ return GL_TRUE; } -/********************************************************************* +/********************************************************************* * - * 3D sorting routines + * 3D sorting routines * *********************************************************************/ static GLfloat gl2psComparePointPlane(GL2PSxyz point, GL2PSplane plane) { - return (plane[0] * point[0] + - plane[1] * point[1] + - plane[2] * point[2] + + return (plane[0] * point[0] + + plane[1] * point[1] + + plane[2] * point[2] + plane[3]); } @@ -1098,13 +1104,13 @@ switch(prim->type){ case GL2PS_TRIANGLE : case GL2PS_QUADRANGLE : - v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0]; - v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1]; - v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2]; - w[0] = prim->verts[2].xyz[0] - prim->verts[0].xyz[0]; - w[1] = prim->verts[2].xyz[1] - prim->verts[0].xyz[1]; - w[2] = prim->verts[2].xyz[2] - prim->verts[0].xyz[2]; - if((GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])) || + v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0]; + v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1]; + v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2]; + w[0] = prim->verts[2].xyz[0] - prim->verts[0].xyz[0]; + w[1] = prim->verts[2].xyz[1] - prim->verts[0].xyz[1]; + w[2] = prim->verts[2].xyz[2] - prim->verts[0].xyz[2]; + if((GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])) || (GL2PS_ZERO(w[0]) && GL2PS_ZERO(w[1]) && GL2PS_ZERO(w[2]))){ plane[0] = plane[1] = 0.0F; plane[2] = 1.0F; @@ -1112,16 +1118,16 @@ } else{ gl2psGetNormal(v, w, plane); - plane[3] = - - plane[0] * prim->verts[0].xyz[0] - - plane[1] * prim->verts[0].xyz[1] + plane[3] = + - plane[0] * prim->verts[0].xyz[0] + - plane[1] * prim->verts[0].xyz[1] - plane[2] * prim->verts[0].xyz[2]; } break; case GL2PS_LINE : - v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0]; - v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1]; - v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2]; + v[0] = prim->verts[1].xyz[0] - prim->verts[0].xyz[0]; + v[1] = prim->verts[1].xyz[1] - prim->verts[0].xyz[1]; + v[2] = prim->verts[1].xyz[2] - prim->verts[0].xyz[2]; if(GL2PS_ZERO(v[0]) && GL2PS_ZERO(v[1]) && GL2PS_ZERO(v[2])){ plane[0] = plane[1] = 0.0F; plane[2] = 1.0F; @@ -1132,9 +1138,9 @@ else if(GL2PS_ZERO(v[1])) w[1] = 1.0F; else w[2] = 1.0F; gl2psGetNormal(v, w, plane); - plane[3] = - - plane[0] * prim->verts[0].xyz[0] - - plane[1] * prim->verts[0].xyz[1] + plane[3] = + - plane[0] * prim->verts[0].xyz[0] + - plane[1] * prim->verts[0].xyz[1] - plane[2] * prim->verts[0].xyz[2]; } break; @@ -1169,11 +1175,11 @@ sect = -gl2psComparePointPlane(a->xyz, plane) / psca; else sect = 0.0F; - + c->xyz[0] = a->xyz[0] + v[0] * sect; c->xyz[1] = a->xyz[1] + v[1] * sect; c->xyz[2] = a->xyz[2] + v[2] * sect; - + c->rgba[0] = (1 - sect) * a->rgba[0] + sect * b->rgba[0]; c->rgba[1] = (1 - sect) * a->rgba[1] + sect * b->rgba[1]; c->rgba[2] = (1 - sect) * a->rgba[2] + sect * b->rgba[2]; @@ -1196,10 +1202,10 @@ numverts = 4; } switch(numverts){ - case 1 : child->type = GL2PS_POINT; break; - case 2 : child->type = GL2PS_LINE; break; - case 3 : child->type = GL2PS_TRIANGLE; break; - case 4 : child->type = GL2PS_QUADRANGLE; break; + case 1 : child->type = GL2PS_POINT; break; + case 2 : child->type = GL2PS_LINE; break; + case 3 : child->type = GL2PS_TRIANGLE; break; + case 4 : child->type = GL2PS_QUADRANGLE; break; default: child->type = GL2PS_NO_TYPE; break; } } @@ -1218,13 +1224,13 @@ child->verts[i] = parent->verts[index0[i]]; } else{ - gl2psCutEdge(&parent->verts[index0[i]], &parent->verts[index1[i]], + gl2psCutEdge(&parent->verts[index0[i]], &parent->verts[index1[i]], plane, &child->verts[i]); } } } -static void gl2psAddIndex(GLshort *index0, GLshort *index1, GLshort *nb, +static void gl2psAddIndex(GLshort *index0, GLshort *index1, GLshort *nb, GLshort i, GLshort j) { GLint k; @@ -1247,9 +1253,9 @@ { GLint type = GL2PS_COINCIDENT; GLshort i, j; - GLfloat d[5]; - - for(i = 0; i < prim->numverts; i++){ + GLfloat d[5]; + + for(i = 0; i < prim->numverts; i++){ d[i] = gl2psComparePointPlane(prim->verts[i].xyz, plane); } @@ -1261,11 +1267,11 @@ j = gl2psGetIndex(i, prim->numverts); if(d[j] > GL2PS_EPSILON){ if(type == GL2PS_COINCIDENT) type = GL2PS_IN_BACK_OF; - else if(type != GL2PS_IN_BACK_OF) return 1; + else if(type != GL2PS_IN_BACK_OF) return 1; if(d[i] < -GL2PS_EPSILON) return 1; } else if(d[j] < -GL2PS_EPSILON){ - if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF; + if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF; else if(type != GL2PS_IN_FRONT_OF) return 1; if(d[i] > GL2PS_EPSILON) return 1; } @@ -1274,16 +1280,16 @@ return 0; } -static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane, +static GLint gl2psSplitPrimitive(GL2PSprimitive *prim, GL2PSplane plane, GL2PSprimitive **front, GL2PSprimitive **back) { GLshort i, j, in = 0, out = 0, in0[5], in1[5], out0[5], out1[5]; GLint type; - GLfloat d[5]; + GLfloat d[5]; type = GL2PS_COINCIDENT; - for(i = 0; i < prim->numverts; i++){ + for(i = 0; i < prim->numverts; i++){ d[i] = gl2psComparePointPlane(prim->verts[i].xyz, plane); } @@ -1298,7 +1304,7 @@ j = gl2psGetIndex(i, prim->numverts); if(d[j] > GL2PS_EPSILON){ if(type == GL2PS_COINCIDENT) type = GL2PS_IN_BACK_OF; - else if(type != GL2PS_IN_BACK_OF) type = GL2PS_SPANNING; + else if(type != GL2PS_IN_BACK_OF) type = GL2PS_SPANNING; if(d[i] < -GL2PS_EPSILON){ gl2psAddIndex(in0, in1, &in, i, j); gl2psAddIndex(out0, out1, &out, i, j); @@ -1307,7 +1313,7 @@ gl2psAddIndex(out0, out1, &out, j, -1); } else if(d[j] < -GL2PS_EPSILON){ - if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF; + if(type == GL2PS_COINCIDENT) type = GL2PS_IN_FRONT_OF; else if(type != GL2PS_IN_FRONT_OF) type = GL2PS_SPANNING; if(d[i] > GL2PS_EPSILON){ gl2psAddIndex(in0, in1, &in, i, j); @@ -1334,7 +1340,7 @@ return type; } -static void gl2psDivideQuad(GL2PSprimitive *quad, +static void gl2psDivideQuad(GL2PSprimitive *quad, GL2PSprimitive **t1, GL2PSprimitive **t2) { *t1 = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); @@ -1355,25 +1361,25 @@ (*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]; + dq += q->verts[i].xyz[2]; } dq /= (GLfloat)q->numverts; for(i = 0; i < w->numverts; i++){ - dw += w->verts[i].xyz[2]; + dw += w->verts[i].xyz[2]; } dw /= (GLfloat)w->numverts; @@ -1391,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); } @@ -1424,7 +1430,7 @@ for(j = 0; j < gl2psListNbr(primitives); j++){ if(j != i){ prim2 = *(GL2PSprimitive**)gl2psListPointer(primitives, j); - count += gl2psTestSplitPrimitive(prim2, plane); + count += gl2psTestSplitPrimitive(prim2, plane); } if(count > best) break; } @@ -1458,7 +1464,7 @@ static void gl2psFreePrimitive(void *data) { GL2PSprimitive *q; - + q = *(GL2PSprimitive**)data; gl2psFree(q->verts); if(q->type == GL2PS_TEXT || q->type == GL2PS_SPECIAL){ @@ -1483,7 +1489,7 @@ gl2psListAdd(list, &t2); gl2psFreePrimitive(&prim); } - + } static void gl2psFreeBspTree(GL2PSbsptree **tree) @@ -1595,7 +1601,7 @@ } gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse); } - else if(GL_TRUE == compare(-epsilon, result)){ + else if(GL_TRUE == compare(-epsilon, result)){ gl2psTraverseBspTree(tree->front, eye, epsilon, compare, action, inverse); if(inverse){ gl2psListActionInverse(tree->primitives, action); @@ -1611,7 +1617,7 @@ } } -static void gl2psRescaleAndOffset() +static void gl2psRescaleAndOffset(void) { GL2PSprimitive *prim; GLfloat minZ, maxZ, rangeZ, scaleZ; @@ -1663,18 +1669,18 @@ else if(prim->offset && (prim->type == GL2PS_TRIANGLE)){ factor = gl2ps->offset[0]; units = gl2ps->offset[1]; - area = - (prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) * - (prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) - - (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) * + area = + (prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) * + (prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) - + (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) * (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]); if(!GL2PS_ZERO(area)){ - dZdX = + dZdX = ((prim->verts[2].xyz[1] - prim->verts[1].xyz[1]) * (prim->verts[1].xyz[2] - prim->verts[0].xyz[2]) - (prim->verts[1].xyz[1] - prim->verts[0].xyz[1]) * (prim->verts[2].xyz[2] - prim->verts[1].xyz[2])) / area; - dZdY = + dZdY = ((prim->verts[1].xyz[0] - prim->verts[0].xyz[0]) * (prim->verts[2].xyz[2] - prim->verts[1].xyz[2]) - (prim->verts[2].xyz[0] - prim->verts[1].xyz[0]) * @@ -1692,15 +1698,15 @@ } } -/********************************************************************* +/********************************************************************* * - * 2D sorting routines (for occlusion culling) + * 2D sorting routines (for occlusion culling) * *********************************************************************/ static GLint gl2psGetPlaneFromPoints(GL2PSxyz a, GL2PSxyz b, GL2PSplane plane) { - GLfloat n; + GLfloat n; plane[0] = b[1] - a[1]; plane[1] = a[0] - b[0]; @@ -1709,7 +1715,7 @@ if(!GL2PS_ZERO(n)){ plane[0] /= n; plane[1] /= n; - plane[3] = -plane[0]*a[0]-plane[1]*a[1]; + plane[3] = -plane[0]*a[0]-plane[1]*a[1]; return 1; } else{ @@ -1894,8 +1900,8 @@ } static void gl2psSplitPrimitive2D(GL2PSprimitive *prim, - GL2PSplane plane, - GL2PSprimitive **front, + GL2PSplane plane, + GL2PSprimitive **front, GL2PSprimitive **back) { /* cur will hold the position of the current vertex @@ -1904,10 +1910,10 @@ v1 and v2 represent the current and previous vertices, respectively flag is set if the current vertex should be checked against the plane */ GLint cur = -1, prev = -1, i, v1 = 0, v2 = 0, flag = 1, prev0 = -1; - + /* list of vertices that will go in front and back primitive */ GL2PSvertex *front_list = NULL, *back_list = NULL; - + /* number of vertices in front and back list */ GLshort front_count = 0, back_count = 0; @@ -1924,7 +1930,7 @@ if(i == 0){ prev0 = cur; } - } + } if(((prev == -1) || (prev == cur) || (prev == 0) || (cur == 0)) && (i < prim->numverts)){ if(cur == GL2PS_POINT_INFRONT){ @@ -1979,12 +1985,12 @@ { GLint ret = 0; GL2PSprimitive *frontprim = NULL, *backprim = NULL; - + /* FIXME: until we consider the actual extent of text strings and pixmaps, never cull them. Otherwise the whole string/pixmap gets culled as soon as the reference point is hidden */ - if(prim->type == GL2PS_PIXMAP || - prim->type == GL2PS_TEXT || + if(prim->type == GL2PS_PIXMAP || + prim->type == GL2PS_TEXT || prim->type == GL2PS_SPECIAL){ return 1; } @@ -1998,7 +2004,7 @@ else{ switch(gl2psCheckPrimitive(prim, (*tree)->plane)){ case GL2PS_IN_BACK_OF: return gl2psAddInBspImageTree(prim, &(*tree)->back); - case GL2PS_IN_FRONT_OF: + case GL2PS_IN_FRONT_OF: if((*tree)->front != NULL) return gl2psAddInBspImageTree(prim, &(*tree)->front); else return 0; case GL2PS_SPANNING: @@ -2133,14 +2139,14 @@ gl2psBuildPolygonBoundary(tree->front); } -/********************************************************************* +/********************************************************************* * * Feedback buffer parser * *********************************************************************/ -static void gl2psAddPolyPrimitive(GLshort type, GLshort numverts, - GL2PSvertex *verts, GLint offset, +static void gl2psAddPolyPrimitive(GLshort type, GLshort numverts, + GL2PSvertex *verts, GLint offset, GLushort pattern, GLint factor, GLfloat width, char boundary) { @@ -2207,7 +2213,7 @@ while(used > 0){ if(GL_TRUE == boundary) gl2ps->boundary = GL_TRUE; - + switch((GLint)*current){ case GL_POINT_TOKEN : current ++; @@ -2215,7 +2221,7 @@ i = gl2psGetVertex(&vertices[0], current); current += i; used -= i; - gl2psAddPolyPrimitive(GL2PS_POINT, 1, vertices, 0, + gl2psAddPolyPrimitive(GL2PS_POINT, 1, vertices, 0, pattern, factor, psize, 0); break; case GL_LINE_TOKEN : @@ -2228,7 +2234,7 @@ i = gl2psGetVertex(&vertices[1], current); current += i; used -= i; - gl2psAddPolyPrimitive(GL2PS_LINE, 2, vertices, 0, + gl2psAddPolyPrimitive(GL2PS_LINE, 2, vertices, 0, pattern, factor, lwidth, 0); break; case GL_POLYGON_TOKEN : @@ -2259,7 +2265,7 @@ else v ++; } - break; + break; case GL_BITMAP_TOKEN : case GL_DRAW_PIXEL_TOKEN : case GL_COPY_PIXEL_TOKEN : @@ -2268,7 +2274,7 @@ i = gl2psGetVertex(&vertices[0], current); current += i; used -= i; - break; + break; case GL_PASS_THROUGH_TOKEN : switch((GLint)current[1]){ case GL2PS_BEGIN_OFFSET_TOKEN : offset = 1; break; @@ -2278,32 +2284,32 @@ case GL2PS_END_STIPPLE_TOKEN : pattern = factor = 0; break; case GL2PS_BEGIN_BLEND_TOKEN : gl2ps->blending = GL_TRUE; break; case GL2PS_END_BLEND_TOKEN : gl2ps->blending = GL_FALSE; break; - case GL2PS_BEGIN_STIPPLE_TOKEN : + case GL2PS_BEGIN_STIPPLE_TOKEN : current += 2; - used -= 2; - pattern = (GLushort)current[1]; + used -= 2; + pattern = (GLushort)current[1]; current += 2; - used -= 2; - factor = (GLint)current[1]; + used -= 2; + factor = (GLint)current[1]; break; - case GL2PS_SRC_BLEND_TOKEN : - current += 2; - used -= 2; + case GL2PS_SRC_BLEND_TOKEN : + current += 2; + used -= 2; gl2ps->blendfunc[0] = (GLint)current[1]; break; - case GL2PS_DST_BLEND_TOKEN : - current += 2; - used -= 2; + case GL2PS_DST_BLEND_TOKEN : + current += 2; + used -= 2; gl2ps->blendfunc[1] = (GLint)current[1]; break; - case GL2PS_POINT_SIZE_TOKEN : - current += 2; - used -= 2; + case GL2PS_POINT_SIZE_TOKEN : + current += 2; + used -= 2; psize = current[1]; break; - case GL2PS_LINE_WIDTH_TOKEN : - current += 2; - used -= 2; + case GL2PS_LINE_WIDTH_TOKEN : + current += 2; + used -= 2; lwidth = current[1]; break; case GL2PS_IMAGEMAP_TOKEN : @@ -2317,24 +2323,26 @@ prim->pattern = 0; prim->factor = 0; prim->width = 1; - + node = (GL2PSimagemap*)gl2psMalloc(sizeof(GL2PSimagemap)); node->image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); node->image->type = 0; node->image->format = 0; + node->image->zoom_x = 1.0F; + node->image->zoom_y = 1.0F; node->next = NULL; - + if(gl2ps->imagemap_head == NULL) gl2ps->imagemap_head = node; else gl2ps->imagemap_tail->next = node; gl2ps->imagemap_tail = node; prim->data.image = node->image; - + current += 2; used -= 2; i = gl2psGetVertex(&prim->verts[0], ¤t[1]); current += i; used -= i; - + node->image->width = (GLint)current[2]; current += 2; used -= 2; node->image->height = (GLint)current[2]; @@ -2354,12 +2362,12 @@ sizeoffloat = sizeof(GLfloat); v = 2 * sizeoffloat; - vtot = node->image->height + node->image->height * + vtot = node->image->height + node->image->height * ((node->image->width - 1) / 8); node->image->pixels = (GLfloat*)gl2psMalloc(v + vtot); node->image->pixels[0] = prim->verts[0].xyz[0]; node->image->pixels[1] = prim->verts[0].xyz[1]; - + for(i = 0; i < vtot; i += sizeoffloat){ current += 2; used -= 2; if((vtot - i) >= 4) @@ -2373,15 +2381,15 @@ case GL2PS_DRAW_PIXELS_TOKEN : case GL2PS_TEXT_TOKEN : if(auxindex < gl2psListNbr(gl2ps->auxprimitives)) - gl2psListAdd(gl2ps->primitives, + gl2psListAdd(gl2ps->primitives, gl2psListPointer(gl2ps->auxprimitives, auxindex++)); else gl2psMsg(GL2PS_ERROR, "Wrong number of auxiliary tokens in buffer"); break; } - current += 2; - used -= 2; - break; + current += 2; + used -= 2; + break; default : gl2psMsg(GL2PS_WARNING, "Unknown token in buffer"); current ++; @@ -2393,7 +2401,7 @@ gl2psListReset(gl2ps->auxprimitives); } -/********************************************************************* +/********************************************************************* * * PostScript routines * @@ -2423,17 +2431,17 @@ if((width <= 0) || (height <= 0)) return; gl2psPrintf("gsave\n"); - gl2psPrintf("%.2f %.2f translate\n", x, y); - gl2psPrintf("%d %d scale\n", width, height); + gl2psPrintf("%.2f %.2f translate\n", x, y); + gl2psPrintf("%.2f %.2f scale\n", width * im->zoom_x, height * im->zoom_y); if(greyscale){ /* greyscale */ - gl2psPrintf("/picstr %d string def\n", width); - gl2psPrintf("%d %d %d\n", width, height, 8); - gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); + gl2psPrintf("/picstr %d string def\n", width); + gl2psPrintf("%d %d %d\n", width, height, 8); + gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); gl2psPrintf("{ currentfile picstr readhexstring pop }\n"); gl2psPrintf("image\n"); for(row = 0; row < height; row++){ - for(col = 0; col < width; col++){ + for(col = 0; col < width; col++){ gl2psGetRGB(im, col, row, &dr, &dg, &db); fgrey = (0.30F * dr + 0.59F * dg + 0.11F * db); grey = (unsigned char)(255. * fgrey); @@ -2441,8 +2449,8 @@ } gl2psPrintf("\n"); } - nbhex = width * height * 2; - gl2psPrintf("%%%% nbhex digit :%d\n", nbhex); + nbhex = width * height * 2; + gl2psPrintf("%%%% nbhex digit :%d\n", nbhex); } else if(nbit == 2){ /* color, 2 bits for r and g and b; rgbs following each other */ nrgb = width * 3; @@ -2463,7 +2471,7 @@ if(icase == 1) { if(col < width) { gl2psGetRGB(im, col, row, &dr, &dg, &db); - } + } else { dr = dg = db = 0; } @@ -2476,7 +2484,7 @@ b = (b<<2) + blue; if(col < width) { gl2psGetRGB(im, col, row, &dr, &dg, &db); - } + } else { dr = dg = db = 0; } @@ -2488,7 +2496,7 @@ gl2psWriteByte(b); b = 0; icase++; - } + } else if(icase == 2) { b = green; b = (b<<2) + blue; @@ -2507,7 +2515,7 @@ gl2psWriteByte(b); b = 0; icase++; - } + } else if(icase == 3) { b = blue; if(col < width) { @@ -2535,7 +2543,7 @@ nrgb = width * 3; nbits = nrgb * nbit; nbyte = nbits / 8; - if((nbyte * 8) != nbits) nbyte++; + if((nbyte * 8) != nbits) nbyte++; gl2psPrintf("/rgbstr %d string def\n", nbyte); gl2psPrintf("%d %d %d\n", width, height, nbit); gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); @@ -2549,7 +2557,7 @@ if(icase == 1) { if(col < width) { gl2psGetRGB(im, col, row, &dr, &dg, &db); - } + } else { dr = dg = db = 0; } @@ -2558,12 +2566,12 @@ green = (unsigned char)(15. * dg); gl2psPrintf("%x%x", red, green); icase++; - } + } else if(icase == 2) { blue = (unsigned char)(15. * db); if(col < width) { gl2psGetRGB(im, col, row, &dr, &dg, &db); - } + } else { dr = dg = db = 0; } @@ -2586,7 +2594,7 @@ nbyte = width * 3; gl2psPrintf("/rgbstr %d string def\n", nbyte); gl2psPrintf("%d %d %d\n", width, height, 8); - gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); + gl2psPrintf("[ %d 0 0 -%d 0 %d ]\n", width, height, height); gl2psPrintf("{ currentfile rgbstr readhexstring pop }\n"); gl2psPrintf("false 3\n"); gl2psPrintf("colorimage\n"); @@ -2603,7 +2611,7 @@ gl2psPrintf("\n"); } } - + gl2psPrintf("grestore\n"); } @@ -2611,14 +2619,14 @@ GLsizei width, GLsizei height, const unsigned char *imagemap){ int i, size; - + if((width <= 0) || (height <= 0)) return; - + size = height + height * (width - 1) / 8; - + gl2psPrintf("gsave\n"); gl2psPrintf("%.2f %.2f translate\n", x, y); - gl2psPrintf("%d %d scale\n%d %d\ntrue\n", width, height,width, height); + gl2psPrintf("%d %d scale\n%d %d\ntrue\n", width, height,width, height); gl2psPrintf("[ %d 0 0 -%d 0 %d ] {<", width, height); for(i = 0; i < size; i++){ gl2psWriteByte(*imagemap); @@ -2652,7 +2660,7 @@ "%%%%LanguageLevel: 3\n" "%%%%DocumentData: Clean7Bit\n" "%%%%Pages: 1\n", - gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, + gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, gl2ps->producer, ctime(&now)); @@ -2661,18 +2669,18 @@ "%%%%DocumentMedia: Default %d %d 0 () ()\n", (gl2ps->options & GL2PS_LANDSCAPE) ? "Landscape" : "Portrait", (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] : - (int)gl2ps->viewport[2], - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] : + (int)gl2ps->viewport[2], + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] : (int)gl2ps->viewport[3]); } gl2psPrintf("%%%%BoundingBox: %d %d %d %d\n" "%%%%EndComments\n", - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[1] : + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[1] : (int)gl2ps->viewport[0], (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[0] : (int)gl2ps->viewport[1], - (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] : + (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[3] : (int)gl2ps->viewport[2], (gl2ps->options & GL2PS_LANDSCAPE) ? (int)gl2ps->viewport[2] : (int)gl2ps->viewport[3]); @@ -2720,7 +2728,7 @@ /* rotated text routines: same nameanem with R appended */ gl2psPrintf("/FCT { FC translate 0 0 } BD\n" - "/SR { gsave FCT moveto rotate show grestore } BD\n" + "/SR { gsave FCT moveto rotate show grestore } BD\n" "/SBCR{ gsave FCT moveto rotate SW -2 div 0 rmoveto show grestore } BD\n" "/SBRR{ gsave FCT moveto rotate SW neg 0 rmoveto show grestore } BD\n" "/SCLR{ gsave FCT moveto rotate 0 SH -2 div rmoveto show grestore} BD\n"); @@ -2735,7 +2743,7 @@ "/L { lineto } BD\n" "/LE { lineto stroke } BD\n" "/T { newpath moveto lineto lineto closepath fill } BD\n"); - + /* Smooth-shaded triangle with PostScript level 3 shfill operator: x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STshfill */ @@ -2789,11 +2797,11 @@ " 4 index 10 index add 0.5 mul\n" /* g12 = (g1+g2)/2 */ " 4 index 10 index add 0.5 mul\n" /* b12 = (b1+b2)/2 */ " 5 copy 5 copy 40 5 roll 25 5 roll 15 5 roll 25 5 roll\n"); - + /* stack = (V3) (V13) (V23) (V13) (V12) (V23) (V13) (V1) (V12) (V23) (V12) (V2) */ gl2psPrintf(" STnoshfill STnoshfill STnoshfill STnoshfill } BD\n"); - + /* Gouraud shaded triangle using recursive subdivision until the difference between corner colors does not exceed the thresholds: x3 y3 r3 g3 b3 x2 y2 r2 g2 b2 x1 y1 r1 g1 b1 STnoshfill */ @@ -2827,7 +2835,7 @@ " ifelse }\n" " ifelse }\n" " ifelse } BD\n"); - + gl2psPrintf("tryPS3shading\n" "{ /shfill where\n" " { /ST { STshfill } BD }\n" @@ -2844,7 +2852,7 @@ "%%%%EndSetup\n" "%%%%Page: 1 1\n" "%%%%BeginPageSetup\n"); - + if(gl2ps->options & GL2PS_LANDSCAPE){ gl2psPrintf("%d 0 translate 90 rotate\n", (int)gl2ps->viewport[3]); @@ -2854,14 +2862,14 @@ "mark\n" "gsave\n" "1.0 1.0 scale\n"); - + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ gl2psPrintf("%g %g %g C\n" "newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" "closepath fill\n", - gl2ps->bgcolor[0], gl2ps->bgcolor[1], gl2ps->bgcolor[2], - (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], - (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3], + gl2ps->bgcolor[0], gl2ps->bgcolor[1], gl2ps->bgcolor[2], + (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], + (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3], (int)gl2ps->viewport[0], (int)gl2ps->viewport[3]); } } @@ -2891,7 +2899,7 @@ } } -static void gl2psParseStipplePattern(GLushort pattern, GLint factor, +static void gl2psParseStipplePattern(GLushort pattern, GLint factor, int *nb, int array[10]) { int i, n; @@ -2931,10 +2939,10 @@ if(pattern == gl2ps->lastpattern && factor == gl2ps->lastfactor) return 0; - + gl2ps->lastpattern = pattern; gl2ps->lastfactor = factor; - + if(!pattern || !factor){ /* solid line */ len += gl2psPrintf("[] 0 %s\n", str); @@ -2948,7 +2956,7 @@ } len += gl2psPrintf("] 0 %s\n", str); } - + return len; } @@ -2971,7 +2979,7 @@ switch(prim->type){ case GL2PS_POINT : gl2psPrintPostScriptColor(prim->verts[0].rgba); - gl2psPrintf("%g %g %g P\n", + gl2psPrintf("%g %g %g P\n", prim->verts[0].xyz[0], prim->verts[0].xyz[1], 0.5 * prim->width); break; case GL2PS_LINE : @@ -3134,14 +3142,14 @@ gl2psPrintf("%g %g %g C\n" "newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" "closepath fill\n", - rgba[0], rgba[1], rgba[2], + rgba[0], rgba[1], rgba[2], x, y, x+w, y, x+w, y+h, x, y+h); } - + gl2psPrintf("newpath %d %d moveto %d %d lineto %d %d lineto %d %d lineto\n" "closepath clip\n", x, y, x+w, y, x+w, y+h, x, y+h); - + } static GLint gl2psPrintPostScriptEndViewport(void) @@ -3183,7 +3191,7 @@ "Encapsulated Postscript" }; -/********************************************************************* +/********************************************************************* * * LaTeX routines * @@ -3196,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'; @@ -3211,7 +3219,7 @@ time(&now); - fprintf(gl2ps->stream, + fprintf(gl2ps->stream, "%% Title: %s\n" "%% Creator: GL2PS %d.%d.%d%s, %s\n" "%% For: %s\n" @@ -3220,7 +3228,7 @@ GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, gl2ps->producer, ctime(&now)); - fprintf(gl2ps->stream, + fprintf(gl2ps->stream, "\\setlength{\\unitlength}{1pt}\n" "\\begin{picture}(0,0)\n" "\\includegraphics{%s}\n" @@ -3238,10 +3246,13 @@ switch(prim->type){ case GL2PS_TEXT : - fprintf(gl2ps->stream, "\\fontsize{%d}{0}\n\\selectfont", + fprintf(gl2ps->stream, "\\fontsize{%d}{0}\n\\selectfont", prim->data.text->fontsize); - fprintf(gl2ps->stream, "\\put(%g,%g){\\makebox(0,0)", + fprintf(gl2ps->stream, "\\put(%g,%g)", prim->verts[0].xyz[0], prim->verts[0].xyz[1]); + if(prim->data.text->angle) + fprintf(gl2ps->stream, "{\\rotatebox{%g}", prim->data.text->angle); + fprintf(gl2ps->stream, "{\\makebox(0,0)"); switch(prim->data.text->alignment){ case GL2PS_TEXT_C: fprintf(gl2ps->stream, "{"); @@ -3272,8 +3283,6 @@ fprintf(gl2ps->stream, "[bl]{"); break; } - if(prim->data.text->angle) - fprintf(gl2ps->stream, "\\rotatebox{%g}{", prim->data.text->angle); fprintf(gl2ps->stream, "\\textcolor[rgb]{%g,%g,%g}{{%s}}", prim->verts[0].rgba[0], prim->verts[0].rgba[1], prim->verts[0].rgba[2], prim->data.text->str); @@ -3300,8 +3309,9 @@ static void gl2psPrintTeXBeginViewport(GLint viewport[4]) { + (void) viewport; /* not used */ glRenderMode(GL_FEEDBACK); - + if(gl2ps->header){ gl2psPrintTeXHeader(); gl2ps->header = GL_FALSE; @@ -3330,7 +3340,7 @@ "LaTeX text" }; -/********************************************************************* +/********************************************************************* * * PDF routines * @@ -3366,7 +3376,7 @@ static int gl2psPrintPDFFillColor(GL2PSrgba rgba) { int i, offs = 0; - + for(i = 0; i < 3; ++i){ if(GL2PS_ZERO(rgba[i])) offs += gl2psPrintf("%.0f ", 0.); @@ -3392,18 +3402,18 @@ static void gl2psPutPDFText(GL2PSstring *text, int cnt, GLfloat x, GLfloat y) { GLfloat rad, crad, srad; - + if(text->angle == 0.0F){ gl2ps->streamlength += gl2psPrintf ("BT\n" "/F%d %d Tf\n" "%f %f Td\n" "(%s) Tj\n" - "ET\n", + "ET\n", cnt, text->fontsize, x, y, text->str); } else{ - rad = 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 @@ -3428,23 +3438,23 @@ static void gl2psPDFstacksInit(void) { - gl2ps->objects_stack = 7 /* FIXED_XREF_ENTRIES */ + 1; - gl2ps->extgs_stack = 0; - gl2ps->font_stack = 0; - gl2ps->im_stack = 0; - gl2ps->trgroupobjects_stack = 0; - gl2ps->shader_stack = 0; - gl2ps->mshader_stack = 0; + gl2ps->objects_stack = 7 /* FIXED_XREF_ENTRIES */ + 1; + gl2ps->extgs_stack = 0; + gl2ps->font_stack = 0; + gl2ps->im_stack = 0; + gl2ps->trgroupobjects_stack = 0; + gl2ps->shader_stack = 0; + gl2ps->mshader_stack = 0; } static void gl2psPDFgroupObjectInit(GL2PSpdfgroup *gro) { if(!gro) return; - + gro->ptrlist = NULL; - gro->fontno = gro->gsno = gro->imno = gro->maskshno = gro->shno - = gro->trgroupno = gro->fontobjno = gro->imobjno = gro->shobjno + gro->fontno = gro->gsno = gro->imno = gro->maskshno = gro->shno + = gro->trgroupno = gro->fontobjno = gro->imobjno = gro->shobjno = gro->maskshobjno = gro->gsobjno = gro->trgroupobjno = -1; } @@ -3469,7 +3479,7 @@ gl2ps->pdfgrouplist = gl2psListCreate(500, 500, sizeof(GL2PSpdfgroup)); gl2psInitTriangle(&lastt); - for(i = 0; i < gl2psListNbr(gl2ps->pdfprimlist); ++i){ + for(i = 0; i < gl2psListNbr(gl2ps->pdfprimlist); ++i){ p = *(GL2PSprimitive**)gl2psListPointer(gl2ps->pdfprimlist, i); switch(p->type){ case GL2PS_PIXMAP: @@ -3487,7 +3497,7 @@ gl2psListAdd(gl2ps->pdfgrouplist, &gro); break; case GL2PS_LINE: - if(lasttype != p->type || lastwidth != p->width || + if(lasttype != p->type || lastwidth != p->width || lastpattern != p->pattern || lastfactor != p->factor || !gl2psSameColor(p->verts[0].rgba, lastrgba)){ gl2psPDFgroupObjectInit(&gro); @@ -3506,7 +3516,7 @@ lastrgba[2] = p->verts[0].rgba[2]; break; case GL2PS_POINT: - if(lasttype != p->type || lastwidth != p->width || + if(lasttype != p->type || lastwidth != p->width || !gl2psSameColor(p->verts[0].rgba, lastrgba)){ gl2psPDFgroupObjectInit(&gro); gro.ptrlist = gl2psListCreate(1,2,sizeof(GL2PSprimitive*)); @@ -3523,10 +3533,10 @@ break; case GL2PS_TRIANGLE: gl2psFillTriangleFromPrimitive(&tmpt, p, GL_TRUE); - lastTriangleWasNotSimpleWithSameColor = + lastTriangleWasNotSimpleWithSameColor = !(tmpt.prop & T_CONST_COLOR && tmpt.prop & T_ALPHA_1) || !gl2psSameColor(tmpt.vertex[0].rgba, lastt.vertex[0].rgba); - if(lasttype == p->type && tmpt.prop == lastt.prop && + if(lasttype == p->type && tmpt.prop == lastt.prop && lastTriangleWasNotSimpleWithSameColor){ /* TODO Check here for last alpha */ gl2psListAdd(gro.ptrlist, &p); @@ -3541,7 +3551,7 @@ break; default: break; - } + } lasttype = p->type; } } @@ -3550,7 +3560,7 @@ { GL2PStriangle t; GL2PSprimitive *prim = NULL; - + if(!gro) return; @@ -3563,35 +3573,35 @@ return; gl2psFillTriangleFromPrimitive(&t, prim, GL_TRUE); - - if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){ - gro->gsno = gl2ps->extgs_stack++; + + if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){ + gro->gsno = gl2ps->extgs_stack++; gro->gsobjno = gl2ps->objects_stack ++; } - else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){ + else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){ gro->gsno = gl2ps->extgs_stack++; gro->gsobjno = gl2ps->objects_stack++; - gro->trgroupno = gl2ps->trgroupobjects_stack++; + gro->trgroupno = gl2ps->trgroupobjects_stack++; gro->trgroupobjno = gl2ps->objects_stack++; gro->maskshno = gl2ps->mshader_stack++; gro->maskshobjno = gl2ps->objects_stack++; } - else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){ + else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){ gro->shno = gl2ps->shader_stack++; gro->shobjno = gl2ps->objects_stack++; } - else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){ + else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){ gro->gsno = gl2ps->extgs_stack++; gro->gsobjno = gl2ps->objects_stack++; - gro->shno = gl2ps->shader_stack++; + gro->shno = gl2ps->shader_stack++; gro->shobjno = gl2ps->objects_stack++; } - else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){ + else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){ gro->gsno = gl2ps->extgs_stack++; gro->gsobjno = gl2ps->objects_stack++; - gro->shno = gl2ps->shader_stack++; + gro->shno = gl2ps->shader_stack++; gro->shobjno = gl2ps->objects_stack++; - gro->trgroupno = gl2ps->trgroupobjects_stack++; + gro->trgroupno = gl2ps->trgroupobjects_stack++; gro->trgroupobjno = gl2ps->objects_stack++; gro->maskshno = gl2ps->mshader_stack++; gro->maskshobjno = gl2ps->objects_stack++; @@ -3624,14 +3634,14 @@ gl2ps->streamlength += gl2psPrintf("1 J\n"); gl2ps->streamlength += gl2psPrintPDFLineWidth(prim->width); gl2ps->streamlength += gl2psPrintPDFStrokeColor(prim->verts[0].rgba); - for(j = 0; j <= lastel; ++j){ + for(j = 0; j <= lastel; ++j){ prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); gl2ps->streamlength += gl2psPrintf("%f %f m %f %f l\n", prim->verts[0].xyz[0], prim->verts[0].xyz[1], prim->verts[0].xyz[0], prim->verts[0].xyz[1]); } - gl2ps->streamlength += gl2psPrintf("S\n"); + gl2ps->streamlength += gl2psPrintf("S\n"); gl2ps->streamlength += gl2psPrintf("0 J\n"); break; case GL2PS_LINE: @@ -3642,10 +3652,10 @@ gl2ps->streamlength += gl2psPrintPDFStrokeColor(prim->verts[0].rgba); gl2ps->streamlength += gl2psPrintPostScriptDash(prim->pattern, prim->factor, "d"); /* start new path */ - gl2ps->streamlength += - gl2psPrintf("%f %f m\n", + gl2ps->streamlength += + gl2psPrintf("%f %f m\n", prim->verts[0].xyz[0], prim->verts[0].xyz[1]); - + for(j = 1; j <= lastel; ++j){ prev = prim; prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); @@ -3653,38 +3663,38 @@ /* the starting point of the new segment does not match the end point of the previous line, so we end the current path and start a new one */ - gl2ps->streamlength += - gl2psPrintf("%f %f l\n", + gl2ps->streamlength += + gl2psPrintf("%f %f l\n", prev->verts[1].xyz[0], prev->verts[1].xyz[1]); - gl2ps->streamlength += - gl2psPrintf("%f %f m\n", + gl2ps->streamlength += + gl2psPrintf("%f %f m\n", prim->verts[0].xyz[0], prim->verts[0].xyz[1]); } else{ /* the two segements are connected, so we just append to the current path */ - gl2ps->streamlength += + gl2ps->streamlength += gl2psPrintf("%f %f l\n", prim->verts[0].xyz[0], prim->verts[0].xyz[1]); } } /* end last path */ - gl2ps->streamlength += - gl2psPrintf("%f %f l\n", + gl2ps->streamlength += + gl2psPrintf("%f %f l\n", prim->verts[1].xyz[0], prim->verts[1].xyz[1]); gl2ps->streamlength += gl2psPrintf("S\n"); break; case GL2PS_TRIANGLE: gl2psFillTriangleFromPrimitive(&t, prim, GL_TRUE); gl2psSortOutTrianglePDFgroup(gro); - + /* No alpha and const color: Simple PDF draw orders */ - if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_1){ - gl2ps->streamlength += gl2psPrintPDFFillColor(t.vertex[0].rgba); - for(j = 0; j <= lastel; ++j){ + if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_1){ + gl2ps->streamlength += gl2psPrintPDFFillColor(t.vertex[0].rgba); + for(j = 0; j <= lastel; ++j){ prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); - gl2ps->streamlength + gl2ps->streamlength += gl2psPrintf("%f %f m\n" "%f %f l\n" "%f %f l\n" @@ -3694,17 +3704,17 @@ t.vertex[2].xyz[0], t.vertex[2].xyz[1]); } } - /* Const alpha < 1 and const color: Simple PDF draw orders + /* Const alpha < 1 and const color: Simple PDF draw orders and an extra extended Graphics State for the alpha const */ - else if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){ + else if(t.prop & T_CONST_COLOR && t.prop & T_ALPHA_LESS_1){ gl2ps->streamlength += gl2psPrintf("q\n" "/GS%d gs\n", gro->gsno); gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); - for(j = 0; j <= lastel; ++j){ + for(j = 0; j <= lastel; ++j){ prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); - gl2ps->streamlength + gl2ps->streamlength += gl2psPrintf("%f %f m\n" "%f %f l\n" "%f %f l\n" @@ -3715,19 +3725,19 @@ } gl2ps->streamlength += gl2psPrintf("Q\n"); } - /* Variable alpha and const color: Simple PDF draw orders - and an extra extended Graphics State + Xobject + Shader + /* Variable alpha and const color: Simple PDF draw orders + and an extra extended Graphics State + Xobject + Shader object for the alpha mask */ - else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){ + else if(t.prop & T_CONST_COLOR && t.prop & T_VAR_ALPHA){ gl2ps->streamlength += gl2psPrintf("q\n" "/GS%d gs\n" "/TrG%d Do\n", gro->gsno, gro->trgroupno); gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); - for(j = 0; j <= lastel; ++j){ + for(j = 0; j <= lastel; ++j){ prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); gl2psFillTriangleFromPrimitive(&t, prim, GL_FALSE); - gl2ps->streamlength + gl2ps->streamlength += gl2psPrintf("%f %f m\n" "%f %f l\n" "%f %f l\n" @@ -3740,23 +3750,23 @@ } /* Variable color and no alpha: Shader Object for the colored triangle(s) */ - else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){ + else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_1){ gl2ps->streamlength += gl2psPrintf("/Sh%d sh\n", gro->shno); } - /* Variable color and const alpha < 1: Shader Object for the - colored triangle(s) and an extra extended Graphics State + /* Variable color and const alpha < 1: Shader Object for the + colored triangle(s) and an extra extended Graphics State for the alpha const */ - else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){ + else if(t.prop & T_VAR_COLOR && t.prop & T_ALPHA_LESS_1){ gl2ps->streamlength += gl2psPrintf("q\n" "/GS%d gs\n" "/Sh%d sh\n" "Q\n", gro->gsno, gro->shno); } - /* Variable alpha and color: Shader Object for the colored - triangle(s) and an extra extended Graphics State + /* Variable alpha and color: Shader Object for the colored + triangle(s) and an extra extended Graphics State + Xobject + Shader object for the alpha mask */ - else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){ + else if(t.prop & T_VAR_COLOR && t.prop & T_VAR_ALPHA){ gl2ps->streamlength += gl2psPrintf("q\n" "/GS%d gs\n" "/TrG%d Do\n" @@ -3768,12 +3778,12 @@ case GL2PS_PIXMAP: for(j = 0; j <= lastel; ++j){ prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); - gl2psPutPDFImage(prim->data.image, gro->imno, prim->verts[0].xyz[0], + gl2psPutPDFImage(prim->data.image, gro->imno, prim->verts[0].xyz[0], prim->verts[0].xyz[1]); } break; case GL2PS_TEXT: - for(j = 0; j <= lastel; ++j){ + for(j = 0; j <= lastel; ++j){ prim = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); gl2ps->streamlength += gl2psPrintPDFFillColor(prim->verts[0].rgba); gl2psPutPDFText(prim->data.text, gro->fontno, prim->verts[0].xyz[0], @@ -3782,7 +3792,7 @@ break; default: break; - } + } } } @@ -3795,15 +3805,15 @@ int i; offs += fprintf(gl2ps->stream, - "/ExtGState\n" + "/ExtGState\n" "<<\n" "/GSa 7 0 R\n"); - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); if(gro->gsno >= 0) offs += fprintf(gl2ps->stream, "/GS%d %d 0 R\n", gro->gsno, gro->gsobjno); } - offs += fprintf(gl2ps->stream, ">>\n"); + offs += fprintf(gl2ps->stream, ">>\n"); return offs; } @@ -3818,14 +3828,14 @@ offs += fprintf(gl2ps->stream, "/Shading\n" "<<\n"); - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); if(gro->shno >= 0) offs += fprintf(gl2ps->stream, "/Sh%d %d 0 R\n", gro->shno, gro->shobjno); if(gro->maskshno >= 0) offs += fprintf(gl2ps->stream, "/TrSh%d %d 0 R\n", gro->maskshno, gro->maskshobjno); } - offs += fprintf(gl2ps->stream,">>\n"); + offs += fprintf(gl2ps->stream,">>\n"); return offs; } @@ -3842,8 +3852,8 @@ "/XObject\n" "<<\n"); - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); if(!gl2psListNbr(gro->ptrlist)) continue; p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); @@ -3875,8 +3885,8 @@ offs += fprintf(gl2ps->stream, "/Font\n<<\n"); - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); if(gro->fontno < 0) continue; gro->fontobjno = gl2ps->objects_stack++; @@ -3891,11 +3901,11 @@ { int i; GL2PSpdfgroup *gro = NULL; - + if(!gl2ps->pdfgrouplist) return; - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist,i); gl2psListDelete(gro->ptrlist); } @@ -3911,10 +3921,10 @@ int offs; time_t now; struct tm *newtime; - + time(&now); newtime = gmtime(&now); - + offs = fprintf(gl2ps->stream, "1 0 obj\n" "<<\n" @@ -3924,20 +3934,20 @@ gl2ps->title, GL2PS_MAJOR_VERSION, GL2PS_MINOR_VERSION, GL2PS_PATCH_VERSION, GL2PS_EXTRA_VERSION, GL2PS_COPYRIGHT, gl2ps->producer); - + if(!newtime){ - offs += fprintf(gl2ps->stream, + offs += fprintf(gl2ps->stream, ">>\n" "endobj\n"); return offs; } - - offs += fprintf(gl2ps->stream, + + offs += fprintf(gl2ps->stream, "/CreationDate (D:%d%02d%02d%02d%02d%02d)\n" ">>\n" "endobj\n", - newtime->tm_year+1900, - newtime->tm_mon+1, + newtime->tm_year+1900, + newtime->tm_mon+1, newtime->tm_mday, newtime->tm_hour, newtime->tm_min, @@ -3949,7 +3959,7 @@ static int gl2psPrintPDFCatalog(void) { - return fprintf(gl2ps->stream, + return fprintf(gl2ps->stream, "2 0 obj\n" "<<\n" "/Type /Catalog\n" @@ -3960,9 +3970,9 @@ static int gl2psPrintPDFPages(void) { - return fprintf(gl2ps->stream, + return fprintf(gl2ps->stream, "3 0 obj\n" - "<<\n" + "<<\n" "/Type /Pages\n" "/Kids [6 0 R]\n" "/Count 1\n" @@ -3975,13 +3985,13 @@ static int gl2psOpenPDFDataStream(void) { int offs = 0; - - offs += fprintf(gl2ps->stream, + + offs += fprintf(gl2ps->stream, "4 0 obj\n" - "<<\n" + "<<\n" "/Length 5 0 R\n" ); offs += gl2psPrintPDFCompressorType(); - offs += fprintf(gl2ps->stream, + offs += fprintf(gl2ps->stream, ">>\n" "stream\n"); return offs; @@ -3994,13 +4004,13 @@ int offs; offs = gl2psPrintf("/GSa gs\n"); - + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ offs += gl2psPrintPDFFillColor(gl2ps->bgcolor); offs += gl2psPrintf("%d %d %d %d re\n", (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); - offs += gl2psPrintf("f\n"); + offs += gl2psPrintf("f\n"); } return offs; } @@ -4013,26 +4023,26 @@ gl2ps->pdfprimlist = gl2psListCreate(500, 500, sizeof(GL2PSprimitive*)); gl2psPDFstacksInit(); - gl2ps->xreflist = (int*)gl2psMalloc(sizeof(int) * gl2ps->objects_stack); + gl2ps->xreflist = (int*)gl2psMalloc(sizeof(int) * gl2ps->objects_stack); #if defined(GL2PS_HAVE_ZLIB) if(gl2ps->options & GL2PS_COMPRESS){ gl2psSetupCompress(); } -#endif +#endif gl2ps->xreflist[0] = 0; offs += fprintf(gl2ps->stream, "%%PDF-1.4\n"); gl2ps->xreflist[1] = offs; - + offs += gl2psPrintPDFInfo(); gl2ps->xreflist[2] = offs; - + offs += gl2psPrintPDFCatalog(); gl2ps->xreflist[3] = offs; - + offs += gl2psPrintPDFPages(); gl2ps->xreflist[4] = offs; - + offs += gl2psOpenPDFDataStream(); gl2ps->xreflist[5] = offs; /* finished in gl2psPrintPDFFooter */ gl2ps->streamlength = gl2psOpenPDFDataStreamWritePreface(); @@ -4044,7 +4054,7 @@ { GL2PSprimitive *prim = *(GL2PSprimitive**)data; - if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled) + if((gl2ps->options & GL2PS_OCCLUSION_CULL) && prim->culled) return; prim = gl2psCopyPrimitive(prim); /* deep copy */ @@ -4056,7 +4066,7 @@ static int gl2psClosePDFDataStream(void) { int offs = 0; - + #if defined(GL2PS_HAVE_ZLIB) if(gl2ps->options & GL2PS_COMPRESS){ if(Z_OK != gl2psDeflate()) @@ -4064,13 +4074,13 @@ else fwrite(gl2ps->compress->dest, gl2ps->compress->destLen, 1, gl2ps->stream); gl2ps->streamlength += gl2ps->compress->destLen; - + offs += gl2ps->streamlength; gl2psFreeCompress(); } -#endif - - offs += fprintf(gl2ps->stream, +#endif + + offs += fprintf(gl2ps->stream, "endstream\n" "endobj\n"); return offs; @@ -4091,27 +4101,27 @@ static int gl2psPrintPDFOpenPage(void) { int offs; - + /* Write fixed part */ - - offs = fprintf(gl2ps->stream, + + offs = fprintf(gl2ps->stream, "6 0 obj\n" - "<<\n" + "<<\n" "/Type /Page\n" "/Parent 3 0 R\n" "/MediaBox [%d %d %d %d]\n", (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); - + if(gl2ps->options & GL2PS_LANDSCAPE) offs += fprintf(gl2ps->stream, "/Rotate -90\n"); - + offs += fprintf(gl2ps->stream, "/Contents 4 0 R\n" - "/Resources\n" - "<<\n" + "/Resources\n" + "<<\n" "/ProcSet [/PDF /Text /ImageB /ImageC] %%/ImageI\n"); - + return offs; /* End fixed part, proceeds in gl2psPDFgroupListWriteVariableResources() */ @@ -4120,19 +4130,19 @@ static int gl2psPDFgroupListWriteVariableResources(void) { int offs = 0; - + /* a) Graphics States for shader alpha masks*/ - offs += gl2psPDFgroupListWriteGStateResources(); - - /* b) Shader and shader masks */ - offs += gl2psPDFgroupListWriteShaderResources(); - + offs += gl2psPDFgroupListWriteGStateResources(); + + /* b) Shader and shader masks */ + offs += gl2psPDFgroupListWriteShaderResources(); + /* c) XObjects (Images & Shader Masks) */ offs += gl2psPDFgroupListWriteXObjectResources(); - + /* d) Fonts */ offs += gl2psPDFgroupListWriteFontResources(); - + /* End resources and page */ offs += fprintf(gl2ps->stream, ">>\n" @@ -4163,10 +4173,9 @@ /* 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), - GLfloat dx, GLfloat dy, +static int gl2psPrintPDFShaderStreamDataCoord(GL2PSvertex *vertex, + int (*action)(unsigned long data, int size), + GLfloat dx, GLfloat dy, GLfloat xmin, GLfloat ymin) { int offs = 0; @@ -4182,7 +4191,7 @@ /* The Shader stream in PDF requires to be in a 'big-endian' order */ - + if(GL2PS_ZERO(dx * dy)){ offs += (*action)(0, 4); offs += (*action)(0, 4); @@ -4195,7 +4204,7 @@ diff = 0.0F; imap = (unsigned long)(diff * dmax); offs += (*action)(imap, 4); - + diff = (vertex->xyz[1] - ymin) / dy; if(diff > 1) diff = 1.0F; @@ -4204,15 +4213,14 @@ imap = (unsigned long)(diff * dmax); offs += (*action)(imap, 4); } - + return offs; } /* 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; @@ -4223,21 +4231,20 @@ imap = (unsigned long)((vertex->rgba[0]) * dmax); offs += (*action)(imap, 1); - + imap = (unsigned long)((vertex->rgba[1]) * dmax); offs += (*action)(imap, 1); - + imap = (unsigned long)((vertex->rgba[2]) * dmax); offs += (*action)(imap, 1); - + return offs; } /* Put vertex' alpha (8/16bit) in shader stream */ -static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex, - size_t (*action)(unsigned long data, - size_t size), +static int gl2psPrintPDFShaderStreamDataAlpha(GL2PSvertex *vertex, + int (*action)(unsigned long data, int size), int sigbyte) { int offs = 0; @@ -4249,48 +4256,47 @@ if(sigbyte != 8 && sigbyte != 16) sigbyte = 8; - + sigbyte /= 8; - + imap = (unsigned long)((vertex->rgba[3]) * dmax); - + offs += (*action)(imap, sigbyte); - + return offs; } /* Put a triangles raw data in shader stream */ -static int gl2psPrintPDFShaderStreamData(GL2PStriangle *triangle, - GLfloat dx, GLfloat dy, +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; GL2PSvertex v; - + if(gray && gray != 8 && gray != 16) gray = 8; - + for(i = 0; i < 3; ++i){ offs += gl2psPrintPDFShaderStreamDataCoord(&triangle->vertex[i], action, dx, dy, xmin, ymin); - if(gray){ + if(gray){ v = triangle->vertex[i]; - offs += gl2psPrintPDFShaderStreamDataAlpha(&v, action, gray); + offs += gl2psPrintPDFShaderStreamDataAlpha(&v, action, gray); } else{ offs += gl2psPrintPDFShaderStreamDataRGB(&triangle->vertex[i], action); } } - + return offs; } -static void gl2psPDFRectHull(GLfloat *xmin, GLfloat *xmax, - GLfloat *ymin, GLfloat *ymax, +static void gl2psPDFRectHull(GLfloat *xmin, GLfloat *xmax, + GLfloat *ymin, GLfloat *ymax, GL2PStriangle *triangles, int cnt) { int i, j; @@ -4299,7 +4305,7 @@ *xmax = triangles[0].vertex[0].xyz[0]; *ymin = triangles[0].vertex[0].xyz[1]; *ymax = triangles[0].vertex[0].xyz[1]; - + for(i = 0; i < cnt; ++i){ for(j = 0; j < 3; ++j){ if(*xmin > triangles[i].vertex[j].xyz[0]) @@ -4314,17 +4320,17 @@ } } -/* Writes shaded triangle +/* Writes shaded triangle gray == 0 means write RGB triangles gray == 8 8bit-grayscale (for alpha masks) gray == 16 16bit-grayscale (for alpha masks) */ -static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles, +static int gl2psPrintPDFShader(int obj, GL2PStriangle *triangles, int size, int gray) { int i, offs = 0, vertexbytes, done = 0; GLfloat xmin, xmax, ymin, ymax; - + switch(gray){ case 0: vertexbytes = 1+4+4+1+1+1; @@ -4340,9 +4346,9 @@ vertexbytes = 1+4+4+1; break; } - + gl2psPDFRectHull(&xmin, &xmax, &ymin, &ymax, triangles, size); - + offs += fprintf(gl2ps->stream, "%d 0 obj\n" "<< " @@ -4353,18 +4359,18 @@ "/BitsPerFlag 8 " "/Decode [%f %f %f %f 0 1 %s] ", obj, - (gray) ? "/DeviceGray" : "/DeviceRGB", + (gray) ? "/DeviceGray" : "/DeviceRGB", (gray) ? gray : 8, xmin, xmax, ymin, ymax, (gray) ? "" : "0 1 0 1"); - + #if defined(GL2PS_HAVE_ZLIB) if(gl2ps->options & GL2PS_COMPRESS){ gl2psAllocCompress(vertexbytes * size * 3); for(i = 0; i < size; ++i) gl2psPrintPDFShaderStreamData(&triangles[i], - xmax-xmin, ymax-ymin, xmin, ymin, + xmax-xmin, ymax-ymin, xmin, ymin, gl2psWriteBigEndianCompress, gray); if(Z_OK == gl2psDeflate() && 23 + gl2ps->compress->destLen < gl2ps->compress->srcLen){ @@ -4374,8 +4380,8 @@ ">>\n" "stream\n", (int)gl2ps->compress->destLen); - offs += gl2ps->compress->destLen * fwrite(gl2ps->compress->dest, - gl2ps->compress->destLen, + offs += gl2ps->compress->destLen * fwrite(gl2ps->compress->dest, + gl2ps->compress->destLen, 1, gl2ps->stream); done = 1; } @@ -4396,11 +4402,11 @@ xmax-xmin, ymax-ymin, xmin, ymin, gl2psWriteBigEndian, gray); } - + offs += fprintf(gl2ps->stream, "\nendstream\n" "endobj\n"); - + return offs; } @@ -4409,7 +4415,7 @@ static int gl2psPrintPDFShaderMask(int obj, int childobj) { int offs = 0, len; - + offs += fprintf(gl2ps->stream, "%d 0 obj\n" "<<\n" @@ -4421,11 +4427,11 @@ obj, (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], (int)gl2ps->viewport[2], (int)gl2ps->viewport[3]); - - len = (childobj>0) + + len = (childobj>0) ? strlen("/TrSh sh\n") + (int)log10((double)childobj)+1 - : strlen("/TrSh0 sh\n"); - + : strlen("/TrSh0 sh\n"); + offs += fprintf(gl2ps->stream, "/Length %d\n" ">>\n" @@ -4437,7 +4443,7 @@ offs += fprintf(gl2ps->stream, "endstream\n" "endobj\n"); - + return offs; } @@ -4448,16 +4454,16 @@ static int gl2psPrintPDFShaderExtGS(int obj, int childobj) { int offs = 0; - + offs += fprintf(gl2ps->stream, "%d 0 obj\n" "<<\n", obj); - + offs += fprintf(gl2ps->stream, "/SMask << /S /Alpha /G %d 0 R >> ", childobj); - + offs += fprintf(gl2ps->stream, ">>\n" "endobj\n"); @@ -4469,7 +4475,7 @@ static int gl2psPrintPDFShaderSimpleExtGS(int obj, GLfloat alpha) { int offs = 0; - + offs += fprintf(gl2ps->stream, "%d 0 obj\n" "<<\n" @@ -4483,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; @@ -4497,7 +4502,7 @@ gray = 8; gray /= 8; - + shift = (sizeof(unsigned long) - 1) * 8; for(y = 0; y < im->height; ++y){ @@ -4528,10 +4533,10 @@ if(gray && gray !=8 && gray != 16) gray = 8; - + if(gray) - sigbytes = gray / 8; - + sigbytes = gray / 8; + offs += fprintf(gl2ps->stream, "%d 0 obj\n" "<<\n" @@ -4549,13 +4554,13 @@ "/SMask %d 0 R\n", childobj); } - + #if defined(GL2PS_HAVE_ZLIB) if(gl2ps->options & GL2PS_COMPRESS){ gl2psAllocCompress((int)(im->width * im->height * sigbytes)); - + gl2psPrintPDFPixmapStreamData(im, gl2psWriteBigEndianCompress, gray); - + if(Z_OK == gl2psDeflate() && 23 + gl2ps->compress->destLen < gl2ps->compress->srcLen){ offs += gl2psPrintPDFCompressorType(); offs += fprintf(gl2ps->stream, @@ -4570,7 +4575,7 @@ gl2psFreeCompress(); } #endif - + if(!done){ /* no compression, or too long after compression, or compress error -> write non-compressed entry */ @@ -4581,18 +4586,18 @@ (int)(im->width * im->height * sigbytes)); offs += gl2psPrintPDFPixmapStreamData(im, gl2psWriteBigEndian, gray); } - + offs += fprintf(gl2ps->stream, "\nendstream\n" "endobj\n"); - + return offs; } static int gl2psPrintPDFText(int obj, GL2PSstring *s, int fontnumber) { int offs = 0; - + offs += fprintf(gl2ps->stream, "%d 0 obj\n" "<<\n" @@ -4620,9 +4625,9 @@ if(!gl2ps->pdfgrouplist) return offs; - - for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ - gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); + + for(i = 0; i < gl2psListNbr(gl2ps->pdfgrouplist); ++i){ + gro = (GL2PSpdfgroup*)gl2psListPointer(gl2ps->pdfgrouplist, i); if(!gl2psListNbr(gro->ptrlist)) continue; p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, 0); @@ -4634,7 +4639,7 @@ case GL2PS_TRIANGLE: size = gl2psListNbr(gro->ptrlist); triangles = (GL2PStriangle*)gl2psMalloc(sizeof(GL2PStriangle) * size); - for(j = 0; j < size; ++j){ + for(j = 0; j < size; ++j){ p = *(GL2PSprimitive**)gl2psListPointer(gro->ptrlist, j); gl2psFillTriangleFromPrimitive(&triangles[j], p, GL_TRUE); } @@ -4676,7 +4681,7 @@ break; default: break; - } + } } return offs; } @@ -4687,29 +4692,29 @@ static void gl2psPrintPDFFooter(void) { - int i, offs; + int i, offs; gl2psPDFgroupListInit(); gl2psPDFgroupListWriteMainStream(); - - offs = gl2ps->xreflist[5] + gl2ps->streamlength; + + offs = gl2ps->xreflist[5] + gl2ps->streamlength; offs += gl2psClosePDFDataStream(); gl2ps->xreflist[5] = offs; - + offs += gl2psPrintPDFDataStreamLength(gl2ps->streamlength); gl2ps->xreflist[6] = offs; gl2ps->streamlength = 0; - + offs += gl2psPrintPDFOpenPage(); offs += gl2psPDFgroupListWriteVariableResources(); gl2ps->xreflist = (int*)gl2psRealloc(gl2ps->xreflist, sizeof(int) * (gl2ps->objects_stack + 1)); gl2ps->xreflist[7] = offs; - + offs += gl2psPrintPDFGSObject(); gl2ps->xreflist[8] = offs; - - gl2ps->xreflist[gl2ps->objects_stack] = + + gl2ps->xreflist[gl2ps->objects_stack] = gl2psPDFgroupListWriteObjects(gl2ps->xreflist[8]); /* Start cross reference table. The file has to been opened in @@ -4718,13 +4723,13 @@ "xref\n" "0 %d\n" "%010d 65535 f \n", gl2ps->objects_stack, 0); - + for(i = 1; i < gl2ps->objects_stack; ++i) fprintf(gl2ps->stream, "%010d 00000 n \n", gl2ps->xreflist[i]); - + fprintf(gl2ps->stream, "trailer\n" - "<<\n" + "<<\n" "/Size %d\n" "/Info 1 0 R\n" "/Root 2 0 R\n" @@ -4732,13 +4737,13 @@ "startxref\n%d\n" "%%%%EOF\n", gl2ps->objects_stack, gl2ps->xreflist[gl2ps->objects_stack]); - - /* Free auxiliary lists and arrays */ + + /* Free auxiliary lists and arrays */ gl2psFree(gl2ps->xreflist); gl2psListAction(gl2ps->pdfprimlist, gl2psFreePrimitive); gl2psListDelete(gl2ps->pdfprimlist); gl2psPDFgroupListDelete(); - + #if defined(GL2PS_HAVE_ZLIB) if(gl2ps->options & GL2PS_COMPRESS){ gl2psFreeCompress(); @@ -4756,16 +4761,16 @@ GLint index; GLfloat rgba[4]; int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; - + glRenderMode(GL_FEEDBACK); - + if(gl2ps->header){ gl2psPrintPDFHeader(); gl2ps->header = GL_FALSE; } offs += gl2psPrintf("q\n"); - + if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ if(gl2ps->colormode == GL_RGBA || gl2ps->colorsize == 0){ glGetFloatv(GL_COLOR_CLEAR_VALUE, rgba); @@ -4785,18 +4790,18 @@ } else{ offs += gl2psPrintf("%d %d %d %d re\n" - "W\n" + "W\n" "n\n", - x, y, w, h); - } - + x, y, w, h); + } + gl2ps->streamlength += offs; } static GLint gl2psPrintPDFEndViewport(void) { GLint res; - + res = gl2psPrintPrimitives(); gl2ps->streamlength += gl2psPrintf("Q\n"); return res; @@ -4819,13 +4824,13 @@ "Portable Document Format" }; -/********************************************************************* +/********************************************************************* * * SVG routines * *********************************************************************/ -static void gl2psSVGGetCoordsAndColors(int n, GL2PSvertex *verts, +static void gl2psSVGGetCoordsAndColors(int n, GL2PSvertex *verts, GL2PSxyz *xyz, GL2PSrgba *rgba) { int i, j; @@ -4855,9 +4860,9 @@ int x, y, width, height; char col[32]; time_t now; - + time(&now); - + if (gl2ps->options & GL2PS_LANDSCAPE){ x = (int)gl2ps->viewport[1]; y = (int)gl2ps->viewport[0]; @@ -4870,10 +4875,10 @@ width = (int)gl2ps->viewport[2]; height = (int)gl2ps->viewport[3]; } - + /* Compressed SVG files (.svgz) are simply gzipped SVG files */ gl2psPrintGzipHeader(); - + gl2psPrintf("<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"no\"?>\n"); gl2psPrintf("<svg xmlns=\"http://www.w3.org/2000/svg\"\n"); gl2psPrintf(" xmlns:xlink=\"http://www.w3.org/1999/xlink\"\n" @@ -4893,9 +4898,9 @@ if(gl2ps->options & GL2PS_DRAW_BACKGROUND){ gl2psSVGGetColorString(gl2ps->bgcolor, col); gl2psPrintf("<polygon fill=\"%s\" points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n", col, - (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], - (int)gl2ps->viewport[2], (int)gl2ps->viewport[1], - (int)gl2ps->viewport[2], (int)gl2ps->viewport[3], + (int)gl2ps->viewport[0], (int)gl2ps->viewport[1], + (int)gl2ps->viewport[2], (int)gl2ps->viewport[1], + (int)gl2ps->viewport[2], (int)gl2ps->viewport[3], (int)gl2ps->viewport[0], (int)gl2ps->viewport[3]); } @@ -4918,52 +4923,52 @@ gl2psSVGGetColorString(rgba[0], col); gl2psPrintf("<polygon fill=\"%s\" ", col); if(rgba[0][3] < 1.0F) gl2psPrintf("fill-opacity=\"%g\" ", rgba[0][3]); - gl2psPrintf("points=\"%g,%g %g,%g %g,%g\"/>\n", xyz[0][0], xyz[0][1], + gl2psPrintf("points=\"%g,%g %g,%g %g,%g\"/>\n", xyz[0][0], xyz[0][1], xyz[1][0], xyz[1][1], xyz[2][0], xyz[2][1]); } else{ /* subdivide into 4 subtriangles */ for(i = 0; i < 3; i++){ - xyz2[0][i] = xyz[0][i]; + xyz2[0][i] = xyz[0][i]; xyz2[1][i] = 0.5F * (xyz[0][i] + xyz[1][i]); xyz2[2][i] = 0.5F * (xyz[0][i] + xyz[2][i]); } for(i = 0; i < 4; i++){ - rgba2[0][i] = rgba[0][i]; + rgba2[0][i] = rgba[0][i]; rgba2[1][i] = 0.5F * (rgba[0][i] + rgba[1][i]); rgba2[2][i] = 0.5F * (rgba[0][i] + rgba[2][i]); } gl2psPrintSVGSmoothTriangle(xyz2, rgba2); for(i = 0; i < 3; i++){ xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[1][i]); - xyz2[1][i] = xyz[1][i]; + xyz2[1][i] = xyz[1][i]; xyz2[2][i] = 0.5F * (xyz[1][i] + xyz[2][i]); } for(i = 0; i < 4; i++){ rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[1][i]); - rgba2[1][i] = rgba[1][i]; + rgba2[1][i] = rgba[1][i]; rgba2[2][i] = 0.5F * (rgba[1][i] + rgba[2][i]); } gl2psPrintSVGSmoothTriangle(xyz2, rgba2); for(i = 0; i < 3; i++){ xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[2][i]); - xyz2[1][i] = xyz[2][i]; + xyz2[1][i] = xyz[2][i]; xyz2[2][i] = 0.5F * (xyz[1][i] + xyz[2][i]); } for(i = 0; i < 4; i++){ rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[2][i]); - rgba2[1][i] = rgba[2][i]; + rgba2[1][i] = rgba[2][i]; rgba2[2][i] = 0.5F * (rgba[1][i] + rgba[2][i]); } gl2psPrintSVGSmoothTriangle(xyz2, rgba2); for(i = 0; i < 3; i++){ xyz2[0][i] = 0.5F * (xyz[0][i] + xyz[1][i]); - xyz2[1][i] = 0.5F * (xyz[1][i] + xyz[2][i]); + xyz2[1][i] = 0.5F * (xyz[1][i] + xyz[2][i]); xyz2[2][i] = 0.5F * (xyz[0][i] + xyz[2][i]); } for(i = 0; i < 4; i++){ rgba2[0][i] = 0.5F * (rgba[0][i] + rgba[1][i]); - rgba2[1][i] = 0.5F * (rgba[1][i] + rgba[2][i]); + rgba2[1][i] = 0.5F * (rgba[1][i] + rgba[2][i]); rgba2[2][i] = 0.5F * (rgba[0][i] + rgba[2][i]); } gl2psPrintSVGSmoothTriangle(xyz2, rgba2); @@ -4989,7 +4994,7 @@ { int i; if(gl2ps->lastvertex.rgba[0] >= 0.){ - gl2psPrintf("%g,%g\"/>\n", gl2ps->lastvertex.xyz[0], + gl2psPrintf("%g,%g\"/>\n", gl2ps->lastvertex.xyz[0], gl2ps->viewport[3] - gl2ps->lastvertex.xyz[1]); for(i = 0; i < 3; i++) gl2ps->lastvertex.xyz[i] = -1.; @@ -5011,7 +5016,7 @@ file), we need to encode the pixmap into PNG in memory, then encode it into base64. */ - png = gl2psListCreate(pixmap->width * pixmap->height * 3, 1000, + png = gl2psListCreate(pixmap->width * pixmap->height * 3, 1000, sizeof(unsigned char)); gl2psConvertPixmapToPNG(pixmap, png); gl2psListEncodeBase64(png); @@ -5025,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 @@ -5080,7 +5086,7 @@ gl2ps->lastfactor = prim->factor; if(newline){ gl2psSVGGetColorString(rgba[0], col); - gl2psPrintf("<polyline fill=\"none\" stroke=\"%s\" stroke-width=\"%g\" ", + gl2psPrintf("<polyline fill=\"none\" stroke=\"%s\" stroke-width=\"%g\" ", col, prim->width); if(rgba[0][3] < 1.0F) gl2psPrintf("stroke-opacity=\"%g\" ", rgba[0][3]); gl2psPrintSVGDash(prim->pattern, prim->factor); @@ -5106,6 +5112,42 @@ if(prim->data.text->angle) gl2psPrintf("transform=\"rotate(%g, %g, %g)\" ", -prim->data.text->angle, xyz[0][0], xyz[0][1]); + switch(prim->data.text->alignment){ + case GL2PS_TEXT_C: + gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize / 2); + break; + case GL2PS_TEXT_CL: + gl2psPrintf("text-anchor=\"start\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize / 2); + break; + case GL2PS_TEXT_CR: + gl2psPrintf("text-anchor=\"end\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize / 2); + break; + case GL2PS_TEXT_B: + gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"0\" "); + break; + case GL2PS_TEXT_BR: + gl2psPrintf("text-anchor=\"end\" baseline-shift=\"0\" "); + break; + case GL2PS_TEXT_T: + gl2psPrintf("text-anchor=\"middle\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize); + break; + case GL2PS_TEXT_TL: + gl2psPrintf("text-anchor=\"start\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize); + break; + case GL2PS_TEXT_TR: + gl2psPrintf("text-anchor=\"end\" baseline-shift=\"%d\" ", + -prim->data.text->fontsize); + break; + case GL2PS_TEXT_BL: + default: /* same as GL2PS_TEXT_BL */ + gl2psPrintf("text-anchor=\"start\" baseline-shift=\"0\" "); + break; + } if(!strcmp(prim->data.text->fontname, "Times-Roman")) gl2psPrintf("font-family=\"Times\">"); else if(!strcmp(prim->data.text->fontname, "Times-Bold")) @@ -5144,8 +5186,8 @@ static void gl2psPrintSVGFooter(void) { gl2psPrintf("</g>\n"); - gl2psPrintf("</svg>\n"); - + gl2psPrintf("</svg>\n"); + gl2psPrintGzipFooter(); } @@ -5157,7 +5199,7 @@ int x = viewport[0], y = viewport[1], w = viewport[2], h = viewport[3]; glRenderMode(GL_FEEDBACK); - + if(gl2ps->header){ gl2psPrintSVGHeader(); gl2ps->header = GL_FALSE; @@ -5175,18 +5217,18 @@ rgba[3] = 1.0F; } gl2psSVGGetColorString(rgba, col); - gl2psPrintf("<polygon fill=\"%s\" points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n", col, - x, gl2ps->viewport[3] - y, - x + w, gl2ps->viewport[3] - y, - x + w, gl2ps->viewport[3] - (y + h), + gl2psPrintf("<polygon fill=\"%s\" points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n", col, + x, gl2ps->viewport[3] - y, + x + w, gl2ps->viewport[3] - y, + x + w, gl2ps->viewport[3] - (y + h), x, gl2ps->viewport[3] - (y + h)); } gl2psPrintf("<clipPath id=\"cp%d%d%d%d\">\n", x, y, w, h); - gl2psPrintf(" <polygon points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n", - x, gl2ps->viewport[3] - y, - x + w, gl2ps->viewport[3] - y, - x + w, gl2ps->viewport[3] - (y + h), + gl2psPrintf(" <polygon points=\"%d,%d %d,%d %d,%d %d,%d\"/>\n", + x, gl2ps->viewport[3] - y, + x + w, gl2ps->viewport[3] - y, + x + w, gl2ps->viewport[3] - (y + h), x, gl2ps->viewport[3] - (y + h)); gl2psPrintf("</clipPath>\n"); gl2psPrintf("<g clip-path=\"url(#cp%d%d%d%d)\">\n", x, y, w, h); @@ -5240,7 +5282,7 @@ time(&now); - fprintf(gl2ps->stream, + fprintf(gl2ps->stream, "%% Title: %s\n" "%% Creator: GL2PS %d.%d.%d%s, %s\n" "%% For: %s\n" @@ -5294,7 +5336,7 @@ case GL2PS_TEXT_T : return "north"; case GL2PS_TEXT_TL : return "north west"; case GL2PS_TEXT_TR : return "north east"; - case GL2PS_TEXT_BL : + case GL2PS_TEXT_BL : default : return "south west"; } } @@ -5309,7 +5351,7 @@ case GL2PS_POINT : /* Points in openGL are rectangular */ gl2psPrintPGFColor(prim->verts[0].rgba); - fprintf(gl2ps->stream, + fprintf(gl2ps->stream, "\\pgfpathrectangle{\\pgfpoint{%fpt}{%fpt}}" "{\\pgfpoint{%fpt}{%fpt}}\n\\pgfusepath{fill}\n", prim->verts[0].xyz[0]-0.5*prim->width, @@ -5323,7 +5365,7 @@ fprintf(gl2ps->stream, "\\pgfsetlinewidth{%fpt}\n", gl2ps->lastlinewidth); } gl2psPrintPGFDash(prim->pattern, prim->factor); - fprintf(gl2ps->stream, + fprintf(gl2ps->stream, "\\pgfpathmoveto{\\pgfpoint{%fpt}{%fpt}}\n" "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" "\\pgfusepath{stroke}\n", @@ -5336,7 +5378,7 @@ fprintf(gl2ps->stream, "\\pgfsetlinewidth{0.01pt}\n"); } gl2psPrintPGFColor(prim->verts[0].rgba); - fprintf(gl2ps->stream, + fprintf(gl2ps->stream, "\\pgfpathmoveto{\\pgfpoint{%fpt}{%fpt}}\n" "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" "\\pgflineto{\\pgfpoint{%fpt}{%fpt}}\n" @@ -5405,14 +5447,14 @@ rgba[3] = 1.0F; } gl2psPrintPGFColor(rgba); - fprintf(gl2ps->stream, + fprintf(gl2ps->stream, "\\pgfpathrectangle{\\pgfpoint{%dpt}{%dpt}}" "{\\pgfpoint{%dpt}{%dpt}}\n" "\\pgfusepath{fill}\n", x, y, w, h); } - - fprintf(gl2ps->stream, + + fprintf(gl2ps->stream, "\\pgfpathrectangle{\\pgfpoint{%dpt}{%dpt}}" "{\\pgfpoint{%dpt}{%dpt}}\n" "\\pgfusepath{clip}\n", @@ -5444,7 +5486,7 @@ "PGF Latex Graphics" }; -/********************************************************************* +/********************************************************************* * * General primitive printing routine * @@ -5479,7 +5521,7 @@ if(prim->verts[i].xyz[1] > gl2ps->viewport[3]) gl2ps->viewport[3] = (GLint)(prim->verts[i].xyz[1] + 0.5F); } -} +} static GLint gl2psPrintPrimitives(void) { @@ -5500,7 +5542,7 @@ gl2psRescaleAndOffset(); if(gl2ps->header){ - if(gl2psListNbr(gl2ps->primitives) && + if(gl2psListNbr(gl2ps->primitives) && (gl2ps->options & GL2PS_TIGHT_BOUNDING_BOX)){ gl2ps->viewport[0] = gl2ps->viewport[1] = 100000; gl2ps->viewport[2] = gl2ps->viewport[3] = -100000; @@ -5542,7 +5584,7 @@ gl2psAddInImageTree, 1); gl2psFreeBspImageTree(&gl2ps->imagetree); } - gl2psTraverseBspTree(root, eye, GL2PS_EPSILON, gl2psGreater, + gl2psTraverseBspTree(root, eye, GL2PS_EPSILON, gl2psGreater, gl2psbackends[gl2ps->format]->printPrimitive, 0); gl2psFreeBspTree(&root); /* reallocate the primitive list (it's been deleted by @@ -5555,13 +5597,13 @@ return GL2PS_SUCCESS; } -/********************************************************************* +/********************************************************************* * * Public routines * *********************************************************************/ -GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer, +GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer, GLint viewport[4], GLint format, GLint sort, GLint options, GLint colormode, GLint colorsize, GL2PSrgba *colormap, @@ -5629,7 +5671,7 @@ if(!gl2ps->viewport[2] || !gl2ps->viewport[3]){ gl2psMsg(GL2PS_ERROR, "Incorrect viewport (x=%d, y=%d, width=%d, height=%d)", - gl2ps->viewport[0], gl2ps->viewport[1], + gl2ps->viewport[0], gl2ps->viewport[1], gl2ps->viewport[2], gl2ps->viewport[3]); gl2psFree(gl2ps); gl2ps = NULL; @@ -5653,11 +5695,11 @@ gl2ps->lastfactor = 0; gl2ps->imagetree = NULL; gl2ps->primitivetoadd = NULL; - gl2ps->zerosurfacearea = GL_FALSE; + gl2ps->zerosurfacearea = GL_FALSE; gl2ps->pdfprimlist = NULL; gl2ps->pdfgrouplist = NULL; gl2ps->xreflist = NULL; - + /* get default blending mode from current OpenGL state (enabled by default for SVG) */ gl2ps->blending = (gl2ps->format == GL2PS_SVG) ? GL_TRUE : glIsEnabled(GL_BLEND); @@ -5700,7 +5742,7 @@ gl2ps->title = (char*)gl2psMalloc((strlen(title)+1)*sizeof(char)); strcpy(gl2ps->title, title); } - + if(!producer){ gl2ps->producer = (char*)gl2psMalloc(sizeof(char)); gl2ps->producer[0] = '\0'; @@ -5709,7 +5751,7 @@ gl2ps->producer = (char*)gl2psMalloc((strlen(producer)+1)*sizeof(char)); strcpy(gl2ps->producer, producer); } - + if(!filename){ gl2ps->filename = (char*)gl2psMalloc(sizeof(char)); gl2ps->filename[0] = '\0'; @@ -5723,7 +5765,7 @@ gl2ps->auxprimitives = gl2psListCreate(100, 100, sizeof(GL2PSprimitive*)); gl2ps->feedback = (GLfloat*)gl2psMalloc(gl2ps->buffersize * sizeof(GLfloat)); glFeedbackBuffer(gl2ps->buffersize, GL_3D_COLOR, gl2ps->feedback); - glRenderMode(GL_FEEDBACK); + glRenderMode(GL_FEEDBACK); return GL2PS_SUCCESS; } @@ -5738,7 +5780,7 @@ if(res != GL2PS_OVERFLOW) (gl2psbackends[gl2ps->format]->printFooter)(); - + fflush(gl2ps->stream); gl2psListDelete(gl2ps->primitives); @@ -5760,7 +5802,7 @@ if(!gl2ps) return GL2PS_UNINITIALIZED; (gl2psbackends[gl2ps->format]->beginViewport)(viewport); - + return GL2PS_SUCCESS; } @@ -5778,7 +5820,7 @@ return res; } -GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname, +GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname, GLshort fontsize, GLint alignment, GLfloat angle) { return gl2psAddText(GL2PS_TEXT, str, fontname, fontsize, alignment, angle); @@ -5796,11 +5838,12 @@ GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height, GLint xorig, GLint yorig, - GLenum format, GLenum type, + GLenum format, GLenum type, const void *pixels) { int size, i; - GLfloat pos[4], *piv; + const GLfloat *piv; + GLfloat pos[4], zoom_x, zoom_y; GL2PSprimitive *prim; GLboolean valid; @@ -5820,6 +5863,8 @@ if(GL_FALSE == valid) return GL2PS_SUCCESS; /* the primitive is culled */ glGetFloatv(GL_CURRENT_RASTER_POSITION, pos); + glGetFloatv(GL_ZOOM_X, &zoom_x); + glGetFloatv(GL_ZOOM_Y, &zoom_y); prim = (GL2PSprimitive*)gl2psMalloc(sizeof(GL2PSprimitive)); prim->type = GL2PS_PIXMAP; @@ -5838,6 +5883,8 @@ prim->data.image = (GL2PSimage*)gl2psMalloc(sizeof(GL2PSimage)); prim->data.image->width = width; prim->data.image->height = height; + prim->data.image->zoom_x = zoom_x; + prim->data.image->zoom_y = zoom_y; prim->data.image->format = format; prim->data.image->type = type; @@ -5848,12 +5895,12 @@ 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)) + if(!((i + 1) % 3)) ++piv; - } + } } else{ size = height * width * 4; @@ -5880,11 +5927,11 @@ const unsigned char *imagemap){ int size, i; int sizeoffloat = sizeof(GLfloat); - + if(!gl2ps || !imagemap) return GL2PS_UNINITIALIZED; if((width <= 0) || (height <= 0)) return GL2PS_ERROR; - + size = height + height * ((width - 1) / 8); glPassThrough(GL2PS_IMAGEMAP_TOKEN); glBegin(GL_POINTS); @@ -5893,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; } @@ -5964,7 +6011,7 @@ glPassThrough(GL2PS_POINT_SIZE_TOKEN); glPassThrough(value); - + return GL2PS_SUCCESS; }
--- a/src/gl2ps.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/gl2ps.h Tue Oct 11 14:08:38 2011 -0500 @@ -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: @@ -80,14 +80,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!) */ @@ -139,9 +139,9 @@ #define GL2PS_BLEND 4 /* Text alignment (o=raster position; default mode is BL): - +---+ +---+ +---+ +---+ +---+ +---+ +-o-+ o---+ +---o - | o | o | | o | | | | | | | | | | | | - +---+ +---+ +---+ +-o-+ o---+ +---o +---+ +---+ +---+ + +---+ +---+ +---+ +---+ +---+ +---+ +-o-+ o---+ +---o + | o | o | | o | | | | | | | | | | | | + +---+ +---+ +---+ +-o-+ o---+ +---o +---+ +---+ +---+ C CL CR B BL BR T TL TR */ #define GL2PS_TEXT_C 1 @@ -160,10 +160,10 @@ extern "C" { #endif -GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer, +GL2PSDLL_API GLint gl2psBeginPage(const char *title, const char *producer, GLint viewport[4], GLint format, GLint sort, GLint options, GLint colormode, - GLint colorsize, GL2PSrgba *colormap, + GLint colorsize, GL2PSrgba *colormap, GLint nr, GLint ng, GLint nb, GLint buffersize, FILE *stream, const char *filename); GL2PSDLL_API GLint gl2psEndPage(void); @@ -171,9 +171,9 @@ GL2PSDLL_API GLint gl2psGetOptions(GLint *options); GL2PSDLL_API GLint gl2psBeginViewport(GLint viewport[4]); GL2PSDLL_API GLint gl2psEndViewport(void); -GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname, +GL2PSDLL_API GLint gl2psText(const char *str, const char *fontname, GLshort fontsize); -GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname, +GL2PSDLL_API GLint gl2psTextOpt(const char *str, const char *fontname, GLshort fontsize, GLint align, GLfloat angle); GL2PSDLL_API GLint gl2psSpecial(GLint format, const char *str); GL2PSDLL_API GLint gl2psDrawPixels(GLsizei width, GLsizei height,
--- a/src/graphics.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/graphics.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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" @@ -308,6 +310,100 @@ } 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)) @@ -315,6 +411,7 @@ 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 +424,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 +447,7 @@ retval(2) = 0.5 * pos(2) * f; retval(3) = pos(3) * f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -377,7 +474,7 @@ retval(2) = pos(2) * f; retval(3) = pos(3) * f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -393,7 +490,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 +511,7 @@ retval(2) = 2 * retval(2) / f; retval(3) = retval(3) / f; } - else + else if (! is_2d) retval(2) = 0; } } @@ -441,12 +538,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 +754,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 +774,9 @@ if (e > 0 && e < eminp) eminp = e; + + if (e < 0 && e > emaxp) + emaxp = e; } } } @@ -712,8 +812,16 @@ { 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")) + offset = 9; + } } } } @@ -754,27 +862,27 @@ 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); 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 +903,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 +1030,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 +1101,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 +1251,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); } } @@ -1427,6 +1548,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 +1628,16 @@ { 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")) + offset = 9; + } } } } @@ -1493,6 +1670,10 @@ 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); if (has_property) { @@ -1557,8 +1738,16 @@ { 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")) + offset = 9; + } } } } @@ -1873,9 +2062,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 @@ -2044,6 +2231,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 +2250,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 @@ -2306,6 +2502,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")) @@ -2756,7 +2957,7 @@ } Matrix -figure::properties::get_boundingbox (bool) const +figure::properties::get_boundingbox (bool, const Matrix&) const { Matrix screen_size = screen_size_pixels (); Matrix pos; @@ -2785,6 +2986,40 @@ set_position (pos); } +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) { @@ -3393,7 +3628,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; @@ -3466,7 +3701,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; } @@ -4693,7 +4928,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)) { @@ -4836,20 +5072,27 @@ // 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; } @@ -4935,7 +5178,7 @@ ext(2) = ext(2)-ext(0); ext(3) = ext(3)-ext(1); - + return ext; } @@ -4982,31 +5225,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) { @@ -5069,7 +5307,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 (); @@ -5081,18 +5320,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; @@ -5107,6 +5350,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; } } } @@ -5124,8 +5371,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); } } @@ -5171,7 +5418,8 @@ 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; @@ -5182,13 +5430,17 @@ { if (logscale) { - if (xisinf (min_pos)) + if (xisinf (min_pos) && xisinf (max_neg)) { - // FIXME -- need to handle log plots with all negative data. - return default_lim (); + // 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; @@ -5199,8 +5451,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, gnulib::floor (log10 (-min_val))); + max_val = -pow (10, std::ceil (log10 (-max_val))); + } } else { @@ -5246,23 +5508,41 @@ 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); + if (is_logscale && ! (xisinf (hi) || xisinf (lo))) + { + // FIXME - what if (hi-lo) < tick_sep? + // ex: loglog ([1 1.1]) + tick_sep = std::max (tick_sep, 1.); + tick_sep = std::ceil (tick_sep); + } + int i1 = static_cast<int> (gnulib::floor (lo / tick_sep)); int i2 = static_cast<int> (std::ceil (hi / tick_sep)); @@ -5279,6 +5559,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; } @@ -5296,6 +5582,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; @@ -5315,17 +5608,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; @@ -5367,7 +5698,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 (); @@ -5383,7 +5715,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; @@ -5397,7 +5729,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; @@ -5411,7 +5743,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; @@ -5425,7 +5757,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; @@ -5439,7 +5771,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; @@ -5463,6 +5795,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; @@ -5470,7 +5803,7 @@ double val; #define FIX_LIMITS \ - if (limits.numel() == 3) \ + if (limits.numel() == 4) \ { \ val = limits(0); \ if (! (xisinf (val) || xisnan (val))) \ @@ -5481,13 +5814,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" @@ -5499,9 +5836,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'; @@ -5516,9 +5854,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'; @@ -5533,9 +5872,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'; @@ -5550,7 +5890,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) { @@ -5558,7 +5898,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); @@ -5578,7 +5921,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) { @@ -5654,6 +5997,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; @@ -5665,9 +6009,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'; @@ -5679,9 +6024,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'; @@ -5693,9 +6039,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'; @@ -5707,7 +6054,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) { @@ -5715,7 +6062,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); @@ -5732,7 +6082,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) { @@ -5818,12 +6168,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); @@ -5867,12 +6219,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; @@ -5935,16 +6289,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; } @@ -5952,11 +6318,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; } @@ -6077,6 +6444,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 @@ -6238,6 +6622,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; @@ -6270,7 +6655,7 @@ update_type = 'a'; } - if (limits.numel() == 3) + if (limits.numel() == 4) { val = limits(0); if (! (xisinf (val) || xisnan (val))) @@ -6281,27 +6666,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) { @@ -6344,36 +6735,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'; } @@ -6383,11 +6775,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) { @@ -6421,6 +6814,279 @@ // --------------------------------------------------------------------- octave_value +uicontrol::properties::get_extent (void) const +{ + Matrix m = extent.get ().matrix_value (); + + graphics_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (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_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (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_handle parent = get_parent (); + graphics_object parent_obj = gh_manager::get_object (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 base_graphics_object::get_default (const caseless_str& name) const { graphics_handle parent = get_parent (); @@ -6442,7 +7108,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 ()); @@ -6452,7 +7119,8 @@ graphics_handle gh_manager::do_make_graphics_handle (const std::string& go_name, - const graphics_handle& p, bool do_createfcn) + const graphics_handle& p, bool do_createfcn, + bool do_notify_toolkit) { graphics_handle h = get_handle (go_name); @@ -6469,9 +7137,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'", @@ -6481,7 +7148,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; @@ -6491,9 +7158,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; } @@ -6528,11 +7194,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: @@ -6544,6 +7218,7 @@ private: graphics_handle handle; std::string callback_name; + octave_value callback; octave_value callback_data; }; @@ -6581,15 +7256,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: @@ -6601,6 +7284,7 @@ graphics_handle handle; std::string property_name; octave_value property_value; + bool notify_toolkit; }; graphics_event @@ -6616,6 +7300,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) { @@ -6629,11 +7325,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; } @@ -6651,7 +7348,7 @@ void gh_manager::do_restore_gcbo (void) { - gh_manager::autolock guard; + gh_manager::auto_lock guard; callback_objects.pop_front (); @@ -6661,69 +7358,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 @@ -6738,7 +7452,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); @@ -6777,69 +7491,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 lock; + + 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) { @@ -6854,6 +7607,8 @@ 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 (); return plist_map; } @@ -6870,7 +7625,7 @@ @seealso{isfigure}\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -6946,7 +7701,7 @@ @end itemize\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7034,6 +7789,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\ @@ -7043,7 +7813,7 @@ values or lists respectively.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7067,31 +7837,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; + } } } } @@ -7109,6 +7905,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; } @@ -7130,7 +7935,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7221,7 +8026,7 @@ if (parent.ok ()) { graphics_handle h - = gh_manager::make_graphics_handle (go_name, parent, false); + = gh_manager::make_graphics_handle (go_name, parent, false, false); if (! error_state) { @@ -7229,6 +8034,7 @@ xset (h, xargs); xcreatefcn (h); + xinitialize (h); retval = h.value (); @@ -7254,7 +8060,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7277,9 +8083,10 @@ graphics_handle h = octave_NaN; if (xisnan (val)) - h = gh_manager::make_graphics_handle ("figure", 0, false); + h = gh_manager::make_graphics_handle ("figure", 0, false, + false); else if (val > 0 && D_NINT (val) == val) - h = gh_manager::make_figure_handle (val); + h = gh_manager::make_figure_handle (val, false); else error ("__go_figure__: invalid figure number"); @@ -7289,6 +8096,7 @@ xset (h, args.splice (0, 1)); xcreatefcn (h); + xinitialize (h); retval = h.value (); } @@ -7306,7 +8114,7 @@ } #define GO_BODY(TYPE) \ - gh_manager::autolock guard; \ + gh_manager::auto_lock guard; \ \ octave_value retval; \ \ @@ -7357,7 +8165,7 @@ object, whether 2 or 3.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7450,13 +8258,31 @@ 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_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; @@ -7534,7 +8360,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7588,7 +8414,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; return octave_value (gh_manager::handle_list ()); } @@ -7599,7 +8425,7 @@ Undocumented internal function.\n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; return octave_value (gh_manager::figure_handle_list ()); } @@ -7695,7 +8521,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 ()); } @@ -7902,7 +8728,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -7974,7 +8800,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -8094,7 +8920,7 @@ \n\ @end deftypefn") { - gh_manager::autolock guard; + gh_manager::auto_lock guard; octave_value retval; @@ -8152,7 +8978,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; @@ -8169,7 +8995,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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/graphics.h.in Tue Oct 11 14:08:38 2011 -0500 @@ -364,7 +364,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); + bool set (const octave_value& v, bool do_run = true, + bool do_notify_toolkit = true); virtual octave_value get (void) const { @@ -599,6 +600,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); @@ -886,11 +889,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; @@ -899,9 +902,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; @@ -964,11 +1004,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; } } @@ -1288,7 +1336,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 (); } @@ -1296,7 +1345,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 (); } @@ -1306,7 +1356,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 () { } @@ -1321,14 +1371,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; } @@ -1383,6 +1435,7 @@ double xmin; double xmax; double xminp; + double xmaxp; std::list<std::string> type_constraints; std::list<dim_vector> size_constraints; }; @@ -1858,8 +1911,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 (); } @@ -2028,10 +2082,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 @@ -2123,11 +2177,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 @@ -2185,6 +2239,7 @@ // --------------------------------------------------------------------- class base_graphics_object; +class graphics_object; class OCTINTERP_API base_properties { @@ -2253,7 +2308,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); @@ -2397,7 +2453,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) { } @@ -2558,6 +2614,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 () @@ -2610,9 +2668,35 @@ } 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&); @@ -2808,6 +2892,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 (); } @@ -2980,15 +3070,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) { @@ -3013,10 +3095,15 @@ } } - Matrix get_boundingbox (bool internal = false) const; + Matrix get_boundingbox (bool internal = false, + const Matrix& parent_pix_size = Matrix ()) const; void set_boundingbox (const Matrix& bb); + 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); void update_paperunits (const caseless_str& old_paperunits); @@ -3269,9 +3356,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")) @@ -3411,10 +3501,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) + handle_property ylabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false) + handle_property zlabel SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false) + handle_property title SOf , gh_manager::make_graphics_handle ("text", __myhandle__, false, false) bool_property xgrid , "off" bool_property ygrid , "off" bool_property zgrid , "off" @@ -3645,7 +3735,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) { @@ -3770,6 +3862,9 @@ void reset_default_properties (void); +protected: + void initialize (const graphics_object& go); + private: property_list default_properties; }; @@ -3855,6 +3950,8 @@ 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. @@ -4514,6 +4611,162 @@ // --------------------------------------------------------------------- +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 (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; } +}; + +// --------------------------------------------------------------------- + octave_value get_property_from_handle (double handle, const std::string &property, const std::string &func); @@ -4585,14 +4838,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; }; @@ -4651,17 +4909,21 @@ static graphics_handle make_graphics_handle (const std::string& go_name, - const graphics_handle& parent, bool do_createfcn = true) + const graphics_handle& parent, 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, 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) @@ -4693,30 +4955,50 @@ 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) { return instance_ok () ? instance->do_figure_handle_list () : 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, @@ -4734,19 +5016,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) @@ -4759,6 +5040,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; @@ -4772,18 +5059,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: @@ -4821,6 +5111,9 @@ // The stack of callback objects. std::list<graphics_object> callback_objects; + // A flag telling whether event processing must be constantly on. + int event_processing; + graphics_handle get_handle (const std::string& go_name); void do_free (const graphics_handle& h); @@ -4840,9 +5133,10 @@ } 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); + const graphics_handle& p, bool do_createfcn, + bool do_notify_toolkit); + + graphics_handle do_make_figure_handle (double val, bool do_notify_toolkit); Matrix do_handle_list (void) { @@ -4881,18 +5175,22 @@ 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); @@ -4905,9 +5203,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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/help.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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{do, for, while}\n\ +@end deftypefn"), + pair_type ("persistent", "-*- texinfo -*-\n\ @deftypefn {Keyword} {} persistent @var{var}\n\
--- a/src/input.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/input.cc Tue Oct 11 14:08:38 2011 -0500 @@ -275,6 +275,9 @@ flush_octave_stdout (); + octave_pager_stream::reset (); + octave_diary_stream::reset (); + octave_diary << prompt; retval = interactive_input (prompt); @@ -794,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);
--- a/src/lex.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/lex.h Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/lex.ll Tue Oct 11 14:08:38 2011 -0500 @@ -554,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 (','); @@ -976,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 (')'); @@ -1516,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; @@ -1531,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; @@ -1546,7 +1562,9 @@ lexer_flags.at_beginning_of_statement = true; break; + case for_kw: + case parfor_kw: case while_kw: promptflag--; lexer_flags.looping++; @@ -1577,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) @@ -3368,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;
--- a/src/load-save.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/load-save.h Tue Oct 11 14:08:38 2011 -0500 @@ -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/mappers.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/mappers.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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); @@ -224,7 +217,6 @@ %!error arg (); %!error arg (1, 2); - */ DEFUN (asin, args, , @@ -271,7 +263,6 @@ } /* - %!test %! v = [0, pi/2*i, 0, -pi/2*i]; %! x = [0, i, 0, -i]; @@ -284,7 +275,6 @@ %!error asinh (); %!error asinh (1, 2); - */ DEFUN (atan, args, , @@ -304,7 +294,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -321,8 +310,7 @@ %!error atan (); %!error atan (1, 2); - - */ +*/ DEFUN (atanh, args, , "-*- texinfo -*-\n\ @@ -341,7 +329,6 @@ } /* - %!test %! v = [0, 0]; %! x = [0, 0]; @@ -354,7 +341,6 @@ %!error atanh (); %!error atanh (1, 2); - */ DEFUN (cbrt, args, , @@ -376,7 +362,6 @@ } /* - %!assert (cbrt (64), 4) %!assert (cbrt (-125), -5) %!assert (cbrt (0), 0) @@ -385,7 +370,6 @@ %!assert (cbrt (NaN), NaN) %!assert (cbrt (2^300), 2^100) %!assert (cbrt (125*2^300), 5*2^100) - */ DEFUN (ceil, args, , @@ -414,7 +398,6 @@ } /* - %% double precision %!assert(ceil ([2, 1.1, -1.1, -1]), [2, 2, -1, -1]); @@ -429,7 +412,6 @@ %!error ceil (); %!error ceil (1, 2); - */ DEFUN (conj, args, , @@ -455,7 +437,6 @@ } /* - %!assert(conj (1), 1); %!assert(conj (i), -i) %!assert(conj (1+i), 1-i) @@ -470,7 +451,6 @@ %!error conj (); %!error conj (1, 2); - */ DEFUN (cos, args, , @@ -490,7 +470,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -507,8 +486,7 @@ %!error cos (); %!error cos (1, 2); - - */ +*/ DEFUN (cosh, args, , "-*- texinfo -*-\n\ @@ -527,7 +505,6 @@ } /* - %!test %! x = [0, pi/2*i, pi*i, 3*pi/2*i]; %! v = [1, 0, -1, 0]; @@ -540,7 +517,6 @@ %!error cosh (); %!error cosh (1, 2); - */ DEFUN (erf, args, , @@ -579,7 +555,6 @@ } /* - %!test %! a = -1i*sqrt(-1/(6.4187*6.4187)); %! assert (erf(a), erf(real(a))); @@ -603,9 +578,6 @@ %% test/octave.test/arith/erf-3.m %!error erf(1,2); - - - */ DEFUN (erfinv, args, , @@ -666,11 +638,9 @@ } /* - %!test %! a = -1i*sqrt(-1/(6.4187*6.4187)); %! assert (erfc(a), erfc(real(a))); - */ DEFUN (erfcx, args, , @@ -701,10 +671,6 @@ return retval; } -/* - -*/ - DEFUN (exp, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} exp (@var{x})\n\ @@ -730,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'))); @@ -741,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, , @@ -794,7 +758,6 @@ } /* - %!assert(!(finite (Inf))); %!assert(!(finite (NaN))); %!assert(finite (rand(1,10))); @@ -802,8 +765,7 @@ %!assert(!(finite (single(Inf)))); %!assert(!(finite (single(NaN)))); %!assert(finite (single(rand(1,10)))); - - */ +*/ DEFUN (fix, args, , "-*- texinfo -*-\n\ @@ -831,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])); @@ -839,7 +800,6 @@ %!error fix (); %!error fix (1, 2); - */ DEFUN (floor, args, , @@ -868,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])); @@ -876,7 +835,6 @@ %!error floor (); %!error floor (1, 2); - */ DEFUN (gamma, args, , @@ -915,7 +873,6 @@ } /* - %!test %! a = -1i*sqrt(-1/(6.4187*6.4187)); %! assert (gamma(a), gamma(real(a))); @@ -942,7 +899,6 @@ %!error gamma(); %!error gamma(1,2); - */ DEFUN (imag, args, , @@ -962,7 +918,6 @@ } /* - %!assert(imag (1), 0); %!assert(imag (i), 1); %!assert(imag (1+i), 1); @@ -975,8 +930,7 @@ %!error imag (); %!error imag (1, 2); - - */ +*/ DEFUNX ("isalnum", Fisalnum, args, , "-*- texinfo -*-\n\ @@ -996,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\ @@ -1014,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\ @@ -1031,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\ @@ -1048,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\ @@ -1065,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\ @@ -1091,7 +1104,6 @@ } /* - %!assert(isinf (Inf)); %!assert(!isinf (NaN)); %!assert(!(isinf (NA))); @@ -1103,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\ @@ -1124,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\ @@ -1141,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\ @@ -1167,7 +1200,6 @@ } /* - %!assert(!(isna (Inf))); %!assert(!isna (NaN)); %!assert(isna (NA)); @@ -1179,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\ @@ -1208,7 +1239,6 @@ } /* - %!assert(!(isnan (Inf))); %!assert(isnan (NaN)); %!assert(isnan (NA)); @@ -1220,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\ @@ -1241,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\ @@ -1258,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\ @@ -1276,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\ @@ -1293,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\ @@ -1310,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\ @@ -1328,7 +1420,6 @@ } /* - %!test %! a = -1i*sqrt(-1/(6.4187*6.4187)); %! assert (lgamma(a), lgamma(real(a))); @@ -1355,7 +1446,6 @@ %!error lgamma(); %!error lgamma(1,2); - */ DEFUN (log, args, , @@ -1383,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)); @@ -1392,8 +1481,7 @@ %!error log (); %!error log (1, 2); - - */ +*/ DEFUN (log10, args, , "-*- texinfo -*-\n\ @@ -1412,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, , @@ -1461,7 +1547,6 @@ } /* - %!assert(real (1), 1); %!assert(real (i), 0); %!assert(real (1+i), 1); @@ -1474,14 +1559,14 @@ %!error real (); %!error real (1, 2); - */ DEFUN (round, args, , "-*- texinfo -*-\n\ @deftypefn {Mapping Function} {} round (@var{x})\n\ Return the integer nearest to @var{x}. If @var{x} is complex, return\n\ -@code{round (real (@var{x})) + round (imag (@var{x})) * I}.\n\ +@code{round (real (@var{x})) + round (imag (@var{x})) * I}. If there\n\ +are two nearest integers, return the one further away from zero.\n\ \n\ @example\n\ @group\n\ @@ -1489,7 +1574,7 @@ @result{} -3 3\n\ @end group\n\ @end example\n\ -@seealso{ceil, floor, fix}\n\ +@seealso{ceil, floor, fix, roundb}\n\ @end deftypefn") { octave_value retval; @@ -1502,7 +1587,6 @@ } /* - %!assert(round (1), 1); %!assert(round (1.1), 1); %!assert(round (5.5), 6); @@ -1521,7 +1605,6 @@ %!error round (); %!error round (1, 2); - */ DEFUN (roundb, args, , @@ -1576,7 +1659,6 @@ } /* - %!assert(sign (-2) , -1); %!assert(sign (3), 1); %!assert(sign (0), 0); @@ -1589,7 +1671,6 @@ %!error sign (); %!error sign (1, 2); - */ DEFUN (sin, args, , @@ -1609,7 +1690,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -1626,7 +1706,6 @@ %!error sin (); %!error sin (1, 2); - */ DEFUN (sinh, args, , @@ -1646,7 +1725,6 @@ } /* - %!test %! x = [0, pi/2*i, pi*i, 3*pi/2*i]; %! v = [0, i, 0, -i]; @@ -1659,8 +1737,7 @@ %!error sinh (); %!error sinh (1, 2); - - */ +*/ DEFUN (sqrt, args, , "-*- texinfo -*-\n\ @@ -1681,7 +1758,6 @@ } /* - %!assert(sqrt (4), 2) %!assert(sqrt (-1), i) %!assert(sqrt (1+i), exp (0.5 * log (1+i)), sqrt (eps)); @@ -1694,7 +1770,6 @@ %!error sqrt (); %!error sqrt (1, 2); - */ DEFUN (tan, args, , @@ -1714,7 +1789,6 @@ } /* - %!test %! rt2 = sqrt (2); %! rt3 = sqrt (3); @@ -1731,7 +1805,6 @@ %!error tan (); %!error tan (1, 2); - */ DEFUN (tanh, args, , @@ -1751,7 +1824,6 @@ } /* - %!test %! x = [0, pi*i]; %! v = [0, 0]; @@ -1764,7 +1836,6 @@ %!error tanh (); %!error tanh (1, 2); - */ DEFUNX ("toascii", Ftoascii, args, , @@ -1791,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\ @@ -1820,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"}}}); @@ -1834,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\ @@ -1866,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"}}}); @@ -1879,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/mkoctfile.in Wed Oct 05 02:19:28 2011 +0200 +++ b/src/mkoctfile.in Tue Oct 11 14:08:38 2011 -0500 @@ -99,9 +99,9 @@ : ${LIBS=%OCTAVE_CONF_LIBS%} : ${FLIBS=%OCTAVE_CONF_FLIBS%} : ${OCTAVE_LINK_DEPS=%OCTAVE_CONF_OCTAVE_LINK_DEPS%} -: ${OCTAVE_LINK_DEPS=%OCTAVE_CONF_OCTAVE_LINK_OPTS%} -: ${OCT_LINK_DEPS=%OCTAVE_CONF_MKOCTFILE_OCT_LINK_DEPS%} -: ${OCT_LINK_DEPS=%OCTAVE_CONF_MKOCTFILE_OCT_LINK_OPTS%} +: ${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%}
--- a/src/oct-parse.yy Wed Oct 05 02:19:28 2011 +0200 +++ b/src/oct-parse.yy Tue Oct 11 14:08:38 2011 -0500 @@ -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 @@ -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,6 +511,8 @@ %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. @@ -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 @@ -1140,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; } ; @@ -1230,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; } } ; @@ -1471,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; } ; @@ -1518,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; } ; @@ -1531,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; } ; @@ -1552,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; } ; @@ -1566,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; } ; @@ -1580,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 // ============= @@ -1758,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; @@ -1766,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; @@ -2071,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; @@ -2094,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; } @@ -2474,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 (); @@ -2493,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; @@ -4179,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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/oct-stream.cc Tue Oct 11 14:08:38 2011 -0500 @@ -2115,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 (); @@ -2145,6 +2145,9 @@ retval(nconv) = num_values; + int err_num; + retval(nconv+1) = error (false, err_num); + if (! quit) { // Pick up any trailing stuff.
--- a/src/octave-config.cc.in Wed Oct 05 02:19:28 2011 +0200 +++ b/src/octave-config.cc.in Tue Oct 11 14:08:38 2011 -0500 @@ -219,6 +219,6 @@ return 1; } } - + return 0; }
--- a/src/octave-config.in Wed Oct 05 02:19:28 2011 +0200 +++ b/src/octave-config.in Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/octave.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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;
--- a/src/octave.gperf Wed Oct 05 02:19:28 2011 +0200 +++ b/src/octave.gperf Tue Oct 11 14:08:38 2011 -0500 @@ -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.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov-base.h Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov-bool.h Tue Oct 11 14:08:38 2011 -0500 @@ -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-class.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov-class.cc Tue Oct 11 14:08:38 2011 -0500 @@ -1686,6 +1686,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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov-class.h Tue Oct 11 14:08:38 2011 -0500 @@ -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));
--- a/src/ov-fcn-handle.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov-fcn-handle.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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;
--- a/src/ov-fcn.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov-fcn.h Tue Oct 11 14:08:38 2011 -0500 @@ -60,7 +60,7 @@ virtual bool is_system_fcn_file (void) const { return false; } 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 (); } @@ -103,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-usr-fcn.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov-usr-fcn.cc Tue Oct 11 14:08:38 2011 -0500 @@ -187,8 +187,8 @@ 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) @@ -229,6 +229,9 @@ 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 ()) @@ -450,8 +453,7 @@ 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 ())
--- a/src/ov-usr-fcn.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov-usr-fcn.h Tue Oct 11 14:08:38 2011 -0500 @@ -263,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 @@ -383,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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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)) { }
--- a/src/ov.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/ov.h Tue Oct 11 14:08:38 2011 -0500 @@ -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 (); }
--- a/src/pager.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pager.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pager.h Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pr-output.cc Tue Oct 11 14:08:38 2011 -0500 @@ -3547,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
--- a/src/profiler.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/profiler.cc Tue Oct 11 14:08:38 2011 -0500 @@ -24,7 +24,6 @@ #include <config.h> #endif -#include <cstddef> #include <iostream> #include "defun.h" @@ -118,7 +117,7 @@ if (fcn_id != 0) { stats& entry = data[fcn_id - 1]; - + entry.time += time; entry.calls += calls; @@ -145,7 +144,7 @@ } octave_value -profile_data_accumulator::tree_node::get_hierarchical (void) const +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 @@ -156,6 +155,7 @@ 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); @@ -164,11 +164,16 @@ 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 (); + rv_children(i) = entry.get_hierarchical (&child_total); + rv_totals(i) = octave_value (child_total); + + if (total) + *total += child_total; ++i; } @@ -178,6 +183,7 @@ 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); @@ -379,7 +385,12 @@ profile_data_accumulator::query_time (void) const { octave_time now; - return now.double_value (); + // 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
--- a/src/profiler.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/profiler.h Tue Oct 11 14:08:38 2011 -0500 @@ -23,6 +23,7 @@ #if !defined (octave_profiler_h) #define octave_profiler_h 1 +#include <cstddef> #include <map> #include <set> #include <string> @@ -91,7 +92,7 @@ }; 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 @@ -113,7 +114,11 @@ tree_node* exit (octave_idx_type); void build_flat (flat_profile&) const; - octave_value get_hierarchical (void) 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:
--- a/src/pt-binop.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-binop.cc Tue Oct 11 14:08:38 2011 -0500 @@ -301,11 +301,11 @@ %!test %! x = 0; %! do_braindead_shortcircuit_evaluation (0); -%! if (1 | (x = 1)) +%! if (1 | (x = 1)) %! endif %! assert (x, 1); %! do_braindead_shortcircuit_evaluation (1); -%! if (1 | (x = 0)) +%! if (1 | (x = 0)) %! endif %! assert (x, 1);
--- a/src/pt-cbinop.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-cbinop.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-check.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-eval.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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; } }
--- a/src/pt-fcn-handle.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-fcn-handle.cc Tue Oct 11 14:08:38 2011 -0500 @@ -124,9 +124,13 @@ 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-fcn-handle.h Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-loop.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-loop.h Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-mat.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 (); 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\
--- a/src/pt-pr-code.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-pr-code.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/pt-unop.cc Tue Oct 11 14:08:38 2011 -0500 @@ -74,7 +74,7 @@ if (! error_state) { BEGIN_PROFILER_BLOCK ("prefix " + oper ()) - + ref.do_unary_op (etype); if (! error_state)
--- a/src/strfns.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/strfns.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/symtab.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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 ()) @@ -1511,10 +1514,10 @@ %!shared old_state %! old_state = ignore_function_time_stamp (); %!test -%! state = ignore_function_time_stamp ("all"); +%! state = ignore_function_time_stamp ("all"); %! assert (state, old_state); %! assert (ignore_function_time_stamp (), "all"); -%! state = ignore_function_time_stamp ("system"); +%! state = ignore_function_time_stamp ("system"); %! assert (state, "all"); %! assert (ignore_function_time_stamp (), "system"); %! ignore_function_time_stamp (old_state);
--- a/src/sysdep.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/sysdep.cc Tue Oct 11 14:08:38 2011 -0500 @@ -878,7 +878,7 @@ %! setenv ("HOME", "foobar"); %! endif %! home = getenv ("HOME"); -%! assert (tilde_expand ("~/foobar"), fullfile (home, "foobar")); +%! 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 Wed Oct 05 02:19:28 2011 +0200 +++ b/src/token.h Tue Oct 11 14:08:38 2011 -0500 @@ -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/txt-eng-ft.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/txt-eng-ft.cc Tue Oct 11 14:08:38 2011 -0500 @@ -202,7 +202,7 @@ ft_render::ft_render (void) : text_processor (), face (0), bbox (1, 4, 0.0), - xoffset (0), yoffset (0), multiline_halign (0), + xoffset (0), yoffset (0), multiline_halign (0), multiline_align_xoffsets(), mode (MODE_BBOX), red (0), green (0), blue (0) { @@ -285,7 +285,7 @@ { glyph_index = FT_Get_Char_Index (face, str[i]); - if (str[i] != '\n' + if (str[i] != '\n' && (! glyph_index || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT))) ::warning ("ft_render: skipping missing glyph for character `%c'", @@ -301,14 +301,14 @@ if (!glyph_index || FT_Load_Glyph (face, glyph_index, FT_LOAD_DEFAULT)) { ::warning ("ft_render: skipping missing glyph for character ` '"); - } - else + } + 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)) ::warning ("ft_render: unable to render glyph for character `%c'", str[i]); @@ -372,11 +372,11 @@ // 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; + box_line_width = 0; bbox(1) -= (face->size->metrics.height >> 6); } - } - else + } + else { // width if (previous) @@ -427,19 +427,19 @@ } if (mode == MODE_BBOX) { - /* Push last the width associated with the last line */ + /* Push last the width associated with the last line */ multiline_align_xoffsets.push_back(box_line_width); for (unsigned int i = 0; i < multiline_align_xoffsets.size(); i++) { /* Center align */ - if (multiline_halign == 1) + 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 + else multiline_align_xoffsets[i] = 0; } } @@ -557,7 +557,7 @@ text_element *elt = text_parser_none ().parse (txt); Matrix extent = get_extent (elt, rotation); delete elt; - + return extent; } @@ -583,7 +583,7 @@ { // 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);
--- a/src/utils.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/utils.cc Tue Oct 11 14:08:38 2011 -0500 @@ -678,11 +678,13 @@ %!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 *
--- a/src/variables.cc Wed Oct 05 02:19:28 2011 +0200 +++ b/src/variables.cc Tue Oct 11 14:08:38 2011 -0500 @@ -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; }
--- a/src/xpow.h Wed Oct 05 02:19:28 2011 +0200 +++ b/src/xpow.h Tue Oct 11 14:08:38 2011 -0500 @@ -41,118 +41,118 @@ class octave_value; class Range; -extern octave_value xpow (double a, double b); -extern octave_value xpow (double a, const Matrix& b); -extern octave_value xpow (double a, const Complex& b); -extern octave_value xpow (double a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value xpow (double a, double b); +extern OCTINTERP_API octave_value xpow (double a, const Matrix& b); +extern OCTINTERP_API octave_value xpow (double a, const Complex& b); +extern OCTINTERP_API octave_value xpow (double a, const ComplexMatrix& b); -extern octave_value xpow (const Matrix& a, double b); -extern octave_value xpow (const Matrix& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const Matrix& a, double b); +extern OCTINTERP_API octave_value xpow (const Matrix& a, const Complex& b); -extern octave_value xpow (const DiagMatrix& a, double b); -extern octave_value xpow (const DiagMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const DiagMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const DiagMatrix& a, const Complex& b); -extern octave_value xpow (const PermMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const PermMatrix& a, double b); -extern octave_value xpow (const Complex& a, double b); -extern octave_value xpow (const Complex& a, const Matrix& b); -extern octave_value xpow (const Complex& a, const Complex& b); -extern octave_value xpow (const Complex& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value xpow (const Complex& a, double b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const Matrix& b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const Complex& a, const ComplexMatrix& b); -extern octave_value xpow (const ComplexMatrix& a, double b); -extern octave_value xpow (const ComplexMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const ComplexMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const ComplexMatrix& a, const Complex& b); -extern octave_value xpow (const ComplexDiagMatrix& a, double b); -extern octave_value xpow (const ComplexDiagMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value xpow (const ComplexDiagMatrix& a, double b); +extern OCTINTERP_API octave_value xpow (const ComplexDiagMatrix& a, const Complex& b); -extern octave_value elem_xpow (double a, const Matrix& b); -extern octave_value elem_xpow (double a, const ComplexMatrix& b); -extern octave_value elem_xpow (double a, const Range& r); +extern OCTINTERP_API octave_value elem_xpow (double a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const Range& r); -extern octave_value elem_xpow (const Matrix& a, double b); -extern octave_value elem_xpow (const Matrix& a, const Matrix& b); -extern octave_value elem_xpow (const Matrix& a, const Complex& b); -extern octave_value elem_xpow (const Matrix& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const Matrix& a, const ComplexMatrix& b); -extern octave_value elem_xpow (const Complex& a, const Matrix& b); -extern octave_value elem_xpow (const Complex& a, const ComplexMatrix& b); -extern octave_value elem_xpow (const Complex& a, const Range& r); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const Range& r); -extern octave_value elem_xpow (const ComplexMatrix& a, double b); -extern octave_value elem_xpow (const ComplexMatrix& a, const Matrix& b); -extern octave_value elem_xpow (const ComplexMatrix& a, const Complex& b); -extern octave_value elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const Matrix& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexMatrix& a, const ComplexMatrix& b); -extern octave_value elem_xpow (double a, const NDArray& b); -extern octave_value elem_xpow (double a, const ComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (double a, const ComplexNDArray& b); -extern octave_value elem_xpow (const NDArray& a, double b); -extern octave_value elem_xpow (const NDArray& a, const NDArray& b); -extern octave_value elem_xpow (const NDArray& a, const Complex& b); -extern octave_value elem_xpow (const NDArray& a, const ComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const NDArray& a, const ComplexNDArray& b); -extern octave_value elem_xpow (const Complex& a, const NDArray& b); -extern octave_value elem_xpow (const Complex& a, const ComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const Complex& a, const ComplexNDArray& b); -extern octave_value elem_xpow (const ComplexNDArray& a, double b); -extern octave_value elem_xpow (const ComplexNDArray& a, const NDArray& b); -extern octave_value elem_xpow (const ComplexNDArray& a, const Complex& b); -extern octave_value elem_xpow (const ComplexNDArray& a, const ComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, double b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const NDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const Complex& b); +extern OCTINTERP_API octave_value elem_xpow (const ComplexNDArray& a, const ComplexNDArray& b); -extern octave_value xpow (float a, float b); -extern octave_value xpow (float a, const FloatMatrix& b); -extern octave_value xpow (float a, const FloatComplex& b); -extern octave_value xpow (float a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value xpow (float a, float b); +extern OCTINTERP_API octave_value xpow (float a, const FloatMatrix& b); +extern OCTINTERP_API octave_value xpow (float a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (float a, const FloatComplexMatrix& b); -extern octave_value xpow (const FloatMatrix& a, float b); -extern octave_value xpow (const FloatMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatMatrix& a, const FloatComplex& b); -extern octave_value xpow (const FloatDiagMatrix& a, float b); -extern octave_value xpow (const FloatDiagMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatDiagMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatDiagMatrix& a, const FloatComplex& b); -extern octave_value xpow (const FloatComplex& a, float b); -extern octave_value xpow (const FloatComplex& a, const FloatMatrix& b); -extern octave_value xpow (const FloatComplex& a, const FloatComplex& b); -extern octave_value xpow (const FloatComplex& a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatComplex& a, const FloatComplexMatrix& b); -extern octave_value xpow (const FloatComplexMatrix& a, float b); -extern octave_value xpow (const FloatComplexMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatComplexMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplexMatrix& a, const FloatComplex& b); -extern octave_value xpow (const FloatComplexDiagMatrix& a, float b); -extern octave_value xpow (const FloatComplexDiagMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value xpow (const FloatComplexDiagMatrix& a, float b); +extern OCTINTERP_API octave_value xpow (const FloatComplexDiagMatrix& a, const FloatComplex& b); -extern octave_value elem_xpow (float a, const FloatMatrix& b); -extern octave_value elem_xpow (float a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatComplexMatrix& b); -extern octave_value elem_xpow (const FloatMatrix& a, float b); -extern octave_value elem_xpow (const FloatMatrix& a, const FloatMatrix& b); -extern octave_value elem_xpow (const FloatMatrix& a, const FloatComplex& b); -extern octave_value elem_xpow (const FloatMatrix& a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatMatrix& a, const FloatComplexMatrix& b); -extern octave_value elem_xpow (const FloatComplex& a, const FloatMatrix& b); -extern octave_value elem_xpow (const FloatComplex& a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatComplexMatrix& b); -extern octave_value elem_xpow (const FloatComplexMatrix& a, float b); -extern octave_value elem_xpow (const FloatComplexMatrix& a, const FloatMatrix& b); -extern octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplex& b); -extern octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplexMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatMatrix& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexMatrix& a, const FloatComplexMatrix& b); -extern octave_value elem_xpow (float a, const FloatNDArray& b); -extern octave_value elem_xpow (float a, const FloatComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (float a, const FloatComplexNDArray& b); -extern octave_value elem_xpow (const FloatNDArray& a, float b); -extern octave_value elem_xpow (const FloatNDArray& a, const FloatNDArray& b); -extern octave_value elem_xpow (const FloatNDArray& a, const FloatComplex& b); -extern octave_value elem_xpow (const FloatNDArray& a, const FloatComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatNDArray& a, const FloatComplexNDArray& b); -extern octave_value elem_xpow (const FloatComplex& a, const FloatNDArray& b); -extern octave_value elem_xpow (const FloatComplex& a, const FloatComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplex& a, const FloatComplexNDArray& b); -extern octave_value elem_xpow (const FloatComplexNDArray& a, float b); -extern octave_value elem_xpow (const FloatComplexNDArray& a, const FloatNDArray& b); -extern octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplex& b); -extern octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplexNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, float b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatNDArray& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplex& b); +extern OCTINTERP_API octave_value elem_xpow (const FloatComplexNDArray& a, const FloatComplexNDArray& b); #endif
--- a/test/@Blork/Blork.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = Blork( bleek ) -% Test class. - - if (nargin==1) && isa(bleek, 'Blork') - s = bleek; - else - if nargin==0 - s.bleek = 1; - else - s.bleek = bleek; - end - s = class(s, 'Blork'); - - end - -end
--- a/test/@Blork/bleek.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = bleek( in, val ) - - if (nargin==1) - out = in.bleek; - else - in.bleek = val; - out = in; - end - -end
--- a/test/@Blork/display.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -function display( s ) - - disp([inputname(1),'.bleek = ']) - disp(' '); - disp(s.bleek); - -end \ No newline at end of file
--- a/test/@Blork/get.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'bleek' - v = s.bleek; - otherwise - error([propName, ' is not a valid Blork property']); - end - -end
--- a/test/@Blork/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Blork/set.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'bleek' - s.bleek = propValue; - otherwise - error([propName, ' is not a valid Blork property']); - end - end - -end
--- a/test/@Cork/Cork.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = Cork( click ) -% Test class. - - if ( (nargin==1) && (isa(click, 'Cork')) ) - s = click; - return; - end - - if( nargin<1 ) - s.click = 1; - else - s.click = click; - end - s = class(s, 'Cork'); - -end
--- a/test/@Cork/click.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = click( in, val ) - - if (nargin==1) - out = in.click; - else - in.click = val; - out = in; - end - -end
--- a/test/@Cork/display.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -function display( s ) - - disp([inputname(1),'.click = ']); - disp(' '); - disp(s.click); - -end \ No newline at end of file
--- a/test/@Cork/get.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'click' - v = s.click; - otherwise - error([propName, ' is not a valid Cork property']); - end - -end
--- a/test/@Cork/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Cork/set.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'click' - s.click = propValue; - otherwise - error([propName, ' is not a valid Cork property']); - end - end - -end
--- a/test/@Dork/Dork.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,18 +0,0 @@ -function [ s ] = Dork( gick, gack ) - - if (nargin==1) && isa(gick,'Dork') - s = gick; - else - s.gack = 0; - if nargin == 0 - s0 = Snork(); - elseif nargin==1 - s0 = Snork(gick); - else - s0 = Snork(gick); - s.gack = gack; - end - s = class(s,'Dork',s0); - end - -end
--- a/test/@Dork/bling.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = bling( m1, m2 ) - - out = 1; - -end
--- a/test/@Dork/display.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -function display( s ) -% Display the critical info for an amplifier - - gick = get(s,'gick'); - disp([inputname(1),'.gick = ']) - disp(' '); - disp(gick); - disp(' '); - disp([inputname(1),'.gack = ']) - disp(' '); - disp(s.gack); - -end
--- a/test/@Dork/gack.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = gack( in, val ) - - if (nargin==1) - out = in.gack; - else - in.gack = val; - out = in; - end - -end
--- a/test/@Dork/get.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'gack' - v = s.gack; - otherwise - v = get(s.Snork,propName); - end - -end
--- a/test/@Dork/getStash.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = getStash(cls) - - out = myStash(); - -end
--- a/test/@Dork/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Dork/private/myStash.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = myStash() - - out = 2; - -end
--- a/test/@Dork/set.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'gack' - s.gack = propValue; - otherwise - s.Snork = set(s.Snork, propName, propValue); - end - end - -end
--- a/test/@Gork/Gork.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,15 +0,0 @@ -function [ s ] = Gork( g ) - if (nargin==1) && isa(g,'Gork') - s = sprk; - return; - end - - drk = Dork(); - prk = Pork(); - blrk = Blork(); - s.Cork = Cork(17); % Aggregation. - s.gark = -2; - s.gyrk = -3; - s = class(s,'Gork',drk,prk,blrk); - -end
--- a/test/@Gork/cork.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = cork( in, val ) - - if (nargin==1) - out = in.Cork; - else - in.Cork = val; - out = in; - end - -end
--- a/test/@Gork/display.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function display( s ) -% Display the critical info for a Gork. - - dork_base = s.Dork - %pork_base = s.Pork - %sprk = s.sprk; - gark = get(s,'gark'); - disp([inputname(1),'.gark = ']) - disp(' '); - disp(gark); - disp([inputname(1),'.Cork= ']) - disp(' '); - disp(click(s.Cork)); - - -end
--- a/test/@Gork/gark.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = gark( in, val ) - - if (nargin==1) - out = in.gark; - else - in.gark = val; - out = in; - end - -end
--- a/test/@Gork/get.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'cork' - v = s.Cork; - case 'gark' - v = s.gark; - otherwise - % Note that get/set for multiple parents is hard. We only do one - % branch of the parent tree just to test this stuff out. - v = get(s.Dork,propName); - end - -end
--- a/test/@Gork/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Gork/set.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'cork' - if(isa(propValue,'Cork')) - s.Cork = propValue; - else - s.Cork = set(s.Cork, 'click',propValue); - end - case 'gark' - s.gark = propValue; - otherwise - % Note that get/set for multiple parents is hard. We only do one - % branch of the parent tree just to test this stuff out. - s.Dork = set(s.Dork, propName, propValue); - end - end - -end
--- a/test/@Gork/subsasgn.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -function g = subsasgn(g, s, x) - - switch s.type - case '.' - switch s.subs - case 'gyrk' - g.gyrk = x; - end -end
--- a/test/@Gork/subsref.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -function x = subsref(g, s) - - switch s.type - case '.' - switch s.subs - case 'gyrk' - x = g.gyrk; - end -end
--- a/test/@Pork/Pork.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -function [ s ] = Pork( geek, gurk ) - - if (nargin==1) && isa(geek,'Pork') - s = geek; - else - s.gurk = 0; - if nargin == 0 - s0 = Spork(); - elseif nargin==1 - s0 = Spork(geek); - else - s0 = Spork(geek); - s.gurk = gurk; - end - s = class(s,'Pork',s0); - end - superiorto('Dork'); - -end
--- a/test/@Pork/bling.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = bling( m1, m2 ) - - out = 2; - -end
--- a/test/@Pork/display.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -function display( s ) -% Display the critical info for an amplifier - - geek = get(s,'geek'); - disp([inputname(1),'.geek = ']) - disp(' '); - disp(geek); - disp(' '); - disp([inputname(1),'.gurk = ']) - disp(' '); - disp(s.gurk); - -end
--- a/test/@Pork/get.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'gurk' - v = s.gurk; - otherwise - v = get(s.Spork,propName); - end - -end
--- a/test/@Pork/gurk.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = gurk( in, val ) - - if (nargin==1) - out = in.gurk; - else - in.gurk = val; - out = in; - end - -end
--- a/test/@Pork/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Pork/private/myStash.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = myStash() - - out = 4; - -end
--- a/test/@Pork/set.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'gurk' - s.gurk = propValue; - otherwise - s.Spork = set(s.Spork, propName, propValue); - end - end - -end
--- a/test/@Sneetch/Sneetch.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = Sneetch( mcbean ) -% Test class: should produce error. - - if (nargin==1) && isa(mcbean, 'Sneetch') - s = mcbean; - else - if nargin==0 - s.mcbean = 1; - else - s.mcbean = mcbean; - end - s = class(s, 'Sneetch'); - s.sylvester = 1; - end - -end
--- a/test/@Sneetch/display.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function display( s ) - - disp([inputname(1),'.mcbean = ']) - disp(' '); - disp(s.mcbean); - disp([inputname(1),'.sylvester = ']) - disp(' '); - disp(s.sylvester); - -end \ No newline at end of file
--- a/test/@Sneetch/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -at_Sneetch_FCN_FILES = \ - @Sneetch/Sneetch.m \ - @Sneetch/display.m - -FCN_FILES += $(at_Sneetch_FCN_FILES)
--- a/test/@Snork/Snork.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -function [ s ] = Snork( gick ) -% Test class. - - if ( (nargin==1) && (isa(gick, 'Snork')) ) - s = gick; - else - s.cack = [0 1 2 3]; - if nargin==0 - s.gick = 1; - else - s.gick = gick; - end - s = class(s, 'Snork'); - - end - -end
--- a/test/@Snork/cack.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = cack( in ) - - out = in.cack; - -end
--- a/test/@Snork/display.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -function display( s ) - - disp([inputname(1),'.gick = ']); - disp(' '); - disp(s.gick); - -end \ No newline at end of file
--- a/test/@Snork/end.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -function r = end (snk, index_pos, num_indices) - - if (num_indices ~= 1) - error ('Snork object may only have one index') - end - - r = length (snk.cack); - -end
--- a/test/@Snork/get.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'gick' - v = s.gick; - otherwise - error([propName, ' is not a valid Snork property']); - end - -end
--- a/test/@Snork/getStash.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = getStash(cls) - - out = myStash(); - -end
--- a/test/@Snork/gick.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = gick( in, val ) - - if (nargin==1) - out = in.gick; - else - in.gick = val; - out = in; - end - -end
--- a/test/@Snork/loadobj.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -function [ out ] = loadobj( in ) - - out = in; - out.cack = [-1 -2 -3 -4]; - -end
--- a/test/@Snork/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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)
--- a/test/@Snork/private/myStash.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = myStash() - - out = 1; - -end
--- a/test/@Snork/saveobj.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -function [ out ] = saveobj( in ) - - out = in; - out.cack = []; - -end
--- a/test/@Snork/set.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'gick' - s.gick = propValue; - otherwise - error([propName, ' is not a valid Snork property']); - end - end - -end
--- a/test/@Snork/subsasgn.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -function snk = subsasgn (snk, s, val) - if (length (s) < 1) - error ('Snork: needs index'); - end - switch (s(1).type) - case '()' - ind = s(1).subs; - if (numel (ind) ~= 1) - error ('Snork: need exactly one index'); - else - if (length (s) == 1) - snk.cack(ind{1}) = val; - else - error ('Snork: chained subscripts not allowed for {}'); - end - end - case '{}' - ind = s(1).subs; - if (numel (ind) ~= 1) - error ('Snork: need exactly one index'); - else - if (length (s) == 1) - snk.cack(ind{1}) = val; - else - error ('Snork: chained subscripts not allowed for {}'); - end - end - case '.' - fld = s(1).subs; - if (strcmp (fld, 'gick')) - snk.gick = val; - else - error ('Snork/subsasgn: invalid property \"%s\"', fld); - end - otherwise - error ('invalid subscript type'); - end -end
--- a/test/@Snork/subsindex.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = subsindex( obj ) - - out = 0; - -end
--- a/test/@Snork/subsref.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -function b = subsref (snk, s) - if (isempty (s)) - error ('Snork: missing index'); - end - switch (s(1).type) - case '()' - ind = s(1).subs; - if (numel (ind) ~= 1) - error ('Snork: need exactly one index'); - else - b = snk.cack(ind{1}); - end - case '{}' - ind = s(1).subs; - if (numel (ind) ~= 1) - error ('Snork: need exactly one index'); - else - b = snk.cack(ind{1}); - end - case '.' - fld = s.subs; - if (strcmp (fld, 'gick')) - b = snk.gick; - else - error ('Snork/subsref: invalid property \"%s\"', fld); - end - otherwise - error ('invalid subscript type'); - end -end
--- a/test/@Spork/Spork.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,17 +0,0 @@ -function [ s ] = Spork( geek ) -% Test class. - - if (nargin==1) && isa(geek, 'Spork') - s = geek; - else - s.cack = [-1 -2 -3 -4]; - if nargin==0 - s.geek = 1; - else - s.geek = geek; - end - s = class(s, 'Spork'); - - end - -end
--- a/test/@Spork/cack.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = cack( in ) - - out = in.cack; - -end
--- a/test/@Spork/display.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -function display( s ) - - disp([inputname(1),'.geek = ']) - disp(' '); - disp(s.geek); - -end \ No newline at end of file
--- a/test/@Spork/geek.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ out ] = geek( in, val ) - - if (nargin==1) - out = in.geek; - else - in.geek = val; - out = in; - end - -end
--- a/test/@Spork/get.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -function [ v ] = get( s, propName ) - - switch propName - case 'geek' - v = s.geek; - otherwise - error([propName, ' is not a valid Spork property']); - end - -end
--- a/test/@Spork/getStash.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = getStash(cls) - - out = myStash(); - -end
--- a/test/@Spork/loadobj.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -function [ out ] = loadobj( in ) - - out = in; - if (~isa(in,'Spork')) - out.cack=[]; - end - -end
--- a/test/@Spork/module.mk Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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/@Spork/private/myStash.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -function [ out ] = myStash() - - out = 3; - -end
--- a/test/@Spork/saveobj.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -function [ out ] = saveobj( in ) - - out = in; - %rmfield(out,'cack'); - -end
--- a/test/@Spork/set.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16 +0,0 @@ -function [ s ] = set( s, varargin ) - - propArgs = varargin; - while (length(propArgs) >= 2) - propName = propArgs{1}; - propValue = propArgs{2}; - propArgs = propArgs(3:end); - switch propName - case 'geek' - s.geek = propValue; - otherwise - error([propName, ' is not a valid Spork property']); - end - end - -end
--- a/test/Makefile.am Wed Oct 05 02:19:28 2011 +0200 +++ b/test/Makefile.am Tue Oct 11 14:08:38 2011 -0500 @@ -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,9 @@ 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 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/Blork.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = Blork( bleek ) +% Test class. + + if (nargin==1) && isa(bleek, 'Blork') + s = bleek; + else + if nargin==0 + s.bleek = 1; + else + s.bleek = bleek; + end + s = class(s, 'Blork'); + + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/bleek.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = bleek( in, val ) + + if (nargin==1) + out = in.bleek; + else + in.bleek = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/display.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,7 @@ +function display( s ) + + disp([inputname(1),'.bleek = ']) + disp(' '); + disp(s.bleek); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/get.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'bleek' + v = s.bleek; + otherwise + error([propName, ' is not a valid Blork property']); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Blork/set.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'bleek' + s.bleek = propValue; + otherwise + error([propName, ' is not a valid Blork property']); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/Cork.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = Cork( click ) +% Test class. + + if ( (nargin==1) && (isa(click, 'Cork')) ) + s = click; + return; + end + + if( nargin<1 ) + s.click = 1; + else + s.click = click; + end + s = class(s, 'Cork'); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/click.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = click( in, val ) + + if (nargin==1) + out = in.click; + else + in.click = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/display.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,7 @@ +function display( s ) + + disp([inputname(1),'.click = ']); + disp(' '); + disp(s.click); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/get.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'click' + v = s.click; + otherwise + error([propName, ' is not a valid Cork property']); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Cork/set.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'click' + s.click = propValue; + otherwise + error([propName, ' is not a valid Cork property']); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/Dork.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,18 @@ +function [ s ] = Dork( gick, gack ) + + if (nargin==1) && isa(gick,'Dork') + s = gick; + else + s.gack = 0; + if nargin == 0 + s0 = Snork(); + elseif nargin==1 + s0 = Snork(gick); + else + s0 = Snork(gick); + s.gack = gack; + end + s = class(s,'Dork',s0); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/bling.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = bling( m1, m2 ) + + out = 1; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/display.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,13 @@ +function display( s ) +% Display the critical info for an amplifier + + gick = get(s,'gick'); + disp([inputname(1),'.gick = ']) + disp(' '); + disp(gick); + disp(' '); + disp([inputname(1),'.gack = ']) + disp(' '); + disp(s.gack); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/gack.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = gack( in, val ) + + if (nargin==1) + out = in.gack; + else + in.gack = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/get.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'gack' + v = s.gack; + otherwise + v = get(s.Snork,propName); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/getStash.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = getStash(cls) + + out = myStash(); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/private/myStash.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = myStash() + + out = 2; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Dork/set.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'gack' + s.gack = propValue; + otherwise + s.Snork = set(s.Snork, propName, propValue); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/Gork.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,15 @@ +function [ s ] = Gork( g ) + if (nargin==1) && isa(g,'Gork') + s = sprk; + return; + end + + drk = Dork(); + prk = Pork(); + blrk = Blork(); + s.Cork = Cork(17); % Aggregation. + s.gark = -2; + s.gyrk = -3; + s = class(s,'Gork',drk,prk,blrk); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/cork.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = cork( in, val ) + + if (nargin==1) + out = in.Cork; + else + in.Cork = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/display.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function display( s ) +% Display the critical info for a Gork. + + dork_base = s.Dork + %pork_base = s.Pork + %sprk = s.sprk; + gark = get(s,'gark'); + disp([inputname(1),'.gark = ']) + disp(' '); + disp(gark); + disp([inputname(1),'.Cork= ']) + disp(' '); + disp(click(s.Cork)); + + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/gark.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = gark( in, val ) + + if (nargin==1) + out = in.gark; + else + in.gark = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/get.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,14 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'cork' + v = s.Cork; + case 'gark' + v = s.gark; + otherwise + % Note that get/set for multiple parents is hard. We only do one + % branch of the parent tree just to test this stuff out. + v = get(s.Dork,propName); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/set.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,24 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'cork' + if(isa(propValue,'Cork')) + s.Cork = propValue; + else + s.Cork = set(s.Cork, 'click',propValue); + end + case 'gark' + s.gark = propValue; + otherwise + % Note that get/set for multiple parents is hard. We only do one + % branch of the parent tree just to test this stuff out. + s.Dork = set(s.Dork, propName, propValue); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/subsasgn.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,9 @@ +function g = subsasgn(g, s, x) + + switch s.type + case '.' + switch s.subs + case 'gyrk' + g.gyrk = x; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Gork/subsref.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,9 @@ +function x = subsref(g, s) + + switch s.type + case '.' + switch s.subs + case 'gyrk' + x = g.gyrk; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/Pork.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,19 @@ +function [ s ] = Pork( geek, gurk ) + + if (nargin==1) && isa(geek,'Pork') + s = geek; + else + s.gurk = 0; + if nargin == 0 + s0 = Spork(); + elseif nargin==1 + s0 = Spork(geek); + else + s0 = Spork(geek); + s.gurk = gurk; + end + s = class(s,'Pork',s0); + end + superiorto('Dork'); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/bling.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = bling( m1, m2 ) + + out = 2; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/display.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,13 @@ +function display( s ) +% Display the critical info for an amplifier + + geek = get(s,'geek'); + disp([inputname(1),'.geek = ']) + disp(' '); + disp(geek); + disp(' '); + disp([inputname(1),'.gurk = ']) + disp(' '); + disp(s.gurk); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/get.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'gurk' + v = s.gurk; + otherwise + v = get(s.Spork,propName); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/gurk.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = gurk( in, val ) + + if (nargin==1) + out = in.gurk; + else + in.gurk = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/private/myStash.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = myStash() + + out = 4; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Pork/set.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'gurk' + s.gurk = propValue; + otherwise + s.Spork = set(s.Spork, propName, propValue); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Sneetch/Sneetch.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = Sneetch( mcbean ) +% Test class: should produce error. + + if (nargin==1) && isa(mcbean, 'Sneetch') + s = mcbean; + else + if nargin==0 + s.mcbean = 1; + else + s.mcbean = mcbean; + end + s = class(s, 'Sneetch'); + s.sylvester = 1; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Sneetch/display.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function display( s ) + + disp([inputname(1),'.mcbean = ']) + disp(' '); + disp(s.mcbean); + disp([inputname(1),'.sylvester = ']) + disp(' '); + disp(s.sylvester); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/Snork.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,17 @@ +function [ s ] = Snork( gick ) +% Test class. + + if ( (nargin==1) && (isa(gick, 'Snork')) ) + s = gick; + else + s.cack = [0 1 2 3]; + if nargin==0 + s.gick = 1; + else + s.gick = gick; + end + s = class(s, 'Snork'); + + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/cack.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = cack( in ) + + out = in.cack; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/display.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,7 @@ +function display( s ) + + disp([inputname(1),'.gick = ']); + disp(' '); + disp(s.gick); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/end.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,9 @@ +function r = end (snk, index_pos, num_indices) + + if (num_indices ~= 1) + error ('Snork object may only have one index') + end + + r = length (snk.cack); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/get.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'gick' + v = s.gick; + otherwise + error([propName, ' is not a valid Snork property']); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/getStash.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = getStash(cls) + + out = myStash(); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/gick.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = gick( in, val ) + + if (nargin==1) + out = in.gick; + else + in.gick = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/loadobj.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,6 @@ +function [ out ] = loadobj( in ) + + out = in; + out.cack = [-1 -2 -3 -4]; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/private/myStash.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = myStash() + + out = 1; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/saveobj.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,6 @@ +function [ out ] = saveobj( in ) + + out = in; + out.cack = []; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/set.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'gick' + s.gick = propValue; + otherwise + error([propName, ' is not a valid Snork property']); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/subsasgn.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,38 @@ +function snk = subsasgn (snk, s, val) + if (length (s) < 1) + error ('Snork: needs index'); + end + switch (s(1).type) + case '()' + ind = s(1).subs; + if (numel (ind) ~= 1) + error ('Snork: need exactly one index'); + else + if (length (s) == 1) + snk.cack(ind{1}) = val; + else + error ('Snork: chained subscripts not allowed for {}'); + end + end + case '{}' + ind = s(1).subs; + if (numel (ind) ~= 1) + error ('Snork: need exactly one index'); + else + if (length (s) == 1) + snk.cack(ind{1}) = val; + else + error ('Snork: chained subscripts not allowed for {}'); + end + end + case '.' + fld = s(1).subs; + if (strcmp (fld, 'gick')) + snk.gick = val; + else + error ('Snork/subsasgn: invalid property \"%s\"', fld); + end + otherwise + error ('invalid subscript type'); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/subsindex.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = subsindex( obj ) + + out = 0; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Snork/subsref.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,30 @@ +function b = subsref (snk, s) + if (isempty (s)) + error ('Snork: missing index'); + end + switch (s(1).type) + case '()' + ind = s(1).subs; + if (numel (ind) ~= 1) + error ('Snork: need exactly one index'); + else + b = snk.cack(ind{1}); + end + case '{}' + ind = s(1).subs; + if (numel (ind) ~= 1) + error ('Snork: need exactly one index'); + else + b = snk.cack(ind{1}); + end + case '.' + fld = s.subs; + if (strcmp (fld, 'gick')) + b = snk.gick; + else + error ('Snork/subsref: invalid property \"%s\"', fld); + end + otherwise + error ('invalid subscript type'); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/Spork.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,17 @@ +function [ s ] = Spork( geek ) +% Test class. + + if (nargin==1) && isa(geek, 'Spork') + s = geek; + else + s.cack = [-1 -2 -3 -4]; + if nargin==0 + s.geek = 1; + else + s.geek = geek; + end + s = class(s, 'Spork'); + + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/cack.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = cack( in ) + + out = in.cack; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/display.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,7 @@ +function display( s ) + + disp([inputname(1),'.geek = ']) + disp(' '); + disp(s.geek); + +end \ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/geek.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ out ] = geek( in, val ) + + if (nargin==1) + out = in.geek; + else + in.geek = val; + out = in; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/get.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,10 @@ +function [ v ] = get( s, propName ) + + switch propName + case 'geek' + v = s.geek; + otherwise + error([propName, ' is not a valid Spork property']); + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/getStash.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = getStash(cls) + + out = myStash(); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/loadobj.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,8 @@ +function [ out ] = loadobj( in ) + + out = in; + if (~isa(in,'Spork')) + out.cack=[]; + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/private/myStash.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function [ out ] = myStash() + + out = 3; + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/saveobj.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,6 @@ +function [ out ] = saveobj( in ) + + out = in; + %rmfield(out,'cack'); + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/@Spork/set.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,16 @@ +function [ s ] = set( s, varargin ) + + propArgs = varargin; + while (length(propArgs) >= 2) + propName = propArgs{1}; + propValue = propArgs{2}; + propArgs = propArgs(3:end); + switch propName + case 'geek' + s.geek = propValue; + otherwise + error([propName, ' is not a valid Spork property']); + end + end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/module.mk Tue Oct 11 14:08:38 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/classes/test_classes.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,201 @@ +## Copyright (C) 2009-2011 Robert T. Short +## +## 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 test classes. +%% +%% Note: This script and all classes are also intended to run +%% in MATLAB to test compatibility. Don't break that! +%% +%% To Do: This script tests to ensure that things done correctly work +%% corrrectly. It should also check that things done incorrectly +%% error properly. +%% +%% The classes used for the tests reside in the test directory. +%% +%% The classes provide the ability to test most of the major features +%% of the legacy OOP facilities. There are a number of classes, mostly +%% kind of the same, that create a hierarchy. + +%% Test the Snork class. The Snork class has a number of the standard +%% methods that the others don't so we can test indexing and other +%% features. +%!shared snk, snk1, snk2 +%!test snk = Snork(); +%! assert(gick(snk),1) +%! assert(snk.gick,1) +%! assert(snk(2),1); +%! assert(snk{end},3); +%!test snk = gick(snk,2); +%! assert(gick(snk),2) +%!test snk = set(snk,'gick',7); +%! assert(get(snk, 'gick'), 7) +%!test snk.gick = 4; +%! assert(gick(snk),4) +%! snk(1) = 3; +%!test snk{end} = 9; +%! assert(cack(snk),[3 1 2 9]) +%! assert(getStash(snk),1) % Check private functions. +%! assert(isobject(snk)) +%! assert(class(snk),'Snork') +%! assert(isa(snk,'Snork')) +%! assert(~isa(snk,'Sneetch')) +%! assert(ismethod(snk,'gick')) +%! assert(~ismethod(snk,'bletch')) +%! assert(exist('snk')) +%! assert(~exist('blink')) +%!test snk1 = Snork(snk); +%! assert(class(snk1),'Snork') +%! assert(gick(snk1),4) +%!test snk2 = Snork(-3); +%! assert(class(snk2),'Snork') +%! assert(gick(snk2),-3) +%!test x=[1 2 3 4]; +%! assert(x(snk),1); +%% x=methods('Snork'); % Need to test the methods function. +%% save temp snk; +%% load temp % This load causes a segment fault. +%% assert(cack(snk),[-1 -2 -3 -4]); % This is a major bug! + +%% The Spork class is a near clone of Snork but without as many standard +%% methods. We are testing no new octave features, but this is makes +%% sure that we haven't bollixed up the Spork class if we should make +%% changes. We use Spork in the class hierarchy. +%!shared sprk +%!test sprk = Spork(); +%! assert(geek(sprk),1) +%!test sprk = geek(sprk,3); +%! assert(geek(sprk),3) +%!test sprk = set(sprk,'geek',7); +%! assert(get(sprk, 'geek'), 7) +%! assert(class(sprk),'Spork'); +%! assert(isa(sprk,'Spork')) + +%% The Blork class is a near clone of Snork but without as many standard +%% methods. We are testing no new octave features, but this is makes +%% sure that we haven't bollixed up the Blork class if we should make +%% changes. We use Blork in the class hierarchy. +%!shared blrk +%!test blrk = Blork(); +%! assert(bleek(blrk),1) +%!test blrk = bleek(blrk,3); +%! assert(bleek(blrk),3) +%!test blrk = set(blrk,'bleek',13); +%! assert(get(blrk, 'bleek'), 13) +%! assert(class(blrk),'Blork'); +%! assert(isa(blrk,'Blork')) + +%% The Cork class is a near clone of Snork but without as many standard +%% methods. We are testing no new octave features, but this is makes +%% sure that we haven't bollixed up the Cork class if we should make +%% changes. We use Cork in the class hierarchy. +%!shared crk +%!test crk = Cork(23); +%! assert(click(crk),23) +%!test crk = click(crk,3); +%! assert(click(crk),3) +%!test crk = set(crk,'click',13); +%! assert(get(crk, 'click'), 13) +%! assert(class(crk),'Cork'); +%! assert(isa(crk,'Cork')) + +%% The Dork class tests single inheritance. +%!shared drk +%!test drk = Dork(); +%! assert(gack(drk),0) +%!test drk = gack(drk,-2); +%! assert(gack(drk),-2) +%!test drk = gick(drk,2); +%! assert(gick(drk),2); +%!test drk = set(drk, 'gick',3, 'gack',-3); +%! assert(get(drk, 'gick'), 3) +%! assert(get(drk, 'gack'), -3) +%! assert(class(drk),'Dork') +%! assert(isa(drk,'Dork')) +%! assert(isa(drk,'Snork')) +%! assert(getStash(drk),2) +%!test drk1 = Dork(drk); +%! assert(class(drk1),'Dork') +%! assert(isa(drk1,'Snork')) +%! assert(gick(drk1),3) +%! assert(gack(drk1),-3) +%!test drk2 = Dork(-4,4); +%! assert(class(drk2),'Dork') +%! assert(isa(drk2,'Snork')) +%! assert(gick(drk2),-4) +%! assert(gack(drk2),4) + +%% The Pork class is essentially a clone of Dork. It is used as part +%% of the multiple inheritance test. +%!shared prk, drk +%!test prk = Pork(); +%! assert(geek(prk),1) +%! assert(gurk(prk),0) +%!test prk = gurk(prk,-3); +%! assert(gurk(prk),-3) +%!test prk = geek(prk,9); +%! assert(geek(prk),9) +%! assert(class(prk),'Pork') +%! assert(isa(prk,'Pork')) +%! assert(isa(prk,'Spork')) +%!test drk = Dork(); % Precedence. +%! assert(bling(drk,prk),2) +%! assert(bling(prk,drk),2) + +%% The Gork class tests aggregation and multiple inheritance. +%!shared grk +%!test grk = Gork(); +%! assert(gick(grk),1) +%! assert(geek(grk),1) +%! assert(gack(grk),0) +%! assert(gurk(grk),0) +%! assert(bleek(grk),1) +%! assert(gark(grk),-2) +%! assert(click(cork(grk)),17) +%! assert(class(cork(grk)),'Cork') +%!test grk = gick(grk,3); +%!test grk = geek(grk,4); +%!test grk = gack(grk,-9); +%!test grk = gurk(grk,-8); +%!test grk = bleek(grk,-7); +%!test grk = gark(grk,-6); +%!test grk = cork(grk,click(cork(grk),23)); +%! assert(gick(grk),3) +%! assert(geek(grk),4) +%! assert(gack(grk),-9) +%! assert(gurk(grk),-8) +%! assert(bleek(grk),-7) +%! assert(gark(grk),-6) +%! assert(click(cork(grk)),23) +%!test +%! cork1 = Cork(13); +%! grk = set(grk, 'gick',-5, 'gack',-6, 'gark',-7, 'cork',cork1); +%! assert(get(grk,'gick'),-5) +%! assert(get(grk,'gack'),-6) +%! assert(get(grk,'gark'),-7) +%! assert(click(get(grk, 'cork')),13); +%!test grk = set(grk, 'cork',12); +%! assert(click(get(grk, 'cork')),12); +%! assert(class(cork(grk)),'Cork') +%! assert(class(grk),'Gork') +%! assert(isa(grk,'Gork')) +%! assert(isa(grk,'Dork')) +%! assert(isa(grk,'Pork')) +%! assert(isa(grk,'Blork')) +%! assert(isa(grk,'Snork')) +%! assert(isa(grk,'Spork'))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@derived/derived.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function r = derived (varargin) + __trace__ ('begin derived/derived'); + r = class (struct (), 'derived', parent ()); + __trace__ ('end derived/derived'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@derived/parent.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@other/other.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function r = other (varargin) + __trace__ ('begin other/other'); + r = class (struct (), 'other'); + __trace__ ('end other/other'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@other/parent.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,4 @@ +function r = parent (a) + __trace__ ('begin other/parent'); + __trace__ ('end other/parent'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@parent/method.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function r = method (a) + __trace__ ('begin parent/method'); + r = parent (a); + __trace__ ('end parent/method'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/@parent/parent.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/__trace__.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/module.mk Tue Oct 11 14:08:38 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/ctor-vs-method/test_ctor_vs_method.m Tue Oct 11 14:08:38 2011 -0500 @@ -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);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@derived/derived.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,5 @@ +function r = derived (n) + s.a = n; + p = parent (n); + r = class (s, 'derived', p); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@other/getsize_arrayfun.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,3 @@ +function r = getsize_arrayfun (x) + r = arrayfun (@(i) numel (x(i).d), 1:numel(x), 'uniformoutput', true); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@other/getsize_cellfun.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,3 @@ +function r = getsize_cellfun (x) + r = cellfun (@numel, {x.d}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@other/getsize_loop.m Tue Oct 11 14:08:38 2011 -0500 @@ -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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@other/other.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,4 @@ +function r = other (n) + s.d = derived (n); + r = class (s, 'other'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@parent/numel.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,3 @@ +function r = numel (x, varargin) + r = numel (x.a, varargin{:}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/@parent/parent.m Tue Oct 11 14:08:38 2011 -0500 @@ -0,0 +1,4 @@ +function r = parent (n) + s.a = rand (n, 1); + r = class (s, 'parent'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/module.mk Tue Oct 11 14:08:38 2011 -0500 @@ -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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/fcn-handle-derived-resolution/test_fcn_handle_derived_resolution.m Tue Oct 11 14:08:38 2011 -0500 @@ -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 Wed Oct 05 02:19:28 2011 +0200 +++ b/test/fntests.m Tue Oct 11 14:08:38 2011 -0500 @@ -115,26 +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; - ##elseif (has_demos (ffnm)) - ## 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, "/", 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);
--- a/test/test_classes.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,201 +0,0 @@ -## Copyright (C) 2009-2011 Robert T. Short -## -## 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 test classes. -%% -%% Note: This script and all classes are also intended to run -%% in MATLAB to test compatibility. Don't break that! -%% -%% To Do: This script tests to ensure that things done correctly work -%% corrrectly. It should also check that things done incorrectly -%% error properly. -%% -%% The classes used for the tests reside in the test directory. -%% -%% The classes provide the ability to test most of the major features -%% of the legacy OOP facilities. There are a number of classes, mostly -%% kind of the same, that create a hierarchy. - -%% Test the Snork class. The Snork class has a number of the standard -%% methods that the others don't so we can test indexing and other -%% features. -%!shared snk, snk1, snk2 -%!test snk = Snork(); -%! assert(gick(snk),1) -%! assert(snk.gick,1) -%! assert(snk(2),1); -%! assert(snk{end},3); -%!test snk = gick(snk,2); -%! assert(gick(snk),2) -%!test snk = set(snk,'gick',7); -%! assert(get(snk, 'gick'), 7) -%!test snk.gick = 4; -%! assert(gick(snk),4) -%! snk(1) = 3; -%!test snk{end} = 9; -%! assert(cack(snk),[3 1 2 9]) -%! assert(getStash(snk),1) % Check private functions. -%! assert(isobject(snk)) -%! assert(class(snk),'Snork') -%! assert(isa(snk,'Snork')) -%! assert(~isa(snk,'Sneetch')) -%! assert(ismethod(snk,'gick')) -%! assert(~ismethod(snk,'bletch')) -%! assert(exist('snk')) -%! assert(~exist('blink')) -%!test snk1 = Snork(snk); -%! assert(class(snk1),'Snork') -%! assert(gick(snk1),4) -%!test snk2 = Snork(-3); -%! assert(class(snk2),'Snork') -%! assert(gick(snk2),-3) -%!test x=[1 2 3 4]; -%! assert(x(snk),1); -%% x=methods('Snork'); % Need to test the methods function. -%% save temp snk; -%% load temp % This load causes a segment fault. -%% assert(cack(snk),[-1 -2 -3 -4]); % This is a major bug! - -%% The Spork class is a near clone of Snork but without as many standard -%% methods. We are testing no new octave features, but this is makes -%% sure that we haven't bollixed up the Spork class if we should make -%% changes. We use Spork in the class hierarchy. -%!shared sprk -%!test sprk = Spork(); -%! assert(geek(sprk),1) -%!test sprk = geek(sprk,3); -%! assert(geek(sprk),3) -%!test sprk = set(sprk,'geek',7); -%! assert(get(sprk, 'geek'), 7) -%! assert(class(sprk),'Spork'); -%! assert(isa(sprk,'Spork')) - -%% The Blork class is a near clone of Snork but without as many standard -%% methods. We are testing no new octave features, but this is makes -%% sure that we haven't bollixed up the Blork class if we should make -%% changes. We use Blork in the class hierarchy. -%!shared blrk -%!test blrk = Blork(); -%! assert(bleek(blrk),1) -%!test blrk = bleek(blrk,3); -%! assert(bleek(blrk),3) -%!test blrk = set(blrk,'bleek',13); -%! assert(get(blrk, 'bleek'), 13) -%! assert(class(blrk),'Blork'); -%! assert(isa(blrk,'Blork')) - -%% The Cork class is a near clone of Snork but without as many standard -%% methods. We are testing no new octave features, but this is makes -%% sure that we haven't bollixed up the Cork class if we should make -%% changes. We use Cork in the class hierarchy. -%!shared crk -%!test crk = Cork(23); -%! assert(click(crk),23) -%!test crk = click(crk,3); -%! assert(click(crk),3) -%!test crk = set(crk,'click',13); -%! assert(get(crk, 'click'), 13) -%! assert(class(crk),'Cork'); -%! assert(isa(crk,'Cork')) - -%% The Dork class tests single inheritance. -%!shared drk -%!test drk = Dork(); -%! assert(gack(drk),0) -%!test drk = gack(drk,-2); -%! assert(gack(drk),-2) -%!test drk = gick(drk,2); -%! assert(gick(drk),2); -%!test drk = set(drk, 'gick',3, 'gack',-3); -%! assert(get(drk, 'gick'), 3) -%! assert(get(drk, 'gack'), -3) -%! assert(class(drk),'Dork') -%! assert(isa(drk,'Dork')) -%! assert(isa(drk,'Snork')) -%! assert(getStash(drk),2) -%!test drk1 = Dork(drk); -%! assert(class(drk1),'Dork') -%! assert(isa(drk1,'Snork')) -%! assert(gick(drk1),3) -%! assert(gack(drk1),-3) -%!test drk2 = Dork(-4,4); -%! assert(class(drk2),'Dork') -%! assert(isa(drk2,'Snork')) -%! assert(gick(drk2),-4) -%! assert(gack(drk2),4) - -%% The Pork class is essentially a clone of Dork. It is used as part -%% of the multiple inheritance test. -%!shared prk, drk -%!test prk = Pork(); -%! assert(geek(prk),1) -%! assert(gurk(prk),0) -%!test prk = gurk(prk,-3); -%! assert(gurk(prk),-3) -%!test prk = geek(prk,9); -%! assert(geek(prk),9) -%! assert(class(prk),'Pork') -%! assert(isa(prk,'Pork')) -%! assert(isa(prk,'Spork')) -%!test drk = Dork(); % Precedence. -%! assert(bling(drk,prk),2) -%! assert(bling(prk,drk),2) - -%% The Gork class tests aggregation and multiple inheritance. -%!shared grk -%!test grk = Gork(); -%! assert(gick(grk),1) -%! assert(geek(grk),1) -%! assert(gack(grk),0) -%! assert(gurk(grk),0) -%! assert(bleek(grk),1) -%! assert(gark(grk),-2) -%! assert(click(cork(grk)),17) -%! assert(class(cork(grk)),'Cork') -%!test grk = gick(grk,3); -%!test grk = geek(grk,4); -%!test grk = gack(grk,-9); -%!test grk = gurk(grk,-8); -%!test grk = bleek(grk,-7); -%!test grk = gark(grk,-6); -%!test grk = cork(grk,click(cork(grk),23)); -%! assert(gick(grk),3) -%! assert(geek(grk),4) -%! assert(gack(grk),-9) -%! assert(gurk(grk),-8) -%! assert(bleek(grk),-7) -%! assert(gark(grk),-6) -%! assert(click(cork(grk)),23) -%!test -%! cork1 = Cork(13); -%! grk = set(grk, 'gick',-5, 'gack',-6, 'gark',-7, 'cork',cork1); -%! assert(get(grk,'gick'),-5) -%! assert(get(grk,'gack'),-6) -%! assert(get(grk,'gark'),-7) -%! assert(click(get(grk, 'cork')),13); -%!test grk = set(grk, 'cork',12); -%! assert(click(get(grk, 'cork')),12); -%! assert(class(cork(grk)),'Cork') -%! assert(class(grk),'Gork') -%! assert(isa(grk,'Gork')) -%! assert(isa(grk,'Dork')) -%! assert(isa(grk,'Pork')) -%! assert(isa(grk,'Blork')) -%! assert(isa(grk,'Snork')) -%! assert(isa(grk,'Spork'))
--- a/test/test_io.m Wed Oct 05 02:19:28 2011 +0200 +++ b/test/test_io.m Tue Oct 11 14:08:38 2011 -0500 @@ -245,6 +245,8 @@ %!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);
--- a/test/test_parser.m Wed Oct 05 02:19:28 2011 +0200 +++ b/test/test_parser.m Tue Oct 11 14:08:38 2011 -0500 @@ -247,3 +247,10 @@ %! 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)]);
--- a/test/test_string.m Wed Oct 05 02:19:28 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -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'); -