general-2.0.0/COPYING0000644000000000000000000000004212531363075012310 0ustar 00000000000000See individual files for licenses general-2.0.0/DESCRIPTION0000644000000000000000000000043212531363075012766 0ustar 00000000000000Name: general Version: 2.0.0 Date: 2015-05-27 Author: various authors Maintainer: Octave-Forge community Title: General Description: General tools for Octave. Depends: octave (>= 4.0.0) License: GPLv3+, modified BSD, public domain Url: http://octave.sf.net general-2.0.0/INDEX0000644000000000000000000000042012531363075012047 0ustar 00000000000000general >> General purpose functions Dictionaries @dict/dict @dict/get @dict/has @dict/isempty @dict/join @dict/length @dict/struct Various Functions adresamp2 majle mark_for_deletion packfields safeprod SHA1 tablify unpackfields unresamp2 unvech ztvals general-2.0.0/NEWS0000644000000000000000000000633612531363075011770 0ustar 00000000000000Summary of important user-visible changes for general 2.0.0: ------------------------------------------------------------------- ** Package is now dependent on Octave version 4.0.0 to avoid conflicts with missing inputParser. ** The @inputParser has been removed since it is now part of Octave core and has a completely Matlab compatible syntax. There may be issues for developers who will not know what inputParser class is being used by others. A workaround can be: p = inputParser (); if (strfind (which ("inputParser"), ["@inputParser" filesep "inputParser.m"])) ## @inputParser specific code (previous general package) else ## use Octave core inputParser implementation endif ** The `cauchy' function is new on the general package. It has been moved from the optim package. Summary of important user-visible changes for general 1.3.4: ------------------------------------------------------------------- ** The dict class has been deprecated in favour of structs which now support arbitrary strings as valid fieldnames. See the help of @dict for an example. ** The following functions have been moved from the general package to the parallel package which includes them since version 2.2.0: fload pararrayfun __exit__ fsave parcellfun Summary of important user-visible changes for general 1.3.2: ------------------------------------------------------------------- ** The following functions are new: tablify Summary of important user-visible changes for general 1.3.1: ------------------------------------------------------------------- ** general 1.3.1 is a bug fix release ** The `addSwitch' method from inputParser class has been fixed ** For Matlab compatibility, optional arguments of the inputParser class will be skipped and followed by ParamValue and Switch arguments if they are a string that does not validate. Note that unlike Matlab, if no validator is given, anything is valid, so giving no validator to an Optional argument will not turn any string on the list of arguments to be considered a ParamValue key. Summary of important user-visible changes for general 1.3.0: ------------------------------------------------------------------- ** The following functions are new: majle ** The class `inputParser' class has been implemented with many methods. It attempts to be as compatible with Matlab as possible. However, since classdef is not yet implemented the syntax differs slightly. Unlike the Matlab implementation, this functions return the object. For example: obj.method (arguments) # matlab implementation obj = obj.method (arguments) # octave implementation The octave implementatino expands on the Matlab one as it has one more type of API, see `help @inputParser/addSwitch'. ** The function `unvech' accepts a new argument scale to calculate the upper triangular part of the matrix thus returning non-symmetric matrix. ** The function `parcellfun' had the random number generator modifed, a new option to set the verbosity level, and other bugs corrected. ** Package is no longer automatically loaded. general-2.0.0/inst/@dict/dict.m0000644000000000000000000001017112531363075014362 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- texinfo -*- ## @deftypefn {Function File} {} dict () ## @deftypefnx {Function File} {} dict (@var{keys}, @var{values}) ## @deftypefnx {Function File} {} dict (@var{str}) ## Creates a dictionary object with given keys and values. ## ## The class @code{dict} has been deprecated in favour of using Octave ## structs. The advantage of dict over structs was that dict allowed any ## string, not only valid Octave identifiers, as fieldnames. This has ## since change and any string is now a valid fieldname. ## ## @example ## @group ## s = struct ("7", "value7", " ", "just spaces"); ## s.("7") ## @result{} "value 7" ## s.(" ") ## @result{} just spaces ## @result{} "just spaces" ## @end group ## @end example ## ## @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 ## @group ## d = dict (keys, values); ## d(str) # result is a single value ## d(cellstr) # result is a cell array ## @end group ## @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 ## @group ## 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 group ## @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 ## Author: Jaroslav Hajek function d = dict (keys, values) persistent warned = false; if (! warned) warned = true; warning ("Octave:deprecated-function", ["`dict' has been deprecated in favor of structs which in " ... "Octave allows the use of arbitrary strings as fieldnames."]); endif 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")); general-2.0.0/inst/@dict/display.m0000644000000000000000000000255312531363075015111 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- texinfo -*- ## @deftypefn{Function File} display (d) ## Overloaded display for dictionaries. ## @end deftypefn ## Author: Jaroslav Hajek 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 general-2.0.0/inst/@dict/end.m0000644000000000000000000000147512531363075014214 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## Author: Jaroslav Hajek function end () error ("invalid use of end to index a dict"); endfunction general-2.0.0/inst/@dict/get.m0000644000000000000000000000351112531363075014216 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- 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 ## Author: Jaroslav Hajek function val = get (d, key, defv = []) if (nargin < 2 || nargin > 3) print_usage (); endif 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 general-2.0.0/inst/@dict/has.m0000644000000000000000000000240712531363075014215 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- 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 ## Author: Jaroslav Hajek function b = has (d, key) if (nargin != 2) print_usage (); endif if (ischar (key) || iscellstr (key)) b = lookup (d.keys, key, "b"); else error ("has: invalid key value"); endif endfunction general-2.0.0/inst/@dict/isempty.m0000644000000000000000000000165712531363075015142 0ustar 00000000000000## 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; if not, see . ## -*- texinfo -*- ## @deftypefn{Function File} {} isempty (d) ## Returns true if the dictionary is empty. ## @end deftypefn ## Author: Jaroslav Hajek function is = isempty (d) is = isempty (d.keys); endfunction general-2.0.0/inst/@dict/join.m0000644000000000000000000000305112531363075014375 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- 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 ## Author: Jaroslav Hajek 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 general-2.0.0/inst/@dict/length.m0000644000000000000000000000165012531363075014722 0ustar 00000000000000## 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; if not, see . ## -*- texinfo -*- ## @deftypefn{Function File} {} length (d) ## Returns the number of key/value pairs. ## @end deftypefn ## Author: Jaroslav Hajek function l = length (d) l = length (d.keys); endfunction general-2.0.0/inst/@dict/struct.m0000644000000000000000000000223312531363075014763 0ustar 00000000000000## 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; if not, see . ## -*- 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 ## Author: Jaroslav Hajek 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 general-2.0.0/inst/@dict/subsasgn.m0000644000000000000000000000700612531363075015267 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- texinfo -*- ## @deftypefn{Function File} {d =} subsasgn (d, s, val) ## Overloaded subsasgn for dictionaries. ## @end deftypefn ## Author: Jaroslav Hajek function d = subsasgn (d, s, val) if (isempty (s)) error ("dict: missing index"); endif 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 general-2.0.0/inst/@dict/subsref.m0000644000000000000000000000407512531363075015116 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- texinfo -*- ## @deftypefn{Function File} {d =} subsref (d, s) ## Overloaded subsref for dictionaries. ## @end deftypefn ## Author: Jaroslav Hajek function varargout = subsref (d, s) if (isempty (s)) error ("dict: missing index"); endif 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 general-2.0.0/inst/adresamp2.m0000644000000000000000000000525212531363075014276 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- 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 ## Author : Jaroslav Hajek 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") general-2.0.0/inst/cauchy.m0000644000000000000000000001013312531363075013666 0ustar 00000000000000## Copyright (C) 2011 Fernando Damian Nieuwveldt ## 2012 Adapted by Juan Pablo Carbajal ## ## 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, ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## -*- texinfo -*- ## @deftypefn {Function File} {} cauchy (@var{N}, @var{r}, @var{x}, @var{f} ) ## Return the Taylor coefficients and numerical differentiation of a function ## @var{f} for the first @var{N-1} coefficients or derivatives using the fft. ## @var{N} is the number of points to evaluate, ## @var{r} is the radius of convergence, needs to be chosen less then the smallest singularity, ## @var{x} is point to evaluate the Taylor expansion or differentiation. For example, ## ## If @var{x} is a scalar, the function @var{f} is evaluated in a row vector ## of length @var{N}. If @var{x} is a column vector, @var{f} is evaluated in a ## matrix of length(x)-by-N elements and must return a matrix of the same size. ## ## @example ## @group ## d = cauchy(16, 1.5, 0, @@(x) exp(x)); ## @result{} d(2) = 1.0000 # first (2-1) derivative of function f (index starts from zero) ## @end group ## @end example ## @end deftypefn function deriv = cauchy(N, r, x, f) if nargin != 4 print_usage (); end [nx m] = size (x); if m > 1 error('cauchy:InvalidArgument', 'The 3rd argument must be a column vector'); end n = 0:N-1; th = 2*pi*n/N; f_p = f (bsxfun (@plus, x, r * exp (i * th) ) ); evalfft = real(fft (f_p, [], 2)); deriv = bsxfun (@times, evalfft, 1./(N*(r.^n)).* factorial(n)) ; endfunction function g = hermite(order,x) ## N should be bigger than order+1 N = 32; r = 0.5; Hnx = @(t) exp ( bsxfun (@minus, kron(t(:).', x(:)) , t(:).'.^2/2) ); Hnxfft = cauchy(N, r, 0, Hnx); g = Hnxfft(:, order+1); endfunction %!demo %! # Cauchy integral formula: Application to Hermite polynomials %! # Author: Fernando Damian Nieuwveldt %! # Edited by: Juan Pablo Carbajal %! %! Hnx = @(t,x) exp ( bsxfun (@minus, kron(t(:).', x(:)) , t(:).'.^2/2) ); %! hermite = @(order,x) cauchy(32, 0.5, 0, @(t)Hnx(t,x))(:, order+1); %! %! t = linspace(-1,1,30); %! he2 = hermite(2,t); %! he2_ = t.^2-1; %! %! figure(1) %! clf %! plot(t,he2,'bo;Contour integral representation;', t,he2_,'r;Exact;'); %! grid %! %! % -------------------------------------------------------------------------- %! % The plots compares the approximation of the Hermite polynomial using the %! % Cauchy integral (circles) and the corresposind polynomial H_2(x) = x.^2 - 1. %! % See http://en.wikipedia.org/wiki/Hermite_polynomials#Contour_integral_representation %!demo %! # Cauchy integral formula: Application to Hermite polynomials %! # Author: Fernando Damian Nieuwveldt %! # Edited by: Juan Pablo Carbajal %! %! xx = sort (rand (100,1)); %! yy = sin (3*2*pi*xx); %! %! # Exact first derivative derivative %! diffy = 6*pi*cos (3*2*pi*xx); %! %! np = [10 15 30 100]; %! %! for i =1:4 %! idx = sort(randperm (100,np(i))); %! x = xx(idx); %! y = yy(idx); %! %! p = spline (x,y); %! yval = ppval (ppder(p),x); %! # Use the cauchy formula for computing the derivatives %! deriv = cauchy (fix (np(i)/4), .1, x, @(x) sin (3*2*pi*x)); %! %! subplot(2,2,i) %! h = plot(xx,diffy,'-b;Exact;',... %! x,yval,'-or;ppder solution;',... %! x,deriv(:,2),'-og;Cauchy formula;'); %! set(h(1),'linewidth',2); %! set(h(2:3),'markersize',3); %! %! legend(h, 'Location','Northoutside','Orientation','horizontal'); %! if i!=1 %! legend('hide'); %! end %! end %! %! % -------------------------------------------------------------------------- %! % The plots compares the derivatives calculated with Cauchy and with ppder. %! % Each subplot shows the results with increasing number of samples. general-2.0.0/inst/majle.m0000644000000000000000000001670012531363075013510 0ustar 00000000000000## Copyright (c) 2010 Andrew V. Knyazev ## Copyright (c) 2010 Merico .E. Argentati ## All rights reserved. ## ## Redistribution and use in source and binary forms, with or without ## modification, are permitted provided that the following conditions are met: ## ## 1 Redistributions of source code must retain the above copyright notice, ## this list of conditions and the following disclaimer. ## 2 Redistributions in binary form must reproduce the above copyright ## notice, this list of conditions and the following disclaimer in the ## documentation and/or other materials provided with the distribution. ## 3 Neither the name of the author nor the names of its contributors may be ## used to endorse or promote products derived from this software without ## specific prior written permission. ## ## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ''AS IS'' ## AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ## IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ## ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ## ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ## DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR ## SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER ## CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE ## OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. %MAJLE (Weak) Majorization check % S = MAJLE(X,Y) checks if the real part of X is (weakly) majorized by % the real part of Y, where X and Y must be numeric (full or sparse) % arrays. It returns S=0, if there is no weak majorization of X by Y, % S=1, if there is a weak majorization of X by Y, or S=2, if there is a % strong majorization of X by Y. The shapes of X and Y are ignored. % NUMEL(X) and NUMEL(Y) may be different, in which case one of them is % appended with zeros to match the sizes with the other and, in case of % any negative components, a special warning is issued. % % S = MAJLE(X,Y,MAJLETOL) allows in addition to specify the tolerance in % all inequalities [S,Z] = MAJLE(X,Y,MAJLETOL) also outputs a row vector % Z, which appears in the definition of the (weak) majorization. In the % traditional case, where the real vectors X and Y are of the same size, % Z = CUMSUM(SORT(Y,'descend')-SORT(X,'descend')). Here, X is weakly % majorized by Y, if MIN(Z)>0, and strongly majorized if MIN(Z)=0, see % http://en.wikipedia.org/wiki/Majorization % % The value of MAJLETOL depends on how X and Y have been computed, i.e., % on what the level of error in X or Y is. A good minimal starting point % should be MAJLETOL=eps*MAX(NUMEL(X),NUMEL(Y)). The default is 0. % % % Examples: % x = [2 2 2]; y = [1 2 3]; s = majle(x,y) % % returns the value 2. % x = [2 2 2]; y = [1 2 4]; s = majle(x,y) % % returns the value 1. % x = [2 2 2]; y = [1 2 2]; s = majle(x,y) % % returns the value 0. % x = [2 2 2]; y = [1 2 2]; [s,z] = majle(x,y) % % also returns the vector z = [ 0 0 -1]. % x = [2 2 2]; y = [1 2 2]; s = majle(x,y,1) % % returns the value 2. % x = [2 2]; y = [1 2 2]; s = majle(x,y) % % returns the value 1 and warns on tailing with zeros % x = [2 2]; y = [-1 2 2]; s = majle(x,y) % % returns the value 0 and gives two warnings on tailing with zeros % x = [2 -inf]; y = [4 inf]; [s,z] = majle(x,y) % % returns s = 1 and z = [Inf Inf]. % x = [2 inf]; y = [4 inf]; [s,z] = majle(x,y) % % returns s = 1 and z = [NaN NaN] and a warning on NaNs in z. % x=speye(2); y=sparse([0 2; -1 1]); s = majle(x,y) % % returns the value 2. % x = [2 2; 2 2]; y = [1 3 4]; [s,z] = majle(x,y) %and % x = [2 2; 2 2]+i; y = [1 3 4]-2*i; [s,z] = majle(x,y) % % both return s = 2 and z = [2 3 2 0]. % x = [1 1 1 1 0]; y = [1 1 1 1 1 0 0]'; s = majle(x,y) % % returns the value 1 and warns on tailing with zeros % % % One can use this function to check numerically the validity of the % Schur-Horn,Lidskii-Mirsky-Wielandt, and Gelfand-Naimark theorems: % clear all; n=100; majleTol=n*n*eps; % A = randn(n,n); A = A'+A; eA = -sort(-eig(A)); dA = diag(A); % majle(dA,eA,majleTol) % returns the value 2 % % which is the Schur-Horn theorem; and % B=randn(n,n); B=B'+B; eB=-sort(-eig(B)); % eAmB=-sort(-eig(A-B)); % majle(eA-eB,eAmB,majleTol) % returns the value 2 % % which is the Lidskii-Mirsky-Wielandt theorem; finally % A = randn(n,n); sA = -sort(-svd(A)); % B = randn(n,n); sB = -sort(-svd(B)); % sAB = -sort(-svd(A*B)); % majle(log2(sAB)-log2(sA), log2(sB), majleTol) % retuns the value 2 % majle(log2(sAB)-log2(sB), log2(sA), majleTol) % retuns the value 2 % % which are the log versions of the Gelfand-Naimark theorems % Tested in MATLAB 7.9.0.529 (R2009b) and Octave 3.2.3. function [s,z]=majle(x,y,majleTol) if (nargin < 2) error('MAJORIZATION:majle:NotEnoughInputs',... 'Not enough input arguments.'); end if (nargin > 3) error('MAJORIZATION:majle:TooManyInputs',... 'Too many input arguments.'); end if (nargout > 2) error('MAJORIZATION:majle:TooManyOutputs',... 'Too many output arguments.'); end % Assign default values to unspecified parameters if (nargin == 2) majleTol = 0; end % transform into real (row) vectors x=real(x); xc=reshape(x,1,numel(x)); clear x; y=real(y); yc=reshape(y,1,numel(y)); clear y; % sort both vectors in descending order xc=-sort(-xc); yc=-sort(-yc); % tail with zeros the shorter vector to make vectors of the same length if size(xc,2)~=size(yc,2) checkForNegative = (xc(end) < -majleTol) || (yc(end) < -majleTol); warning('MAJORIZATION:majle:ResizeVectors', ... 'The input vectors have different sizes. Tailing with zeros.'); yc=[yc zeros(size(xc,2)-size(yc,2),1)']; xc=[xc zeros(size(yc,2)-size(xc,2),1)']; % but warn if negative if checkForNegative warning('MAJORIZATION:majle:ResizeNegativeVectors', ... sprintf('%s%s\n%s\n%s', ... 'At least one of the input vectors ',... 'has negative components.',... ' Tailing with zeros is most likely senseless.',... ' Make sure that you know what you are doing.')); % sort again both vectors in descending order xc=-sort(-xc); yc=-sort(-yc); end end z=cumsum(yc-xc); %check for NaNs in z if any(isnan(z)) warning('MAJORIZATION:majle:NaNsInComparisons', ... sprintf('%s%s\n%s\n%s', ... 'At least one of the input vectors ',... 'includes -Inf, Inf, or NaN components.',... ' Some comparisons could not be made. ',... ' Make sure that you know what you are doing.')); end if min(z) < -majleTol s=0; % no majorization elseif abs(z(end)) <= majleTol s=2; % strong majorization else s=1; % weak majorization end endfunction general-2.0.0/inst/safeprod.m0000644000000000000000000000352612531363075014225 0ustar 00000000000000## 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 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, see . ## -*- 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 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 general-2.0.0/inst/tablify.m0000644000000000000000000000731112531363075014050 0ustar 00000000000000## Copyright (C) 2012 Robert T. Short ## ## This 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 software is distributed in the hope that it will be useful, but ## WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ## General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with Octave; see the file COPYING. If not, see ## . ## -*- texinfo -*- ## @deftypefn {Function File} {[@var{y1}, @dots{}] =} tablify (@var{x1}, @dots{}) ## ## @noindent ## Create a table out of the input arguments, if possible. The table is ## created by extending row and column vectors to like dimensions. If ## the dimensions of input vectors are not commensurate an error will ## occur. Dimensions are commensurate if they have the same number of ## rows and columns, a single row and the same number of columns, or the ## same number of rows and a single column. In other words, vectors ## will only be extended along singleton dimensions. ## ## @noindent ## For example: ## ## @example ## @group ## [a, b] = tablify ([1 2; 3 4], 5) ## @result{} a = [ 1, 2; 3, 4 ] ## @result{} b = [ 5, 5; 5, 5 ] ## @end group ## @end example ## @example ## @group ## [a, b, c] = tablify (1, [1 2 3 4], [5;6;7]) ## @result{} ## b = [ 1 1 1 1; 1 1 1 1; 1 1 1 1] ## @result{} b = [ 1 2 3 4; 1 2 3 4; 1 2 3 4] ## @result{} c = [ 5 5 5 5; 6 6 6 6; 7 7 7 7 ] ## @end group ## @end example ## ## @noindent ## The following example attempts to expand vectors that do not have ## commensurate dimensions and will produce an error. ## ## @example ## @group ## tablify([1 2],[3 4 5]) ## @end group ## @end example ## ## @noindent ## Note that use of array operations and broadcasting is more efficient ## for many situations. ## ## @seealso {common_size} ## ## @end deftypefn ## Author: Robert T. Short ## Created: 3/6/2012 function [varargout] = tablify (varargin) if (nargin < 2) varargout = varargin; return; endif empty = cellfun (@isempty, varargin); nrows = cellfun (@rows, varargin(~empty)); ridx = nrows>1; if (any(ridx)) rdim = nrows(ridx)(1); else rdim = 1; endif ncols = cellfun (@columns, varargin(~empty)); cidx = ncols>1; if (any(cidx)) cdim = ncols(cidx)(1); else cdim = 1; endif if ( any(nrows(ridx) != rdim ) || any(ncols(cidx) != cdim )) error('tablify: incommensurate sizes'); endif varargout = varargin; varargout(~ridx) = cellindexmat(varargout(~ridx),ones(rdim,1),':'); varargout(~cidx) = cellindexmat(varargout(~cidx),':',ones(1,cdim)); endfunction %!error tablify([1,2],[3,4,5]) %!error tablify([1;2],[3;4;5]) %!test %! a = 1; b = 1; c = 1; %! assert(tablify(a),a); %! [x,y,z]=tablify(a,b,c); %! assert(x,a); %! assert(y,b); %! assert(z,c); %!test %! a = 1; b = [1 2 3]; %! [x,y]=tablify(a,b); %! assert(x,[1 1 1]); %! assert(y,[1 2 3]); %!test %! a = 1; b = [1;2;3]; %! [x,y]=tablify(a,b); %! assert(x,[1;1;1]); %! assert(y,[1;2;3]); %!test %! a = [1 2]; b = [1;2;3]; c=1; %! [x,y,z]=tablify(a,b,c); %! assert(x,[1 2; 1 2; 1 2]); %! assert(y,[1 1; 2 2; 3 3]); %! assert(z,[1 1; 1 1; 1 1]); %!test %! a = [1 2]; b = [1;2;3]; c=[2 3]; %! [x,y,z]=tablify(a,b,c); %! assert(x,[1 2; 1 2; 1 2]); %! assert(y,[1 1; 2 2; 3 3]); %! assert(z,[2 3; 2 3; 2 3]); %!test %! a = [1 2]; b = [1;2;3]; c=[]; %! [x,y,z]=tablify(a,b,c); %! assert(x,[1 2; 1 2; 1 2]); %! assert(y,[1 1; 2 2; 3 3]); %! assert(z,[]); general-2.0.0/inst/unresamp2.m0000644000000000000000000000403312531363075014330 0ustar 00000000000000## Copyright (C) 2009 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; if not, see . ## -*- 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 ## Author: Jaroslav Hajek 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") general-2.0.0/inst/unvech.m0000644000000000000000000000522612531363075013711 0ustar 00000000000000## Copyright (C) 2006 Michael Creel ## Copyright (C) 2009 Jaroslav Hajek ## Copyright (C) 2011 Juan Pablo Carbajal ## Copyright (C) 2011 Carnë Draug ## ## 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, see . ## -*- texinfo -*- ## @deftypefn {Function File} {@var{m} =} unvech (@var{v}, @var{scale}) ## Performs the reverse of @code{vech} on the vector @var{v}. ## ## Given a Nx1 array @var{v} describing the lower triangular part of a ## matrix (as obtained from @code{vech}), it returns the full matrix. ## ## The upper triangular part of the matrix will be multiplied by @var{scale} such ## that 1 and -1 can be used for symmetric and antisymmetric matrix respectively. ## @var{scale} must be a scalar and defaults to 1. ## ## @seealso{vech, ind2sub} ## @end deftypefn ## TODO remove subfunction ind2sub_tril after new release of octave that will have ## it builtin standard ind2sub function M = unvech (v, scale = 1) if ( nargin < 1 || nargin > 2 ) print_usage; elseif ( !ismatrix (v) && any (size (v) != 1) ) error ("V must be a row or column matrix") elseif ( !isnumeric (scale) || !isscalar (scale) ) error ("SCALE must be a scalar") endif N = length (v); dim = (sqrt ( 1 + 8*N ) - 1)/2; if fix(dim) != dim error ("Octave:invalid-input-arg", "the length of the vector cannot form a square matrix.\n"); endif [r, c] = ind2sub_tril (dim, 1:N); # replace with core ind2sub after octave 3.6 M = accumarray ([r; c].', v); M += scale * tril (M, -1).'; endfunction function [r c] = ind2sub_tril(N,idx) endofrow = 0.5*(1:N) .* (2*N:-1:N + 1); c = lookup(endofrow, idx-1)+1; r = N - endofrow(c) + idx ; endfunction %!assert(unvech([1;0;0;1;0;1]), full(eye(3,3)) ); %!test %symmetric %! dim = 10; %! A = tril( floor ( 5*(2*rand(dim)-1) ) ); %! A += A.'; %! M = vech(A); %! M = unvech(M, 1); %! assert (A, M); %!test %antisymmetric %! dim = 10; %! A = tril( floor ( 5*(2*rand(dim)-1) ) ); %! A -= A.'; %! M = vech(A); %! M = unvech(M, -1); %! assert (A, M); general-2.0.0/inst/ztvals.m0000644000000000000000000000263412531363075013744 0ustar 00000000000000## 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 ## this program; if not, see . ## -*- 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 general-2.0.0/src/Makefile0000644000000000000000000000027712531363075013516 0ustar 00000000000000ifndef MKOCTFILE MKOCTFILE := mkoctfile -Wall endif PROGS = $(patsubst %.cc,%.oct,$(wildcard *.cc)) all: $(PROGS) %.oct: %.cc $(MKOCTFILE) $< clean: rm -f *.o octave-core core *.oct *~ general-2.0.0/src/SHA1.cc0000644000000000000000000002166512531363075013065 0ustar 00000000000000// Copyright (C) 1999 Andy Adler // // 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, see . // Note that part of the code below is on the public domain. That part will // marked as such. #include /* * 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 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 } general-2.0.0/src/mark_for_deletion.cc0000644000000000000000000000234412531363075016045 0ustar 00000000000000// Copyright (C) 2002 Andy Adler // // 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, see . #include #include 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; } general-2.0.0/src/packfields.cc0000644000000000000000000001006012531363075014461 0ustar 00000000000000// Copyright (C) 2009 VZLU Prague // // 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, see . #include #include #include #include DEFUN_DLD (packfields, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} packfields (@var{s_name}, @var{var1}, @var{var2}, @dots{})\n\ Create struct from variables.\n\ \n\ Inserts the named variables @var{var1}, @var{var2}, @dots{} as fields into\n\ the struct named @var{s_name}. If it does not exist, a struct with that name\n\ is created.\n\ \n\ This is equivalent to the code:\n\ @example\n\ @group\n\ s_name.var1 = var1;\n\ s_name.var2 = var2;\n\ : \n\ @end group\n\ @end example\n\ but more efficient and more concise.\n\ \n\ @seealso{setfield, setfields, struct, unpackfields}\n\ @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); 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_scalar_map (); if (struct_ref.is_map ()) { // Fast code for a built-in struct. octave_scalar_map map = struct_ref.scalar_map_value (); if (! error_state) { // 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 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 (); } /* %!test %! foo = "hello"; %! bar = 42; %! packfields ("s", "foo", "bar"); %! assert (s, struct ("foo", "hello", "bar", 42)); */ general-2.0.0/src/unpackfields.cc0000644000000000000000000001014012531363075015023 0ustar 00000000000000// Copyright (C) 2009 VZLU Prague // // 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, see . #include #include #include #include DEFUN_DLD (unpackfields, args, , "-*- texinfo -*-\n\ @deftypefn {Loadable Function} {} unpackfields (@var{s_name}, @var{fld1}, @var{fld2}, @dots{})\n\ Create variables from fields of a struct.\n\ \n\ Inserts the named fields @var{fld1}, @var{fld2}, @dots{}, from the struct\n\ named @var{s_name}, into the current scope. Noe that @var{s_name} is the\n\ name of the struct in the current scope, not the struct itself.\n\ \n\ @example\n\ @group\n\ unpackfields (\"struct\", \"var1\", \"var2\")\n\ @end group\n\ @end example\n\ \n\ is equivalent to the code:\n\ @example\n\ @group\n\ var1 = struct.var1;\n\ var2 = struct.var2;\n\ : \n\ @end group\n\ @end example\n\ but more efficient and more concise.\n\ \n\ @seealso{getfield, getfields, packfields, struct}\n\ @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_scalar_map map = struct_val.scalar_map_value (); if (! error_state) { // Do the actual work. for (octave_idx_type i = 0; i < nargin-1; i++) { octave_scalar_map::const_iterator iter = map.seek (fld_names(i)); if (iter != map.end ()) symbol_table::assign (fld_names(i), map.contents (iter)); 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 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::assign (fld_names(i), val); } } } } else print_usage (); return octave_value_list (); } /* %!test %! s.foo = "hello"; %! s.bar = 42; %! unpackfields ("s", "foo", "bar"); %! assert (foo, "hello"); %! assert (bar, 42); */