[Pkg-octave-commit] [SCM] Debian packaging for octave-general branch, master, updated. 1.1.3-1-26-g0960d88
Rafael Laboissiere
rafael at laboissiere.net
Tue Mar 13 19:02:09 UTC 2012
The following commit has been merged in the master branch:
commit 2121acc9b247730ac445bb76251d82969a3624a0
Author: Rafael Laboissiere <rafael at laboissiere.net>
Date: Mon Mar 12 07:51:46 2012 +0000
Imported Upstream version 1.2.2
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..bdb226b
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,337 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, see <http://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..0d6ef97
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,12 @@
+Name: General
+Version: 1.2.2
+Date: 2010-03-12
+Author: Jaroslav Hajek
+Maintainer: Jaroslav Hajek
+Title: General
+Description: General tools for octave. String dictionary, parallel computing.
+Categories: General
+Depends: octave (>= 3.2.4)
+Autoload: yes
+License: GPL version 3 or later
+Url: http://octave.sf.net
diff --git a/INDEX b/INDEX
new file mode 100644
index 0000000..d15d991
--- /dev/null
+++ b/INDEX
@@ -0,0 +1,28 @@
+general_html >> General purpose functions
+Parallel Computing
+ pararrayfun
+ parcellfun
+Various Functions
+ adresamp2
+ safeprod
+ unresamp2
+ unvech
+ ztvals
+ SHA1
+ fload
+ fsave
+ mark_for_deletion
+ packfields
+ unpackfields
+Dictionaries
+ @dict/dict
+ @dict/display
+ @dict/get
+ @dict/has
+ @dict/isempty
+ @dict/join
+ @dict/length
+ @dict/struct
+ @dict/subsasgn
+ @dict/subsref
+
diff --git a/inst/.svnignore b/inst/.svnignore
new file mode 100644
index 0000000..521f76d
--- /dev/null
+++ b/inst/.svnignore
@@ -0,0 +1,3 @@
+PKG_ADD
+*.octlink
+*.oct
diff --git a/inst/@dict/dict.m b/inst/@dict/dict.m
new file mode 100644
index 0000000..15da7f3
--- /dev/null
+++ b/inst/@dict/dict.m
@@ -0,0 +1,95 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {d =} dict (@var{keys}, @var{values})
+## @deftypefnx{Function File} {d =} dict ()
+## @deftypefnx{Function File} {d =} dict (@var{str})
+## Creates a dictionary object with given keys and values. @var{keys}
+## should be a cell array of strings; @var{values} should be a cell array
+## with matching size. @var{values} can also be a singleton array, in
+## which case it is expanded to the proper size; or omitted, in which case
+## the default value of empty matrix is used.
+## If neither @var{keys} nor @var{values} are supplied, an empty dictionary
+## is constructed.
+## If a scalar structure is supplied as an argument, it is converted to
+## a dictionary using field names as keys.
+##
+## A dictionary can be indexed either by a single string or cell array of
+## strings, like this:
+##
+## @example
+## d = dict (keys, values);
+## d(str) # result is a single value
+## d(cellstr) # result is a cell array
+## @end example
+##
+## In the first case, the stored value is returned directly; in the second case,
+## a cell array is returned. The cell array returned inherits the shape of the index.
+##
+## Similarly, indexed assignment works like this:
+##
+## @example
+## d = dict (keys, values);
+## d(str) = val; # store a single value
+## d(cellstr) = vals; # store a cell array
+## d(cellstr) = []; # delete a range of keys
+## @end example
+##
+## Any keys that are not present in the dictionary are added. The values of
+## existing keys are overwritten. In the second case, the lengths of index and
+## rhs should match or rhs should be a singleton array, in which case it is
+## broadcasted.
+##
+## It is also possible to retrieve keys and values as cell arrays, using the
+## "keys" and "values" properties. These properties are read-only.
+##
+## @end deftypefn
+function d = dict (keys, values)
+
+ if (nargin == 0)
+ keys = values = cell (0, 1);
+ elseif (nargin == 1)
+ if (iscellstr (keys))
+ keys = sort (keys(:));
+ values = cell (numel (keys), 1);
+ elseif (isstruct (keys))
+ values = struct2cell (keys)(:,:);
+ if (columns (values) != 1)
+ error ("dict: structure must be a scalar");
+ endif
+ [keys, ind] = sort (fieldnames (keys));
+ values = values(ind);
+ else
+ error ("dict: keys must be a cell vector of strings");
+ endif
+ elseif (nargin == 2)
+ [keys, idx] = sort (keys(:));
+ values = values (idx)(:);
+ else
+ print_usage ();
+ endif
+
+ d = class (struct ("keys", {keys}, "values", {values}), "dict");
+
+endfunction
+
+%!test
+%! free = dict ();
+%! free({"computing", "society"}) = {true};
+%! assert (free("computing"), free("society"));
diff --git a/inst/@dict/display.m b/inst/@dict/display.m
new file mode 100644
index 0000000..16aec4b
--- /dev/null
+++ b/inst/@dict/display.m
@@ -0,0 +1,42 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} display (d)
+## Overloaded display for dictionaries.
+## @end deftypefn
+function display (d)
+ if (isempty (d.keys))
+ printf ("%s = dict: {}\n", argn);
+ else
+ printf ("%s = \n\n", argn);
+ n = numel (d.keys);
+ puts ("dict: {\n");
+ for i = 1:n
+ keystr = d.keys{i};
+ valstr = disp (d.values{i});
+ if (any (valstr(1:end-1) == "\n"))
+ valstr = strrep (valstr, "\n", "\n ");
+ printf (" %s :\n\n %s", keystr, valstr(1:end-4));
+ else
+ printf (" %s : %s", keystr, valstr);
+ endif
+ endfor
+ puts ("}\n");
+ endif
+endfunction
diff --git a/inst/@dict/end.m b/inst/@dict/end.m
new file mode 100644
index 0000000..f0026f2
--- /dev/null
+++ b/inst/@dict/end.m
@@ -0,0 +1,23 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+function end ()
+
+ error ("invalid use of end to index a dict");
+
+endfunction
diff --git a/inst/@dict/get.m b/inst/@dict/get.m
new file mode 100644
index 0000000..746d22e
--- /dev/null
+++ b/inst/@dict/get.m
@@ -0,0 +1,59 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} get (d, key, defv)
+## Queries for the values of specified key(s). Unlike indexing, however,
+## this does not throw an error if a key is missing but rather substitutes
+## a default value. If @var{key} is a cell array, @var{defv} should be either
+## a cell array of the same shape as @var{key}, or a singleton cell.
+## Non-cell values will be converted to a singleton cell.
+## @end deftypefn
+
+function val = get (d, key, defv = [])
+ if (nargin < 2 || nargin > 3)
+ print_usage ();
+ endif
+
+ lookup = __lookup_compat__; # FIXME: remove when 3.3.x is required.
+
+ if (ischar (key))
+ i = lookup (d.keys, key, "m");
+ if (i)
+ val = d.values{i};
+ else
+ val = defv;
+ endif
+ elseif (iscellstr (key))
+ if (! iscell (defv))
+ val = repmat ({defv}, size (key));
+ elseif (numel (defv) == 1)
+ val = repmat (defv, size (key));
+ elseif (size_equal (key, defv))
+ val = defv;
+ else
+ error ("get: sizes of key & defv must match");
+ endif
+ i = lookup (d.keys, key, "m");
+ mask = i != 0;
+ val(mask) = d.values(i(mask));
+ else
+ error ("get: invalid key value");
+ endif
+endfunction
+
diff --git a/inst/@dict/has.m b/inst/@dict/has.m
new file mode 100644
index 0000000..5bd163c
--- /dev/null
+++ b/inst/@dict/has.m
@@ -0,0 +1,40 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} has (d, key)
+## Check whether the dictionary contains specified key(s).
+## Key can be either a string or a cell array. In the first case,
+## the result is a logical scalar; otherwise, the result is a logical array
+## with the same shape as @var{key}.
+## @end deftypefn
+
+function b = has (d, key)
+ if (nargin != 2)
+ print_usage ();
+ endif
+
+ lookup = __lookup_compat__; # FIXME: remove when 3.3.x is required.
+
+ if (ischar (key) || iscellstr (key))
+ b = lookup (d.keys, key, "b");
+ else
+ error ("has: invalid key value");
+ endif
+endfunction
+
diff --git a/inst/@dict/isempty.m b/inst/@dict/isempty.m
new file mode 100644
index 0000000..9e6b37a
--- /dev/null
+++ b/inst/@dict/isempty.m
@@ -0,0 +1,29 @@
+## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} isempty (d)
+## Returns true if the dictionary is empty.
+## @end deftypefn
+
+function is = isempty (d)
+
+ is = isempty (d.keys);
+
+endfunction
+
diff --git a/inst/@dict/join.m b/inst/@dict/join.m
new file mode 100644
index 0000000..b9261fc
--- /dev/null
+++ b/inst/@dict/join.m
@@ -0,0 +1,51 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} join (d1, d2, joinop)
+## Merges two given dictionaries. For common keys, the function @var{joinop} is
+## called to combine the two values. If not supplied, values from d2 are taken.
+## @end deftypefn
+
+function d = join (d1, d2, jop)
+ if (nargin < 2 || nargin > 3 || ! (isa (d1, "dict") && isa (d2, "dict")))
+ print_usage ();
+ endif
+
+ keys1 = d1.keys;
+ keys2 = d2.keys;
+
+ [keys, idx] = sort ([keys1; keys2]);
+ values = [d1.values; d2.values](idx);
+ n = numel (keys);
+
+ if (n > 1)
+ idx = find (strcmp (keys(1:n-1), keys(2:n)));
+ keys(idx) = [];
+ if (nargin == 3)
+ values(idx+1) = cellfun (jop, values(idx), values(idx+1), "UniformOutput", false);
+ endif
+ values(idx) = [];
+ endif
+
+ d = dict;
+ d.keys = keys;
+ d.values = values;
+
+endfunction
+
diff --git a/inst/@dict/length.m b/inst/@dict/length.m
new file mode 100644
index 0000000..05df36a
--- /dev/null
+++ b/inst/@dict/length.m
@@ -0,0 +1,29 @@
+## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} length (d)
+## Returns the number of key/value pairs.
+## @end deftypefn
+
+function l = length (d)
+
+ l = length (d.keys);
+
+endfunction
+
diff --git a/inst/@dict/private/__lookup_compat__.m b/inst/@dict/private/__lookup_compat__.m
new file mode 100644
index 0000000..a2b2191
--- /dev/null
+++ b/inst/@dict/private/__lookup_compat__.m
@@ -0,0 +1,57 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## This replaces the missing functionality of "lookup" if on Octave 3.2.
+
+function lookup_func = __lookup_compat__ ()
+ persistent octave32 = issorted ({"3.0.0", version, "3.3.0"});
+ if (octave32)
+ lookup_func = @__my_lookup__;
+ else
+ lookup_func = @lookup;
+ endif
+endfunction
+
+function ind = __my_lookup__ (table, y, opt = "")
+
+ mopt = any (opt == 'm');
+ bopt = any (opt == 'b');
+
+ opt(opt == 'm' | opt == 'b') = [];
+
+ ind = lookup (table, y, opt);
+ if (numel (table) > 0)
+ if (ischar (table) || iscellstr (table))
+ match = strcmp (table(max (1, ind)), y);
+ else
+ match = table(max (1, ind)) == y;
+ endif
+ else
+ match = false (size (y));
+ endif
+
+ if (mopt)
+ ind(! match) = 0;
+ elseif (bopt)
+ ind = match;
+ endif
+endfunction
+
+
+
+
diff --git a/inst/@dict/struct.m b/inst/@dict/struct.m
new file mode 100644
index 0000000..08ba67a
--- /dev/null
+++ b/inst/@dict/struct.m
@@ -0,0 +1,33 @@
+## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} struct (d)
+## Converts the dict object to a structure, if possible.
+## This requires the keys to be valid variable names.
+## @end deftypefn
+
+function s = struct (d)
+ keys = d.keys;
+ valid = cellfun (@isvarname, keys);
+ if (all (valid))
+ s = cell2struct (d.values, keys, 1);
+ else
+ error ("struct: invalid key value: %s", keys{find (! valid, 1)});
+ endif
+endfunction
diff --git a/inst/@dict/subsasgn.m b/inst/@dict/subsasgn.m
new file mode 100644
index 0000000..40d3d33
--- /dev/null
+++ b/inst/@dict/subsasgn.m
@@ -0,0 +1,105 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {d =} subsasgn (d, s, val)
+## Overloaded subsasgn for dictionaries.
+## @end deftypefn
+function d = subsasgn (d, s, val)
+ if (isempty (s))
+ error ("dict: missing index");
+ endif
+
+ lookup = __lookup_compat__; # FIXME: remove when 3.3.x is required.
+
+ switch (s(1).type)
+ case "()"
+ ind = s(1).subs;
+ if (numel (ind) == 1)
+ ind = ind{1};
+ else
+ error ("dict: needs exactly one index");
+ endif
+ if (ischar (ind))
+ ## Scalar assignment case. Search whether the key is present.
+ i = lookup (d.keys, ind, "m");
+ if (i)
+ ## The key is present; handle the rest of chain if needed,
+ ## then assign.
+ if (numel (s) > 1)
+ val = subsasgn (d.values{i}, s(2:end), val);
+ endif
+ d.values{i} = val;
+ else
+ ## The key is missing; handle the rest of chain if needed.
+ if (numel (s) > 1)
+ val = subsasgn ([], s(2:end), val);
+ endif
+ ## Look up the proper place to insert the new key.
+ i = lookup (d.keys, ind);
+ d.keys = [d.keys(1:i,1); {ind}; d.keys(i+1:end,1)];
+ ## Insert value.
+ d.values = [d.values(1:i,1); {val}; d.values(i+1:end,1)];
+ endif
+ elseif (iscellstr (ind))
+ ## Multiple assignment case. Perform checks.
+ if (numel (s) > 1)
+ error ("chained subscripts not allowed for multiple fields");
+ endif
+ if (isnull (val))
+ ## Deleting elements.
+ i = lookup (d.keys, ind, "m");
+ i = i(i != 0);
+ d.keys(i) = [];
+ d.values(i) = [];
+ elseif (iscell (val))
+ if (numel (val) == 1)
+ val = repmat (val, size (ind));
+ elseif (numel (ind) != numel (val))
+ error ("numbers of elements of index and rhs must match");
+ endif
+ ## Choose from two paths.
+ if (numel (ind) < numel (d.keys))
+ ## Scarce assignment. There's a good chance that all keys will be present.
+ i = lookup (d.keys, ind, "m");
+ mask = i != 0;
+ if (all (mask))
+ d.values(i) = val;
+ else
+ d.values(i(mask)) = val(mask);
+ mask = !mask;
+ [d.keys, i] = sort ([d.keys; ind(mask)(:)]);
+ d.values = [d.values; val(mask)(:)](i);
+ endif
+ else
+ ## Mass assignment. Probably most of the keys are new ones, so simply
+ ## melt all together.
+ [d.keys, i] = unique ([d.keys; ind(:)]);
+ d.values = [d.values; val(:)](i);
+ endif
+ else
+ error ("expected cell rhs for cell index");
+ endif
+ else
+ error ("invalid index");
+ endif
+ otherwise
+ error ("invalid subscript type for assignment");
+ endswitch
+endfunction
+
diff --git a/inst/@dict/subsref.m b/inst/@dict/subsref.m
new file mode 100644
index 0000000..6f8a533
--- /dev/null
+++ b/inst/@dict/subsref.m
@@ -0,0 +1,75 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {d =} subsref (d, s)
+## Overloaded subsref for dictionaries.
+## @end deftypefn
+function varargout = subsref (d, s)
+ if (isempty (s))
+ error ("dict: missing index");
+ endif
+
+ lookup = __lookup_compat__; # FIXME: remove when 3.3.x is required.
+
+ switch (s(1).type)
+ case "()"
+ ind = s(1).subs;
+ if (numel (ind) == 1)
+ ind = ind{1};
+ else
+ error ("dict: needs exactly one index");
+ endif
+ if (ischar (ind))
+ i = lookup (d.keys, ind, "m");
+ if (i)
+ e = d.values {i};
+ else
+ error ("key does not exist: %s", ind);
+ endif
+ elseif (iscellstr (ind))
+ i = lookup (d.keys, ind, "m");
+ if (all (i(:)))
+ e = reshape (d.values (i), size (ind)); # ensure correct shape.
+ else
+ ## Report the first non-existing key.
+ error ("key does not exist: %s", ind{find (i == 0, 1)});
+ endif
+ else
+ error ("invalid index");
+ endif
+ case "."
+ fld = s.subs;
+ switch (fld)
+ case 'keys'
+ e = d.keys;
+ case 'values'
+ e = d.values;
+ otherwise
+ error ("@dict/subsref: invalid property \"%s\"", fld);
+ endswitch
+ otherwise
+ error ("invalid subscript type");
+ endswitch
+
+ if (numel (s) > 1)
+ varargout = {subsref(e, s(2:end))};
+ else
+ varargout = {e};
+ endif
+endfunction
diff --git a/inst/adresamp2.m b/inst/adresamp2.m
new file mode 100644
index 0000000..b7991c1
--- /dev/null
+++ b/inst/adresamp2.m
@@ -0,0 +1,91 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {[@var{xs}, @var{ys}] =} adresamp2 (@var{x}, @var{y}, @var{n}, @var{eps})
+## Perform an adaptive resampling of a planar curve.
+## The arrays @var{x} and @var{y} specify x and y coordinates of the points of the curve.
+## On return, the same curve is approximated by @var{xs}, @var{ys} that have length @var{n}
+## and the angles between successive segments are approximately equal.
+## @end deftypefn
+
+function [xs, ys] = adresamp2 (x, y, n, eps)
+ if (! isvector (x) || ! size_equal (x, y) || ! isscalar (n) \
+ || ! isscalar (eps))
+ print_usage ();
+ endif
+
+ if (rows (x) == 1)
+ rowvec = true;
+ x = x.'; y = y.';
+ else
+ rowvec = false;
+ endif
+
+ # first differences
+ dx = diff (x); dy = diff (y);
+ # arc lengths
+ ds = hypot (dx, dy);
+ # derivatives
+ dx = dx ./ ds;
+ dy = dy ./ ds;
+ # second derivatives
+ d2x = deriv2 (dx, ds);
+ d2y = deriv2 (dy, ds);
+ # curvature
+ k = abs (d2x .* dy - d2y .* dx);
+ # curvature cut-off
+ if (eps > 0)
+ k = max (k, eps*max (k));
+ endif
+ # cumulative integrals
+ s = cumsum ([0; ds]);
+ t = cumsum ([0; ds .* k]);
+ # generate sample points
+ i = linspace (0, t(end), n);
+ if (! rowvec)
+ i = i.';
+ endif
+ # and resample
+ xs = interp1 (t, x, i);
+ ys = interp1 (t, y, i);
+endfunction
+
+# calculates second derivatives from first (non-uniform intervals), using local
+# quadratic approximations.
+function d2x = deriv2 (dx, dt)
+ n = length (dt);
+ if (n >= 2)
+ d2x = diff (dx) ./ (dt(1:n-1) + dt(2:n));
+ d2x = [2*d2x(1); d2x(1:n-2) + d2x(2:n-1); 2*d2x(n-1)];
+ else
+ d2x = zeros (n, 1);
+ endif
+endfunction
+
+%!demo
+%! R = 2; r = 3; d = 1.5;
+%! th = linspace (0, 2*pi, 1000);
+%! x = (R-r) * cos (th) + d*sin ((R-r)/r * th);
+%! y = (R-r) * sin (th) + d*cos ((R-r)/r * th);
+%! x += 0.3*exp (-(th-0.8*pi).^2);
+%! y += 0.4*exp (-(th-0.9*pi).^2);
+%!
+%! [xs, ys] = adresamp2 (x, y, 40);
+%! plot (x, y, "-", xs, ys, "*");
+%! title ("adaptive resampling")
diff --git a/inst/pararrayfun.m b/inst/pararrayfun.m
new file mode 100644
index 0000000..a49f0c7
--- /dev/null
+++ b/inst/pararrayfun.m
@@ -0,0 +1,77 @@
+## Copyright (C) 2009 Jaroslav Hajek
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+## Several improvements thanks to: Travis Collier <travcollier at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {[@var{o1}, @var{o2}, @dots{}] =} pararrayfun (@var{nproc}, @var{fun}, @var{a1}, @var{a2}, @dots{})
+## @deftypefnx{Function File} {} pararrayfun (nproc, fun, @dots{}, "UniformOutput", @var{val})
+## @deftypefnx{Function File} {} pararrayfun (nproc, fun, @dots{}, "ErrorHandler", @var{errfunc})
+## Evaluates a function for corresponding elements of an array.
+## Argument and options handling is analogical to @code{parcellfun}, except that
+## arguments are arrays rather than cells. If cells occur as arguments, they are treated
+## as arrays of singleton cells.
+## Arrayfun supports one extra option compared to parcellfun: "Vectorized".
+## This option must be given together with "ChunksPerProc" and it indicates
+## that @var{fun} is able to operate on vectors rather than just scalars, and returns
+## a vector. The same must be true for @var{errfunc}, if given.
+## In this case, the array is split into chunks which are then directly served to @var{func}
+## for evaluation, and the results are concatenated to output arrays.
+## @seealso{parcellfun, arrayfun}
+## @end deftypefn
+
+function varargout = pararrayfun (nproc, func, varargin)
+
+ if (nargin < 3)
+ print_usage ();
+ endif
+
+ [nargs, uniform_output, error_handler, ...
+ verbose_level, chunks_per_proc, vectorized] = parcellfun_opts (varargin);
+
+ args = varargin(1:nargs);
+ opts = varargin(nargs+1:end);
+ if (nargs == 0)
+ print_usage ();
+ elseif (nargs > 1)
+ [err, args{:}] = common_size (args{:});
+ if (err)
+ error ("pararrayfun: arguments size must match");
+ endif
+ endif
+
+ njobs = numel (args{1});
+
+ if (vectorized && chunks_per_proc > 0 && chunks_per_proc < njobs / nproc)
+ ## If "Vectorized" is on, we apply the function directly on chunks of
+ ## arrays.
+ [varargout{1:nargout}] = chunk_parcellfun (nproc, chunks_per_proc, ...
+ func, error_handler, verbose_level, args{:});
+ else
+ args = cellfun (@num2cell, args, "UniformOutput", false,
+ "ErrorHandler", @arg_class_error);
+
+ [varargout{1:nargout}] = parcellfun (nproc, func, args{:}, opts{:});
+ endif
+
+endfunction
+
+function arg_class_error (S, X)
+ error ("arrayfun: invalid argument of class %s", class (X))
+endfunction
+
diff --git a/inst/parcellfun.m b/inst/parcellfun.m
new file mode 100644
index 0000000..b31db39
--- /dev/null
+++ b/inst/parcellfun.m
@@ -0,0 +1,388 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek <highegg at gmail.com>
+## Several improvements thanks to: Travis Collier <travcollier at gmail.com>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {[@var{o1}, @var{o2}, @dots{}] =} parcellfun (@var{nproc}, @var{fun}, @var{a1}, @var{a2}, @dots{})
+## @deftypefnx{Function File} {} parcellfun (nproc, fun, @dots{}, "UniformOutput", @var{val})
+## @deftypefnx{Function File} {} parcellfun (nproc, fun, @dots{}, "ErrorHandler", @var{errfunc})
+## @deftypefnx{Function File} {} parcellfun (nproc, fun, @dots{}, "VerboseLevel", @var{val})
+## @deftypefnx{Function File} {} parcellfun (nproc, fun, @dots{}, "ChunksPerProc", @var{val})
+## Evaluates a function for multiple argument sets using multiple processes.
+## @var{nproc} should specify the number of processes. A maximum recommended value is
+## equal to number of CPUs on your machine or one less.
+## @var{fun} is a function handle pointing to the requested evaluating function.
+## @var{a1}, @var{a2} etc. should be cell arrays of equal size.
+## @var{o1}, @var{o2} etc. will be set to corresponding output arguments.
+##
+## The UniformOutput and ErrorHandler options are supported with meaning identical
+## to @dfn{cellfun}.
+## A VerboseLevel option controlling the level output is supported.
+## A value of 0 is quiet, 1 is normal, and 2 or more enables
+## debugging output.
+## The ChunksPerProc option control the number of chunks which contains elementary jobs. This
+## option particularly useful when time execution of function is small. Setting this option
+## to 100 is a good choice in most cases.
+##
+## Notice that jobs are served from a single first-come first-served queue,
+## so the number of jobs executed by each process is generally unpredictable.
+## This means, for example, that when using this function to perform Monte-Carlo
+## simulations one cannot expect results to be exactly reproducible. The pseudo
+## random number generators of each process are initialised with a unique state.
+## This currently works only for new style generators.
+##
+## NOTE: this function is implemented using "fork" and a number of pipes for IPC.
+## Suitable for systems with an efficient "fork" implementation (such as GNU/Linux),
+## on other systems (Windows) it should be used with caution.
+## Also, if you use a multithreaded BLAS, it may be wise to turn off multi-threading
+## when using this function.
+##
+## CAUTION: This function should be regarded as experimental. Although all subprocesses
+## should be cleared in theory, there is always a danger of a subprocess hanging up,
+## especially if unhandled errors occur. Under GNU and compatible systems, the following
+## shell command may be used to display orphaned Octave processes:
+## ps --ppid 1 | grep octave
+##
+## @end deftypefn
+
+function varargout = parcellfun (nproc, fun, varargin)
+
+ ## The list of functions to be seeded in each slave.
+ persistent random_func_list = {@rand, @randn, @rande, @randp, @randg};
+
+ if (nargin < 3 || ! isscalar (nproc) || nproc <= 0)
+ print_usage ();
+ endif
+
+ if (ischar (fun))
+ fun = str2func (fun);
+ elseif (! isa (fun, "function_handle"))
+ error ("parcellfun: fun must be either a function handle or name")
+ endif
+
+ [nargs, uniform_output, error_handler, ...
+ verbose_level, chunks_per_proc] = parcellfun_opts (varargin);
+
+ args = varargin(1:nargs);
+ if (! all (cellfun ("isclass", args, "cell")))
+ error ("parcellfun: all non-option arguments except the first one must be cell arrays");
+ endif
+
+ if (nargs == 0)
+ print_usage ();
+ elseif (nargs > 1)
+ [err, args{:}] = common_size (args{:});
+ if (err)
+ error ("parcellfun: arguments size must match");
+ endif
+ endif
+
+ njobs = numel (args{1});
+
+ if (chunks_per_proc > 0 && chunks_per_proc < njobs / nproc)
+ ## We need chunked evaluation.
+
+ ## Function executed for a chunk.
+ if (isempty (error_handler))
+ chunk_fun = @(varargin) cellfun (fun, varargin{:}, "UniformOutput", uniform_output);
+ else
+ chunk_fun = @(varargin) cellfun (fun, varargin{:}, ...
+ "UniformOutput", uniform_output, "ErrorHandler", error_handler);
+ endif
+
+ [varargout{1:nargout}] = chunk_parcellfun (nproc, chunks_per_proc, ...
+ chunk_fun, [], verbose_level, args{:});
+ return
+ endif
+
+ nproc = min (nproc, numel (args{1}));
+
+ ## create communication pipes.
+ cmdr = cmdw = resr = resw = zeros (nproc, 1);
+ err = 0;
+ for i = 1:nproc
+ ## command pipes
+ [cmdr(i), cmdw(i), err, msg] = pipe ();
+ if (err)
+ break;
+ endif
+ ## result pipes
+ [resr(i), resw(i), err, msg] = pipe ();
+ if (err)
+ break;
+ endif
+ endfor
+ if (! err)
+ ## status pipe
+ [statr, statw, err, msg] = pipe ();
+ endif
+ if (err)
+ error ("failed to open pipe: %s", msg);
+ endif
+
+ iproc = 0; # the parent process
+ nsuc = 0; # number of processes succesfully forked.
+
+ fflush (stdout); # prevent subprocesses from inheriting buffered output
+
+ ## get a seed and change state
+ seed = rand;
+
+ pids = zeros (nproc, 1);
+
+ ## fork subprocesses
+ for i = 1:nproc
+ [pid, msg] = fork ();
+ if (pid > 0)
+ ## parent process. fork succeded.
+ nsuc ++;
+ pids(i) = pid;
+ if (verbose_level > 1)
+ fprintf (stderr,'parcellfun: child process %d created\n', pids(i));
+ fflush (stderr);
+ endif
+ elseif (pid == 0)
+ ## child process.
+ iproc = i;
+ break;
+ elseif (pid < 0)
+ ## parent process. fork failed.
+ err = 1;
+ break;
+ endif
+ endfor
+
+ if (iproc)
+ ## child process. close unnecessary pipe ends.
+ fclose (statr);
+ for i = 1:nproc
+ ## we won't write commands and read results
+ fclose (cmdw (i));
+ fclose (resr (i));
+ if (i != iproc)
+ ## close also those pipes that don't belong to us.
+ fclose (cmdr (i));
+ fclose (resw (i));
+ endif
+ endfor
+ else
+ ## parent process. close unnecessary pipe ends.
+ fclose (statw);
+ for i = 1:nproc
+ ## we won't read commands and write results
+ fclose (cmdr (i));
+ fclose (resw (i));
+ endfor
+
+ if (nsuc)
+ ## we forked some processes. if this is less than we opted for, gripe
+ ## but continue.
+ if (nsuc < nproc)
+ warning ("parcellfun: only %d out of %d processes forked", nsuc, nproc);
+ nproc = nsuc;
+ endif
+ else
+ ## this is bad.
+ error ("parcellfun: failed to fork processes");
+ endif
+ endif
+
+ ## At this point, everything should be OK (?)
+
+ if (iproc)
+ ## the border patrol. we really don't want errors escape after the forks.
+ unwind_protect
+ try
+ ## re-seed random number states, adjusted for each process
+ seed *= iproc*bitmax;
+ ## FIXME: use cellfun when 3.4. is a requirement
+ for rf = random_func_list
+ feval (rf{1}, "state", seed);
+ endfor
+
+ ## child process. indicate ready state.
+ fwrite (statw, -iproc, "double");
+ fflush (statw);
+
+ do
+ ## get command
+ cmd = fread (cmdr(iproc), 1, "double");
+ if (cmd)
+ ## we've got a job to do. prepare argument and return lists.
+ res = cell (1, nargout);
+ argsc = cell (1, nargs);
+ for i = 1:nargs
+ argsc{i} = args{i}{cmd};
+ endfor
+
+ if (isempty (error_handler))
+ ## unguarded evaluation.
+ [res{:}] = fun (argsc{:});
+ else
+ ## guarded evaluation
+ try
+ [res{:}] = fun (argsc{:});
+ catch
+ errs.index = cmd;
+ [errs.message, errs.identifier] = lasterr ();
+ [res{:}] = error_handler (errs, argsc{:});
+ end_try_catch
+ endif
+
+ ## indicate ready state.
+ fwrite (statw, iproc, "double");
+ fflush (statw);
+
+ ## write the result.
+ ## FIXME: this can fail.
+ fsave (resw(iproc), res);
+ fflush (resw(iproc));
+
+ endif
+ until (cmd == 0)
+
+ catch
+
+ ## just indicate the error. don't quit this function !!!!
+ fputs (stderr, "\n");
+ warning ("parcellfun: unhandled error in subprocess %d", iproc);
+
+ ## send a termination notice.
+ fwrite (statw, -iproc, "double");
+ fflush (statw);
+
+ end_try_catch
+
+ unwind_protect_cleanup
+
+ ## This is enclosed in another handler to prevent errors from escaping.
+ ## If something goes wrong, we'll get a broken pipe signal, but anything
+ ## is better than skipping the following __exit__.
+ try
+ fclose (statw);
+ fclose (resw(iproc));
+ fclose (cmdr(iproc));
+ end_try_catch
+
+ ## no more work for us. We call __exit__, which bypasses termination sequences.
+ __exit__ ();
+
+ ## we should never get here.
+ exit ();
+
+ end_unwind_protect
+
+ else
+ ## parent process.
+ res = cell (nargout, njobs);
+
+ pjobs = 0;
+ pending = zeros (1, nproc);
+
+ unwind_protect
+
+ while (pjobs < njobs || any (pending))
+ ## if pipe contains no more data, that's bad
+ if (feof (statr))
+ warning ("parcellfun: premature exit due to closed pipe");
+ break;
+ endif
+ ## wait for a process state.
+ isubp = fread (statr, 1, "double");
+ if (isubp > 0)
+ ijob = pending(isubp);
+ ## we have a result ready.
+ res(:, ijob) = fload (resr(isubp));
+ ## clear pending state
+ pending(isubp) = 0;
+ else
+ isubp = -isubp;
+ if (pending(isubp))
+ ## premature exit means an unhandled error occured in a subprocess.
+ ## the process should have griped, we just try to exit gracefully.
+ pending(isubp) = 0;
+ ## no more jobs to start.
+ njobs = pjobs;
+ ## skip the rest; don't send commands to the process.
+ fclose(cmdw(isubp));
+ continue;
+ endif
+ endif
+ if (pjobs < njobs)
+ ijob = ++pjobs;
+ ## send the next job to the process.
+ fwrite (cmdw(isubp), ijob, "double");
+ fflush (cmdw(isubp));
+ ## set pending state
+ pending(isubp) = ijob;
+ else
+ ## send terminating signal
+ fwrite (cmdw(isubp), 0, "double");
+ fclose (cmdw(isubp));
+ endif
+ if (verbose_level > 0)
+ fprintf (stderr, "\rparcellfun: %d/%d jobs done", pjobs - sum (pending != 0), njobs);
+ fflush (stderr);
+ endif
+ endwhile
+
+ if (verbose_level > 0)
+ fputs (stderr, "\n");
+ fflush (stderr);
+ endif
+
+ unwind_protect_cleanup
+
+ ## send termination signals to active processes.
+ for isubp = find (pending)
+ ## send terminating signal
+ fwrite (cmdw(isubp), 0, "double");
+ fclose (cmdw(isubp));
+ endfor
+
+ ## explicitly recognize all terminated processes.
+ for i = 1:nproc
+ if (verbose_level > 1)
+ fprintf(stderr,'parcellfun: waiting for child process %d to close\n', pids(i));
+ fflush (stderr);
+ endif
+ [pid, status] = waitpid (pids(i));
+ endfor
+
+ ## FIXME: I think order is possibly important here, and this is correct.
+ ## close all pipe ends
+ fclose (statr);
+ for i = 1:nproc
+ fclose (resr(i));
+ endfor
+
+ end_unwind_protect
+
+ ## we're finished. transform the result.
+ varargout = cell (1, nargout);
+ shape = size (varargin{1});
+ for i = 1:nargout
+ varargout{i} = reshape (res(i,:), shape);
+ if (uniform_output)
+ varargout{i} = cell2mat (varargout{i});
+ endif
+ endfor
+
+ endif
+
+endfunction
diff --git a/inst/private/chunk_parcellfun.m b/inst/private/chunk_parcellfun.m
new file mode 100644
index 0000000..0e63bc1
--- /dev/null
+++ b/inst/private/chunk_parcellfun.m
@@ -0,0 +1,54 @@
+## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic
+## Copyright (C) 2010 Jean-Benoist Leger <jben at jben.info>
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} chunk_parcellfun (@dots{:})
+## Undocumented internal function.
+## @end deftypefn
+
+function varargout = chunk_parcellfun (nproc, chunks_per_proc, func,
+ error_handler, verbose_level, varargin)
+
+ args = varargin;
+
+ nchunks = chunks_per_proc * nproc;
+
+ ## Compute optimal chunk sizes.
+ N = numel (args{1});
+ len_chunk = ceil (N/nchunks);
+ chunk_sizes = len_chunk (ones(1, nchunks));
+ chunk_sizes(1:nchunks*len_chunk - N) -= 1;
+
+ ## Split argument arrays into chunks (thus making arrays of arrays).
+ chunked_args = cellfun (@(arg) mat2cell (arg(:), chunk_sizes), args, ...
+ "UniformOutput", false);
+
+ ## Attach error handler if present.
+ if (! isempty (error_handler))
+ chunked_args = [chunked_args, {"ErrorHandler", error_handler}];
+ endif
+
+ ## Main call.
+ [out_brut{1:nargout}] = parcellfun (nproc, func, chunked_args{:}, ...
+ "UniformOutput", false, "VerboseLevel", verbose_level);
+
+ ## Concatenate output args and reshape them to correct size.
+ true_size = size (args{1});
+ varargout = cellfun (@(arg) reshape (vertcat (arg{:}), true_size), out_brut, "UniformOutput", false);
+
+endfunction
+
diff --git a/inst/private/parcellfun_opts.m b/inst/private/parcellfun_opts.m
new file mode 100644
index 0000000..b5c9403
--- /dev/null
+++ b/inst/private/parcellfun_opts.m
@@ -0,0 +1,78 @@
+## Copyright (C) 2010 VZLU Prague, a.s., Czech Republic
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} parcellfun_opts (args)
+## Undocumented internal function.
+## @end deftypefn
+
+function [nargs, uniform_output, error_handler, ...
+ verbose_level, chunks_per_proc, vectorized] = parcellfun_opts (args)
+
+ uniform_output = true;
+ error_handler = [];
+ verbose_level = 1; # default to normal output level
+ chunks_per_proc = 0; # 0 means than size of chunk is 1
+ vectorized = false;
+
+ nargs = length (args);
+
+ ## parse options
+ while (nargs > 1)
+ opt = args{nargs-1};
+ if (! ischar (opt))
+ break;
+ else
+ opt = tolower (opt);
+ val = args{nargs};
+ endif
+ switch (opt)
+ case "uniformoutput"
+ uniform_output = logical (val);
+ if (! isscalar (uniform_output))
+ error ("parcellfun: UniformOutput must be a logical scalar");
+ endif
+ case "errorhandler"
+ error_handler = val;
+ if (! isa (error_handler, "function_handle"))
+ error ("parcellfun: ErrorHandler must be a function handle");
+ endif
+ case "verboselevel"
+ verbose_level = val;
+ if (! isscalar (verbose_level))
+ error ("parcellfun: VerboseLevel must be a numeric scalar");
+ endif
+ case "chunksperproc"
+ chunks_per_proc = round (val);
+ if (! isscalar (chunks_per_proc) || chunks_per_proc <= 0)
+ error ("parcellfun: ChunksPerProc must be a positive scalar");
+ endif
+ case "vectorized"
+ vectorized = logical (val);
+ if (! isscalar (vectorized))
+ error ("parcellfun: Vectorized must be a logical scalar");
+ endif
+ otherwise
+ break;
+ endswitch
+ nargs -= 2;
+ endwhile
+
+ if (vectorized && chunks_per_proc <= 0)
+ error ("parcellfun: the ""Vectorized"" option requires also ""ChunksPerProc""");
+ endif
+
+endfunction
diff --git a/inst/safeprod.m b/inst/safeprod.m
new file mode 100644
index 0000000..d25117f
--- /dev/null
+++ b/inst/safeprod.m
@@ -0,0 +1,64 @@
+## Copyright (C) 2008 VZLU Prague, a.s., Czech Republic
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {@var{p} =} safeprod (@var{x}, @var{dim})
+## @deftypefnx{Function File} {[@var{p}, @var{e}] =} safeprod (@var{x}, @var{dim})
+## This function forms product(s) of elements of the array @var{x} along the dimension
+## specified by @var{dim}, analogically to @code{prod}, but avoids overflows and underflows
+## if possible. If called with 2 output arguments, @var{p} and @var{e} are computed
+## so that the product is @code{@var{p} * 2^@var{e}}.
+## @seealso{prod,log2}
+## @end deftypefn
+
+## Author: Jaroslav Hajek <highegg at gmail.com>
+## Created: 2008-04-22
+
+function [p, e] = safeprod (x, dim)
+ if (nargin < 1 || nargin > 2)
+ print_usage ();
+ endif
+
+ if (nargin < 2)
+ if (rows(x) == 1)
+ dim = 2;
+ else
+ dim = 1;
+ endif
+ endif
+
+ % try the normal algorithm first
+ if (nargout < 2)
+ p = prod (x, dim);
+ else
+ p = 0;
+ endif
+
+ % 0, Inf and NaN are possibly problematic results. If detected, use the safe
+ % formula.
+
+ flag = (p == 0 | ! isfinite (p));
+
+ if (any (flag(:)))
+ [f, e] = log2 (x);
+ p = prod (f, dim);
+ e = sum (e, dim);
+ if (nargout < 2)
+ p = p .* 2.^e;
+ endif
+ endif
+
+endfunction
diff --git a/inst/unresamp2.m b/inst/unresamp2.m
new file mode 100644
index 0000000..fa095f4
--- /dev/null
+++ b/inst/unresamp2.m
@@ -0,0 +1,65 @@
+## Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+##
+## Author: Jaroslav Hajek
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {[@var{xs}, @var{ys}] =} unresamp2 (@var{x}, @var{y}, @var{n})
+## Perform a uniform resampling of a planar curve.
+## The arrays @var{x} and @var{y} specify x and y coordinates of the points of the curve.
+## On return, the same curve is approximated by @var{xs}, @var{ys} that have length @var{n}
+## and the distances between successive points are approximately equal.
+## @end deftypefn
+
+function [xs, ys] = unresamp2 (x, y, n)
+ if (! isvector (x) || ! size_equal (x, y) || ! isscalar (n))
+ print_usage ();
+ endif
+
+ if (rows (x) == 1)
+ rowvec = true;
+ x = x.'; y = y.';
+ else
+ rowvec = false;
+ endif
+
+ # first differences
+ dx = diff (x); dy = diff (y);
+ # arc lengths
+ ds = hypot (dx, dy);
+ # cumulative integral
+ s = cumsum ([0; ds]);
+ # generate sample points
+ i = linspace (0, s(end), n);
+ if (! rowvec)
+ i = i.';
+ endif
+ # and resample
+ xs = interp1 (s, x, i);
+ ys = interp1 (s, y, i);
+endfunction
+
+%!demo
+%! R = 2; r = 3; d = 1.5;
+%! th = linspace (0, 2*pi, 1000);
+%! x = (R-r) * cos (th) + d*sin ((R-r)/r * th);
+%! y = (R-r) * sin (th) + d*cos ((R-r)/r * th);
+%! x += 0.3*exp (-(th-0.8*pi).^2);
+%! y += 0.4*exp (-(th-0.9*pi).^2);
+%!
+%! [xs, ys] = unresamp2 (x, y, 40);
+%! plot (x, y, "-", xs, ys, "*");
+%! title ("uniform resampling")
diff --git a/inst/unvech.m b/inst/unvech.m
new file mode 100644
index 0000000..a935435
--- /dev/null
+++ b/inst/unvech.m
@@ -0,0 +1,53 @@
+## Copyright (C) 2006 Michael Creel <michael.creel at uab.es>
+## Copyright (C) 2009 Jaroslav Hajek
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 2 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with this program; If not, see <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn {Function File} {} unvech (@var{v})
+## Performs the reverse of "vech". Generates a symmetric matrix from the lower
+## triangular elements, received as a vector @var{v}.
+## @end deftypefn
+
+function x = unvech (v)
+
+ if (nargin != 1)
+ usage ("unvech (v)");
+ endif
+
+ if (! isvector(v))
+ usage ("unvech (v)");
+ endif
+
+ # find out dimension of symmetric matrix
+ p = length (v);
+ n = -(1 - sqrt (1 + 8*p))/2;
+
+ if (mod (n, 1) != 0)
+ error("unvech: the input vector does not generate a square matrix");
+ endif
+
+ x = zeros (n, n);
+
+ # do the reverse of vech
+ count = 0;
+ for j = 1 : n
+ i = j : n;
+ x(j,i) = x(i,j) = v(count + i);
+ count += n - j;
+ endfor
+endfunction
+
+%!assert(unvech([1;0;0;1;0;1]), eye(3,3) );
+%!error <does not generate a square matrix> unvech([1;0;0;1;0;1;1]);
diff --git a/inst/ztvals.m b/inst/ztvals.m
new file mode 100644
index 0000000..aa8060a
--- /dev/null
+++ b/inst/ztvals.m
@@ -0,0 +1,45 @@
+## Copyright (C) 2009 Jaroslav Hajek
+##
+## This program is free software; you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published by
+## the Free Software Foundation; either version 3 of the License, or
+## (at your option) any later version.
+##
+## This program is distributed in the hope that it will be useful,
+## but WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with Octave; see the file COPYING. If not, see
+## <http://www.gnu.org/licenses/>.
+
+## -*- texinfo -*-
+## @deftypefn{Function File} {} function ztvals (@var{x}, @var{tol})
+## Replaces tiny elements of the vector @var{x} by zeros.
+## Equivalent to
+## @example
+## @var{x}(abs(@var{x}) < @var{tol} * norm (@var{x}, Inf)) = 0
+## @end example
+## @var{tol} specifies the chopping tolerance. It defaults to
+## 1e-10 for double precision and 1e-5 for single precision inputs.
+## @end deftypefn
+
+function x = ztvals (x, tol)
+ if (nargin == 1)
+ if (isa (x, 'single'))
+ tol = 1e-5;
+ else
+ tol = 1e-10;
+ endif
+ elseif (nargin != 2)
+ print_usage ();
+ endif
+
+ if (isfloat (x))
+ x(abs(x) < tol*norm (x, Inf)) = 0;
+ else
+ error ("ztvals: needs a floating-point argument");
+ endif
+
+endfunction
diff --git a/src/.svnignore b/src/.svnignore
new file mode 100644
index 0000000..521f76d
--- /dev/null
+++ b/src/.svnignore
@@ -0,0 +1,3 @@
+PKG_ADD
+*.octlink
+*.oct
diff --git a/src/Makefile b/src/Makefile
new file mode 100644
index 0000000..dac9d13
--- /dev/null
+++ b/src/Makefile
@@ -0,0 +1,10 @@
+PROGS = $(patsubst %.cc,%.oct,$(wildcard *.cc))
+
+all: $(PROGS)
+
+$(PROGS): Makefile
+
+%.oct: %.cc
+ mkoctfile $<
+
+clean: ; -rm *.o core octave-core *.oct *~
diff --git a/src/SHA1.cc b/src/SHA1.cc
new file mode 100644
index 0000000..6b7ab0d
--- /dev/null
+++ b/src/SHA1.cc
@@ -0,0 +1,292 @@
+/*
+ * SHA1: calculate the SHA1 hash
+ *
+ * Copyright (C) 1999 Andy Adler
+ * This code has no warrany whatsoever.
+ * Do what you like with this code as long as you
+ * leave this copyright in place.
+ *
+ * $Id: SHA1.cc 2522 2006-08-20 12:25:20Z hauberg $
+ *
+ * $Log$
+ * Revision 1.1 2006/08/20 12:25:20 hauberg
+ * Changed directory structure to match the new package system
+ *
+ * Revision 1.3 2002/11/02 11:05:07 pkienzle
+ * Seperate lines of multiline strings with \n\ to keep gcc 3.2 happy.
+ *
+ * Revision 1.2 2002/03/17 18:23:57 aadler
+ * bug with function prototypes
+ *
+ * Revision 1.1 2002/03/17 02:39:44 aadler
+ * SHA1 secure hash function
+ *
+ */
+
+#include <octave/oct.h>
+
+/*
+ * defines for SHA1.c code
+ */
+
+#define HW 5
+#define LITTLE_ENDIAN_DEF 5
+
+typedef struct {
+ unsigned long state[5];
+ unsigned long count[2];
+ unsigned char buffer[64];
+} hash_context;
+
+static void
+hash_initial( hash_context * c );
+static void
+hash_process( hash_context * c, unsigned char * data, unsigned len );
+static void
+hash_final( hash_context * c, unsigned long[HW] );
+
+DEFUN_DLD (SHA1, args, ,
+ "hash = SHA1 (...)\n\
+SHA1 implements the Secure Hash Algorithm Cryptographic\n\
+Hashing (One-Way) function. (FIPS PUB 180-1)\n\
+\n\
+hash= SHA1( byte_stream, hash_initial )\n\
+hash = Row Vector of 20 byte values;\n\
+\n\
+hash_initial default is 67452301 EFCDAB89 98BADCFE 10325476 C3D2E1F0\n\
+\n\
+Note: while it is possible to create a \"poor-man's\" MAC (message\n\
+authenticity code) by setting hash_initial to a private value,\n\
+it is better to use an algorithm like HMAC.\n\
+\n\
+HMAC= SHA1( [ passcode, SHA1( [passcode, data ] ) ); ")
+{
+ octave_value_list retval;
+ octave_value tmp;
+ int nargin = args.length ();
+ hash_context c;
+
+ if (nargin >2 || nargin ==0) {
+ usage("SHA1");
+ return retval;
+ }
+ else if (nargin ==2 ){
+ ColumnVector init( args(1).vector_value() );
+ if (init.length() != 20)
+ error("hash initializer must have 20 bytes");
+
+ for( int i=0,k=0; i<5; i++) {
+ c.state[i]= 0;
+ for( int j=0; j<4; j++)
+ c.state[i]|= ( (unsigned char) init(k++) ) << (24 - 8*j);
+// printf("state=%d v=%08lX\n", i, c.state[i]);
+ }
+ c.count[0]= c.count[1]=0;
+ }
+ else {
+ hash_initial( &c);
+ }
+
+ ColumnVector data( args(0).vector_value() );
+ int len=data.length();
+
+ for( int i=0; i< len; i++) {
+ unsigned char d= (unsigned char) data(i);
+ hash_process( &c, &d, 1);
+ }
+
+ unsigned long digest[5];
+ hash_final( &c, digest);
+
+ RowVector hash(20);
+ for( int i=0; i<5; i++) {
+ hash(4*i+0)= (digest[i] & 0xFF000000)>>24;
+ hash(4*i+1)= (digest[i] & 0x00FF0000)>>16;
+ hash(4*i+2)= (digest[i] & 0x0000FF00)>> 8;
+ hash(4*i+3)= (digest[i] & 0x000000FF);
+ }
+
+ retval(0)= hash;
+ return retval;
+}
+
+/*
+ * NOTE: The following code is not mine and has
+ * the following copyright
+ */
+
+/*
+This code is available from:
+ http://ds.dial.pipex.com/george.barwood/v8/pegwit.htm
+SHA-1 in C
+By Steve Reid <steve at edmweb.com>
+100% Public Domain
+
+Test Vectors (from FIPS PUB 180-1)
+"abc"
+ A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D
+"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq"
+ 84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1
+A million repetitions of "a"
+ 34AA973C D4C4DAA4 F61EEB2B DBAD2731 6534016F
+*/
+
+
+#if !defined(LITTLE_ENDIAN_DEF) && !defined(BIG_ENDIAN_DEF)
+ #if defined(_M_IX86) || defined(_M_I86) || defined(__alpha)
+ #define LITTLE_ENDIAN_DEF
+ #else
+ #error "LITTLE_ENDIAN_DEF or BIG_ENDIAN_DEF must be defined"
+ #endif
+#endif
+
+/* #define SHA1HANDSOFF * Copies data before messing with it. */
+
+
+#define rol(value, bits) (((value) << (bits)) | ((value) >> (32 - (bits))))
+
+/* blk0() and blk() perform the initial expand. */
+/* I got the idea of expanding during the round function from SSLeay */
+#ifdef LITTLE_ENDIAN_DEF
+#define blk0(i) (block->l[i] = (rol(block->l[i],24)&0xFF00FF00) \
+ |(rol(block->l[i],8)&0x00FF00FF))
+#else
+#define blk0(i) block->l[i]
+#endif
+#define blk(i) (block->l[i&15] = rol(block->l[(i+13)&15]^block->l[(i+8)&15] \
+ ^block->l[(i+2)&15]^block->l[i&15],1))
+
+/* (R0+R1), R2, R3, R4 are the different operations used in SHA1 */
+#define R0(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk0(i)+0x5A827999+rol(v,5);w=rol(w,30);
+#define R1(v,w,x,y,z,i) z+=((w&(x^y))^y)+blk(i)+0x5A827999+rol(v,5);w=rol(w,30);
+#define R2(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0x6ED9EBA1+rol(v,5);w=rol(w,30);
+#define R3(v,w,x,y,z,i) z+=(((w|x)&y)|(w&x))+blk(i)+0x8F1BBCDC+rol(v,5);w=rol(w,30);
+#define R4(v,w,x,y,z,i) z+=(w^x^y)+blk(i)+0xCA62C1D6+rol(v,5);w=rol(w,30);
+
+
+/* Hash a single 512-bit block. This is the core of the algorithm. */
+
+static
+void SHA1Transform(unsigned long state[5], unsigned char buffer[64])
+{
+unsigned long a, b, c, d, e;
+typedef union {
+ unsigned char c[64];
+ unsigned long l[16];
+} CHAR64LONG16;
+CHAR64LONG16* block;
+#ifdef SHA1HANDSOFF
+static unsigned char workspace[64];
+ block = (CHAR64LONG16*)workspace;
+ memcpy(block, buffer, 64);
+#else
+ block = (CHAR64LONG16*)buffer;
+#endif
+ /* Copy context->state[] to working vars */
+ a = state[0];
+ b = state[1];
+ c = state[2];
+ d = state[3];
+ e = state[4];
+ /* 4 rounds of 20 operations each. Loop unrolled. */
+ R0(a,b,c,d,e, 0); R0(e,a,b,c,d, 1); R0(d,e,a,b,c, 2); R0(c,d,e,a,b, 3);
+ R0(b,c,d,e,a, 4); R0(a,b,c,d,e, 5); R0(e,a,b,c,d, 6); R0(d,e,a,b,c, 7);
+ R0(c,d,e,a,b, 8); R0(b,c,d,e,a, 9); R0(a,b,c,d,e,10); R0(e,a,b,c,d,11);
+ R0(d,e,a,b,c,12); R0(c,d,e,a,b,13); R0(b,c,d,e,a,14); R0(a,b,c,d,e,15);
+ R1(e,a,b,c,d,16); R1(d,e,a,b,c,17); R1(c,d,e,a,b,18); R1(b,c,d,e,a,19);
+ R2(a,b,c,d,e,20); R2(e,a,b,c,d,21); R2(d,e,a,b,c,22); R2(c,d,e,a,b,23);
+ R2(b,c,d,e,a,24); R2(a,b,c,d,e,25); R2(e,a,b,c,d,26); R2(d,e,a,b,c,27);
+ R2(c,d,e,a,b,28); R2(b,c,d,e,a,29); R2(a,b,c,d,e,30); R2(e,a,b,c,d,31);
+ R2(d,e,a,b,c,32); R2(c,d,e,a,b,33); R2(b,c,d,e,a,34); R2(a,b,c,d,e,35);
+ R2(e,a,b,c,d,36); R2(d,e,a,b,c,37); R2(c,d,e,a,b,38); R2(b,c,d,e,a,39);
+ R3(a,b,c,d,e,40); R3(e,a,b,c,d,41); R3(d,e,a,b,c,42); R3(c,d,e,a,b,43);
+ R3(b,c,d,e,a,44); R3(a,b,c,d,e,45); R3(e,a,b,c,d,46); R3(d,e,a,b,c,47);
+ R3(c,d,e,a,b,48); R3(b,c,d,e,a,49); R3(a,b,c,d,e,50); R3(e,a,b,c,d,51);
+ R3(d,e,a,b,c,52); R3(c,d,e,a,b,53); R3(b,c,d,e,a,54); R3(a,b,c,d,e,55);
+ R3(e,a,b,c,d,56); R3(d,e,a,b,c,57); R3(c,d,e,a,b,58); R3(b,c,d,e,a,59);
+ R4(a,b,c,d,e,60); R4(e,a,b,c,d,61); R4(d,e,a,b,c,62); R4(c,d,e,a,b,63);
+ R4(b,c,d,e,a,64); R4(a,b,c,d,e,65); R4(e,a,b,c,d,66); R4(d,e,a,b,c,67);
+ R4(c,d,e,a,b,68); R4(b,c,d,e,a,69); R4(a,b,c,d,e,70); R4(e,a,b,c,d,71);
+ R4(d,e,a,b,c,72); R4(c,d,e,a,b,73); R4(b,c,d,e,a,74); R4(a,b,c,d,e,75);
+ R4(e,a,b,c,d,76); R4(d,e,a,b,c,77); R4(c,d,e,a,b,78); R4(b,c,d,e,a,79);
+ /* Add the working vars back into context.state[] */
+ state[0] += a;
+ state[1] += b;
+ state[2] += c;
+ state[3] += d;
+ state[4] += e;
+ /* Wipe variables */
+ a = b = c = d = e = 0;
+}
+
+
+/* Initialize new context */
+
+static
+void hash_initial(hash_context* context)
+{
+ /* SHA1 initialization constants */
+ context->state[0] = 0x67452301;
+ context->state[1] = 0xEFCDAB89;
+ context->state[2] = 0x98BADCFE;
+ context->state[3] = 0x10325476;
+ context->state[4] = 0xC3D2E1F0;
+ context->count[0] = context->count[1] = 0;
+}
+
+
+/* Run your data through this. */
+static
+void hash_process( hash_context * context, unsigned char * data, unsigned len )
+{
+unsigned int i, j;
+unsigned long blen = ((unsigned long)len)<<3;
+
+ j = (context->count[0] >> 3) & 63;
+ if ((context->count[0] += blen) < blen ) context->count[1]++;
+ context->count[1] += (len >> 29);
+ if ((j + len) > 63) {
+ memcpy(&context->buffer[j], data, (i = 64-j));
+ SHA1Transform(context->state, context->buffer);
+ for ( ; i + 63 < len; i += 64) {
+ SHA1Transform(context->state, &data[i]);
+ }
+ j = 0;
+ }
+ else i = 0;
+ memcpy(&context->buffer[j], &data[i], len - i);
+}
+
+
+/* Add padding and return the message digest. */
+
+static
+void hash_final( hash_context* context, unsigned long digest[5] )
+{
+unsigned long i, j;
+unsigned char finalcount[8];
+
+ for (i = 0; i < 8; i++) {
+ finalcount[i] = (unsigned char)((context->count[(i >= 4 ? 0 : 1)]
+ >> ((3-(i & 3)) * 8) ) & 255); /* Endian independent */
+ }
+ hash_process(context, (unsigned char *)"\200", 1);
+ while ((context->count[0] & 504) != 448) {
+ hash_process(context, (unsigned char *)"\0", 1);
+ }
+ hash_process(context, finalcount, 8); /* Should cause a SHA1Transform() */
+ for (i = 0; i < 5; i++) {
+ digest[i] = context->state[i];
+ }
+ /* Wipe variables */
+ i = j = 0;
+ memset(context->buffer, 0, 64);
+ memset(context->state, 0, 20);
+ memset(context->count, 0, 8);
+ memset(&finalcount, 0, 8);
+#ifdef SHA1HANDSOFF /* make SHA1Transform overwrite it's own static vars */
+ SHA1Transform(context->state, context->buffer);
+#endif
+}
+
+
diff --git a/src/__exit__.cc b/src/__exit__.cc
new file mode 100644
index 0000000..76ab29c
--- /dev/null
+++ b/src/__exit__.cc
@@ -0,0 +1,33 @@
+// Copyright (C) 2008 Olaf Till <olaf.till at uni-jena.de>
+
+// This program is free software; you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation; either version 3 of the License, or
+// (at your option) any later version.
+
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+
+// You should have received a copy of the GNU General Public License
+// along with this program; if not, write to the Free Software
+// Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+#include <octave/oct.h>
+
+#include <unistd.h>
+#include <signal.h>
+
+DEFUN_DLD (__exit__, args, ,
+ "-*- texinfo -*-\n\
+ at deftypefn {Loadable Function} __exit__ (status)\n\
+This is a wrapper over the POSIX _exit() system call. Calling this function\n\
+will terminate the running process immediatelly, bypassing normal Octave\n\
+terminating sequence. It is suitable to terminate a forked process. It\n\
+should be considered expert-only and not to be used in normal code.\n\
+ at end deftypefn")
+{
+ _exit (args.length () > 0 ? args(0).int_value () : 0);
+}
diff --git a/src/fload.cc b/src/fload.cc
new file mode 100644
index 0000000..b71819c
--- /dev/null
+++ b/src/fload.cc
@@ -0,0 +1,62 @@
+/* Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+ *
+ * Author: Jaroslav Hajek <highegg at gmail.com>
+ *
+ * This file is part of OctaveForge.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING. If not, see
+ * <http://www.gnu.org/licenses/>. */
+
+#include <octave/oct.h>
+#include <octave/mach-info.h>
+#include <octave/ls-oct-binary.h>
+#include <octave/oct-stream.h>
+
+DEFUN_DLD (fload, args, ,
+ "-*- texinfo -*-\n\
+ at deftypefn {Loadable Function} {@var{var} =} fload (@var{fid})\n\
+Loads a single variable of any type from a binary stream, where it was previously\n\
+saved with fsave.\n\
+ at end deftypefn")
+{
+ octave_value retval;
+ int nargin = args.length ();
+
+ if (nargin == 1)
+ {
+ int fid = octave_stream_list::get_file_number (args (0));
+
+ octave_stream octs = octave_stream_list::lookup (fid, "fload");
+ std::istream *is = octs.input_stream ();
+
+ if (is)
+ {
+ // FIXME: these are dummies. It would be nice to get rid of them and call
+ // a more low-level interface, but there doesn't seem to be a more suitable
+ // one in Octave, that still does the automatic type lookup.
+ std::string doc, filename;
+ bool swap = false, global;
+ read_binary_data (*is, swap, oct_mach_info::native_float_format (),
+ filename, global, retval, doc);
+ if (retval.is_undefined ())
+ error ("fload: failed to extract value");
+ }
+ else
+ error ("fload: stream not opened for reading.");
+ }
+ else
+ print_usage ();
+
+ return retval;
+}
diff --git a/src/fsave.cc b/src/fsave.cc
new file mode 100644
index 0000000..93d3901
--- /dev/null
+++ b/src/fsave.cc
@@ -0,0 +1,61 @@
+/* Copyright (C) 2009 VZLU Prague, a.s., Czech Republic
+ *
+ * Author: Jaroslav Hajek <highegg at gmail.com>
+ *
+ * This file is part of OctaveForge.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING. If not, see
+ * <http://www.gnu.org/licenses/>. */
+
+#include <octave/oct.h>
+#include <octave/mach-info.h>
+#include <octave/ls-oct-binary.h>
+#include <octave/oct-stream.h>
+
+DEFUN_DLD (fsave, args, ,
+ "-*- texinfo -*-\n\
+ at deftypefn {Loadable Function} {} fsave (@var{fid}, @var{var})\n\
+Save a single variable to a binary stream, to be subsequently loaded with\n\
+fload. Returns true if successful.\n\
+ at end deftypefn")
+{
+ octave_value retval;
+ int nargin = args.length ();
+
+ if (nargin == 2)
+ {
+ int fid = octave_stream_list::get_file_number (args(0));
+
+ octave_stream octs = octave_stream_list::lookup (fid, "fsave");
+ std::ostream *os = octs.output_stream ();
+
+ octave_value val = args(1);
+
+ if (os)
+ {
+ // FIXME: these are dummies. It would be nice to get rid of them and call
+ // a more low-level interface, but there doesn't seem to be a more suitable
+ // one in Octave, that still does the automatic type lookup.
+ std::string doc, name;
+ bool floats = false, global = false;
+ save_binary_data (*os, val, name, doc, global, floats);
+ }
+ else
+ error ("fsave: stream not opened for writing.");
+ }
+ else
+ print_usage ();
+
+ return retval;
+}
diff --git a/src/mark_for_deletion.cc b/src/mark_for_deletion.cc
new file mode 100644
index 0000000..e363928
--- /dev/null
+++ b/src/mark_for_deletion.cc
@@ -0,0 +1,31 @@
+// mark_for_deletion - mark a file for deletion
+// Copyright (C) 2002 Andy Adler
+// Licensed under the GNU GPL.
+#include <octave/oct.h>
+
+#if 0
+#include <octave/file-io.h>
+#else
+// The following declaration moved from pt-plot.h to file-io.h
+// We duplicate it here so that octave-forge can support earlier
+// versions of octave. This is cruft that needs to be removed.
+extern void mark_for_deletion (const std::string&);
+#endif
+
+DEFUN_DLD (mark_for_deletion, args,,
+"mark_for_deletion ( filename1, filename2, ... );\n\
+put filenames in the list of files to be deleted\n\
+when octave terminates.\n\
+This is useful for any function which uses temprorary files.")
+{
+ octave_value retval;
+ for ( int i=0; i< args.length(); i++) {
+ if( ! args(i).is_string() ) {
+ error ("mark_for_deletion: arguments must be string filenames");
+ return retval;
+ } else {
+ mark_for_deletion( args(i).string_value() );
+ }
+ }
+ return retval;
+}
diff --git a/src/packfields.cc b/src/packfields.cc
new file mode 100644
index 0000000..a98ac0f
--- /dev/null
+++ b/src/packfields.cc
@@ -0,0 +1,127 @@
+/*
+
+Copyright (C) 2009 VZLU Prague
+
+This file is part of OctaveForge.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 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/>.
+
+*/
+
+#include <octave/oct.h>
+#include <octave/utils.h>
+#include <octave/symtab.h>
+#include <octave/oct-map.h>
+
+DEFUN_DLD (packfields, args, ,
+ "-*- texinfo -*-\n\
+ at deftypefn {Loadable Function} packfields (struct, var1, var2, @dots{})\n\
+Inserts the named variables @var{var1}, @var{var2}, @dots{} as fields into @var{struct}.\n\
+ at var{struct} can be a scalar structure or user class.\n\
+This is equivalent to the code:\n\
+ at example\n\
+ struct.var1 = var1;\n\
+ struct.var2 = var2;\n\
+ : \n\
+ at end example\n\
+but more efficient and more concise.\n\
+ at seealso{unpackfields, struct}\n\
+ at end deftypefn")
+{
+ int nargin = args.length ();
+
+ if (nargin > 0)
+ {
+ std::string struct_name = args (0).string_value ();
+ string_vector fld_names(nargin-1);
+ //octave_value_list fld_vals(nargin-1);
+ // FIXME: workaround for 3.2.4.
+ octave_value_list fld_vals (nargin-1, octave_value ());
+
+ if (! error_state && ! valid_identifier (struct_name))
+ error ("packfields: invalid variable name: %s", struct_name.c_str ());
+
+ for (octave_idx_type i = 0; i < nargin-1; i++)
+ {
+ if (error_state)
+ break;
+
+ std::string fld_name = args(i+1).string_value ();
+
+ if (error_state)
+ break;
+
+ if (valid_identifier (fld_name))
+ {
+ fld_names(i) = fld_name;
+ octave_value fld_val = symbol_table::varval (fld_name);
+ if (fld_val.is_defined ())
+ fld_vals(i) = fld_val;
+ else
+ error ("packfields: variable %s not defined", fld_name.c_str ());
+ }
+ else
+ error ("packfields: invalid field name: %s", fld_name.c_str ());
+ }
+
+ if (! error_state)
+ {
+ // Force the symbol to be inserted in caller's scope.
+ symbol_table::symbol_record& rec = symbol_table::insert (struct_name);
+
+ octave_value& struct_ref = rec.varref ();
+
+ // If not defined, use struct ().
+ if (! struct_ref.is_defined ())
+ struct_ref = Octave_map (dim_vector (1, 1));
+
+ if (struct_ref.is_map ())
+ {
+ // Fast code for a built-in struct.
+ Octave_map map = struct_ref.map_value ();
+
+ if (map.numel () == 1)
+ {
+ // Do the actual work.
+ struct_ref = octave_value (); // Unshare map.
+ for (octave_idx_type i = 0; i < nargin-1; i++)
+ map.assign (fld_names(i), fld_vals(i));
+ struct_ref = map;
+ }
+ else
+ error ("packfields: structure must have singleton dimensions");
+ }
+ else
+ {
+ // General case.
+ struct_ref.make_unique ();
+ std::list<octave_value_list> idx (1);
+
+ for (octave_idx_type i = 0; i < nargin-1; i++)
+ {
+ idx.front () = args(i+1); // Save one string->octave_value conversion.
+ struct_ref = struct_ref.subsasgn (".", idx, fld_vals (i));
+
+ if (error_state)
+ break;
+ }
+ }
+ }
+ }
+ else
+ print_usage ();
+
+ return octave_value_list ();
+}
diff --git a/src/unpackfields.cc b/src/unpackfields.cc
new file mode 100644
index 0000000..123d4c9
--- /dev/null
+++ b/src/unpackfields.cc
@@ -0,0 +1,121 @@
+/*
+
+Copyright (C) 2009 VZLU Prague
+
+This file is part of OctaveForge.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 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/>.
+
+*/
+
+#include <octave/oct.h>
+#include <octave/utils.h>
+#include <octave/symtab.h>
+#include <octave/oct-map.h>
+
+DEFUN_DLD (unpackfields, args, ,
+ "-*- texinfo -*-\n\
+ at deftypefn {Loadable Function} unpackfields (struct, fld1, fld2, @dots{})\n\
+Inserts the named fields of a struct as variables into the current scope.\n\
+ at var{struct} can be a scalar structure or user class.\n\
+This is equivalent to the code:\n\
+ at example\n\
+ var1 = struct.var1;\n\
+ var2 = struct.var2;\n\
+ : \n\
+ at end example\n\
+but more efficient and more concise.\n\
+ at seealso{packfields, struct}\n\
+ at end deftypefn")
+{
+ int nargin = args.length ();
+
+ if (nargin > 0)
+ {
+ std::string struct_name = args (0).string_value ();
+ string_vector fld_names(nargin-1);
+
+ if (! error_state && ! valid_identifier (struct_name))
+ error ("unpackfields: invalid variable name: %s", struct_name.c_str ());
+
+ for (octave_idx_type i = 0; i < nargin-1; i++)
+ {
+ if (error_state)
+ break;
+
+ std::string fld_name = args(i+1).string_value ();
+
+ if (error_state)
+ break;
+
+ if (valid_identifier (fld_name))
+ fld_names(i) = fld_name;
+ else
+ error ("unpackfields: invalid field name: %s", fld_name.c_str ());
+ }
+
+ if (! error_state)
+ {
+ // Force the symbol to be inserted in caller's scope.
+ octave_value struct_val = symbol_table::varval (struct_name);
+
+ if (struct_val.is_map ())
+ {
+ // Fast code for a built-in struct.
+ const Octave_map map = struct_val.map_value ();
+
+ if (map.numel () == 1)
+ {
+ // Do the actual work.
+ for (octave_idx_type i = 0; i < nargin-1; i++)
+ {
+ Octave_map::const_iterator iter = map.seek (fld_names(i));
+ if (iter != map.end ())
+ symbol_table::varref (fld_names(i)) = map.contents (iter)(0);
+ else
+ {
+ error ("unpackfields: field %s does not exist", fld_names(i).c_str ());
+ break;
+ }
+ }
+ }
+ else
+ error ("unpackfields: structure must have singleton dimensions");
+ }
+ else if (struct_val.is_defined ())
+ {
+ // General case.
+ std::list<octave_value_list> idx (1);
+
+ for (octave_idx_type i = 0; i < nargin-1; i++)
+ {
+ idx.front () = args(i+1); // Save one string->octave_value conversion.
+ octave_value val = struct_val.subsref (".", idx);
+
+ if (error_state)
+ break;
+
+ if (val.is_defined ())
+ symbol_table::varref (fld_names (i)) = val;
+ }
+ }
+ }
+ }
+ else
+ print_usage ();
+
+ return octave_value_list ();
+}
+
--
Debian packaging for octave-general
More information about the Pkg-octave-commit
mailing list