From 1c0469ada9531828709108a4882a751d2816994a Mon Sep 17 00:00:00 2001 From: Loriane Weber Date: Tue, 3 May 2016 10:40:11 +0200 Subject: [PATCH] update packages --- octave_packages/m/@ftp/ascii.m | 27 + octave_packages/m/@ftp/binary.m | 27 + octave_packages/m/@ftp/cd.m | 27 + octave_packages/m/@ftp/close.m | 27 + octave_packages/m/@ftp/delete.m | 27 + octave_packages/m/@ftp/dir.m | 31 + octave_packages/m/@ftp/display.m | 25 + octave_packages/m/@ftp/ftp.m | 45 + octave_packages/m/@ftp/loadobj.m | 36 + octave_packages/m/@ftp/mget.m | 37 + octave_packages/m/@ftp/mkdir.m | 27 + octave_packages/m/@ftp/mput.m | 35 + octave_packages/m/@ftp/rename.m | 28 + octave_packages/m/@ftp/rmdir.m | 27 + octave_packages/m/@ftp/saveobj.m | 23 + octave_packages/m/audio/lin2mu.m | 76 + octave_packages/m/audio/loadaudio.m | 81 + octave_packages/m/audio/mu2lin.m | 82 + octave_packages/m/audio/playaudio.m | 88 + octave_packages/m/audio/record.m | 65 + octave_packages/m/audio/saveaudio.m | 88 + octave_packages/m/audio/setaudio.m | 43 + octave_packages/m/audio/wavread.m | 249 ++ octave_packages/m/audio/wavwrite.m | 183 ++ octave_packages/m/deprecated/__error_text__.m | 36 + octave_packages/m/deprecated/autocor.m | 59 + octave_packages/m/deprecated/autocov.m | 62 + octave_packages/m/deprecated/betai.m | 47 + octave_packages/m/deprecated/cellidx.m | 108 + octave_packages/m/deprecated/clg.m | 40 + octave_packages/m/deprecated/cor.m | 54 + octave_packages/m/deprecated/corrcoef.m | 119 + octave_packages/m/deprecated/cquad.m | 39 + octave_packages/m/deprecated/cut.m | 71 + octave_packages/m/deprecated/dispatch.m | 103 + octave_packages/m/deprecated/error_text.m | 36 + octave_packages/m/deprecated/fstat.m | 35 + octave_packages/m/deprecated/gammai.m | 47 + octave_packages/m/deprecated/glpkmex.m | 117 + octave_packages/m/deprecated/intwarning.m | 133 + .../m/deprecated/is_duplicate_entry.m | 53 + octave_packages/m/deprecated/is_global.m | 37 + octave_packages/m/deprecated/isstr.m | 40 + octave_packages/m/deprecated/krylovb.m | 46 + octave_packages/m/deprecated/perror.m | 45 + octave_packages/m/deprecated/polyderiv.m | 108 + octave_packages/m/deprecated/replot.m | 43 + octave_packages/m/deprecated/saveimage.m | 314 ++ octave_packages/m/deprecated/setstr.m | 40 + octave_packages/m/deprecated/shell_cmd.m | 68 + octave_packages/m/deprecated/strerror.m | 72 + octave_packages/m/deprecated/studentize.m | 94 + .../m/deprecated/sylvester_matrix.m | 69 + octave_packages/m/deprecated/values.m | 61 + octave_packages/m/deprecated/weibcdf.m | 47 + octave_packages/m/deprecated/weibinv.m | 40 + octave_packages/m/deprecated/weibpdf.m | 47 + octave_packages/m/deprecated/weibrnd.m | 46 + octave_packages/m/elfun/acosd.m | 36 + octave_packages/m/elfun/acot.m | 47 + octave_packages/m/elfun/acotd.m | 36 + octave_packages/m/elfun/acoth.m | 47 + octave_packages/m/elfun/acsc.m | 47 + octave_packages/m/elfun/acscd.m | 36 + octave_packages/m/elfun/acsch.m | 45 + octave_packages/m/elfun/asec.m | 46 + octave_packages/m/elfun/asecd.m | 36 + octave_packages/m/elfun/asech.m | 45 + octave_packages/m/elfun/asind.m | 36 + octave_packages/m/elfun/atand.m | 36 + octave_packages/m/elfun/cosd.m | 42 + octave_packages/m/elfun/cot.m | 47 + octave_packages/m/elfun/cotd.m | 38 + octave_packages/m/elfun/coth.m | 45 + octave_packages/m/elfun/csc.m | 47 + octave_packages/m/elfun/cscd.m | 39 + octave_packages/m/elfun/csch.m | 45 + octave_packages/m/elfun/sec.m | 47 + octave_packages/m/elfun/secd.m | 38 + octave_packages/m/elfun/sech.m | 45 + octave_packages/m/elfun/sind.m | 41 + octave_packages/m/elfun/tand.m | 44 + octave_packages/m/general/accumarray.m | 408 +++ octave_packages/m/general/accumdim.m | 158 + octave_packages/m/general/bicubic.m | 208 ++ octave_packages/m/general/bitcmp.m | 123 + octave_packages/m/general/bitget.m | 109 + octave_packages/m/general/bitset.m | 122 + octave_packages/m/general/blkdiag.m | 81 + octave_packages/m/general/cart2pol.m | 143 + octave_packages/m/general/cart2sph.m | 113 + octave_packages/m/general/cell2mat.m | 104 + octave_packages/m/general/celldisp.m | 87 + octave_packages/m/general/chop.m | 80 + octave_packages/m/general/circshift.m | 104 + octave_packages/m/general/colon.m | 44 + octave_packages/m/general/common_size.m | 90 + octave_packages/m/general/cplxpair.m | 164 + octave_packages/m/general/cumtrapz.m | 134 + octave_packages/m/general/curl.m | 142 + octave_packages/m/general/dblquad.m | 82 + octave_packages/m/general/deal.m | 83 + octave_packages/m/general/del2.m | 159 + octave_packages/m/general/display.m | 50 + octave_packages/m/general/divergence.m | 112 + octave_packages/m/general/flipdim.m | 67 + octave_packages/m/general/fliplr.m | 62 + octave_packages/m/general/flipud.m | 62 + octave_packages/m/general/genvarname.m | 208 ++ octave_packages/m/general/gradient.m | 304 ++ octave_packages/m/general/idivide.m | 124 + octave_packages/m/general/int2str.m | 122 + octave_packages/m/general/interp1.m | 566 ++++ octave_packages/m/general/interp1q.m | 70 + octave_packages/m/general/interp2.m | 610 ++++ octave_packages/m/general/interp3.m | 166 ++ octave_packages/m/general/interpft.m | 116 + octave_packages/m/general/interpn.m | 314 ++ octave_packages/m/general/isa.m | 96 + octave_packages/m/general/iscolumn.m | 56 + octave_packages/m/general/isdir.m | 39 + octave_packages/m/general/isequal.m | 74 + .../m/general/isequalwithequalnans.m | 44 + octave_packages/m/general/isrow.m | 56 + octave_packages/m/general/isscalar.m | 54 + octave_packages/m/general/issquare.m | 62 + octave_packages/m/general/isvector.m | 57 + octave_packages/m/general/loadobj.m | 41 + octave_packages/m/general/logspace.m | 99 + octave_packages/m/general/nargchk.m | 80 + octave_packages/m/general/narginchk.m | 69 + octave_packages/m/general/nargoutchk.m | 124 + octave_packages/m/general/nextpow2.m | 68 + octave_packages/m/general/nthargout.m | 113 + octave_packages/m/general/num2str.m | 186 ++ octave_packages/m/general/pol2cart.m | 142 + octave_packages/m/general/polyarea.m | 70 + octave_packages/m/general/postpad.m | 97 + octave_packages/m/general/prepad.m | 99 + .../m/general/private/__isequal__.m | 182 ++ .../m/general/private/__splinen__.m | 49 + octave_packages/m/general/profexplore.m | 132 + octave_packages/m/general/profile.m | 151 + octave_packages/m/general/profshow.m | 100 + octave_packages/m/general/quadgk.m | 461 +++ octave_packages/m/general/quadl.m | 217 ++ octave_packages/m/general/quadv.m | 161 + octave_packages/m/general/randi.m | 141 + octave_packages/m/general/rat.m | 160 + octave_packages/m/general/repmat.m | 162 + octave_packages/m/general/rot90.m | 102 + octave_packages/m/general/rotdim.m | 158 + octave_packages/m/general/saveobj.m | 44 + octave_packages/m/general/shift.m | 99 + octave_packages/m/general/shiftdim.m | 100 + octave_packages/m/general/sortrows.m | 137 + octave_packages/m/general/sph2cart.m | 114 + octave_packages/m/general/structfun.m | 146 + octave_packages/m/general/subsindex.m | 65 + octave_packages/m/general/trapz.m | 138 + octave_packages/m/general/triplequad.m | 85 + octave_packages/m/geometry/convhull.m | 100 + octave_packages/m/geometry/delaunay.m | 119 + octave_packages/m/geometry/delaunay3.m | 77 + octave_packages/m/geometry/delaunayn.m | 93 + octave_packages/m/geometry/dsearch.m | 40 + octave_packages/m/geometry/dsearchn.m | 57 + octave_packages/m/geometry/griddata.m | 177 ++ octave_packages/m/geometry/griddata3.m | 84 + octave_packages/m/geometry/griddatan.m | 106 + octave_packages/m/geometry/inpolygon.m | 143 + octave_packages/m/geometry/rectint.m | 131 + octave_packages/m/geometry/tsearchn.m | 107 + octave_packages/m/geometry/voronoi.m | 187 ++ octave_packages/m/geometry/voronoin.m | 67 + octave_packages/m/help/__makeinfo__.m | 150 + octave_packages/m/help/doc.m | 111 + octave_packages/m/help/gen_doc_cache.m | 151 + .../m/help/get_first_help_sentence.m | 165 + octave_packages/m/help/help.m | 185 ++ octave_packages/m/help/lookfor.m | 191 ++ octave_packages/m/help/print_usage.m | 142 + .../private/__additional_help_message__.m | 39 + .../m/help/private/__strip_html_tags__.m | 81 + octave_packages/m/help/type.m | 124 + octave_packages/m/help/unimplemented.m | 435 +++ octave_packages/m/help/which.m | 65 + octave_packages/m/image/autumn.m | 61 + octave_packages/m/image/bone.m | 64 + octave_packages/m/image/brighten.m | 76 + octave_packages/m/image/colormap.m | 74 + octave_packages/m/image/contrast.m | 50 + octave_packages/m/image/cool.m | 60 + octave_packages/m/image/copper.m | 62 + octave_packages/m/image/flag.m | 59 + octave_packages/m/image/gmap40.m | 57 + octave_packages/m/image/gray.m | 55 + octave_packages/m/image/gray2ind.m | 61 + octave_packages/m/image/hot.m | 62 + octave_packages/m/image/hsv.m | 63 + octave_packages/m/image/hsv2rgb.m | 87 + octave_packages/m/image/image.m | 238 ++ octave_packages/m/image/imagesc.m | 121 + octave_packages/m/image/imfinfo.m | 157 + octave_packages/m/image/imread.m | 117 + octave_packages/m/image/imshow.m | 210 ++ octave_packages/m/image/imwrite.m | 200 ++ octave_packages/m/image/ind2gray.m | 49 + octave_packages/m/image/ind2rgb.m | 72 + octave_packages/m/image/jet.m | 65 + octave_packages/m/image/ntsc2rgb.m | 67 + octave_packages/m/image/ocean.m | 65 + octave_packages/m/image/pink.m | 65 + octave_packages/m/image/prism.m | 58 + octave_packages/m/image/rainbow.m | 67 + octave_packages/m/image/rgb2hsv.m | 102 + octave_packages/m/image/rgb2ind.m | 65 + octave_packages/m/image/rgb2ntsc.m | 67 + octave_packages/m/image/spring.m | 60 + octave_packages/m/image/summer.m | 61 + octave_packages/m/image/white.m | 55 + octave_packages/m/image/winter.m | 61 + octave_packages/m/io/beep.m | 38 + octave_packages/m/io/csvread.m | 41 + octave_packages/m/io/csvwrite.m | 54 + octave_packages/m/io/dlmwrite.m | 212 ++ octave_packages/m/io/fileread.m | 63 + octave_packages/m/io/is_valid_file_id.m | 46 + octave_packages/m/io/strread.m | 889 ++++++ octave_packages/m/io/textread.m | 148 + octave_packages/m/io/textscan.m | 332 +++ .../m/linear-algebra/commutation_matrix.m | 119 + octave_packages/m/linear-algebra/cond.m | 93 + octave_packages/m/linear-algebra/condest.m | 238 ++ octave_packages/m/linear-algebra/cross.m | 115 + .../m/linear-algebra/duplication_matrix.m | 120 + octave_packages/m/linear-algebra/expm.m | 154 + octave_packages/m/linear-algebra/housh.m | 133 + octave_packages/m/linear-algebra/isdefinite.m | 87 + .../m/linear-algebra/ishermitian.m | 67 + .../m/linear-algebra/issymmetric.m | 66 + octave_packages/m/linear-algebra/krylov.m | 246 ++ octave_packages/m/linear-algebra/logm.m | 171 ++ octave_packages/m/linear-algebra/normest.m | 93 + octave_packages/m/linear-algebra/null.m | 111 + octave_packages/m/linear-algebra/onenormest.m | 290 ++ octave_packages/m/linear-algebra/orth.m | 90 + octave_packages/m/linear-algebra/planerot.m | 47 + octave_packages/m/linear-algebra/qzhess.m | 141 + octave_packages/m/linear-algebra/rank.m | 111 + octave_packages/m/linear-algebra/rref.m | 128 + octave_packages/m/linear-algebra/subspace.m | 61 + octave_packages/m/linear-algebra/trace.m | 52 + octave_packages/m/linear-algebra/vech.m | 58 + octave_packages/m/miscellaneous/ans.m | 34 + octave_packages/m/miscellaneous/bincoeff.m | 120 + octave_packages/m/miscellaneous/bug_report.m | 48 + octave_packages/m/miscellaneous/bunzip2.m | 42 + octave_packages/m/miscellaneous/bzip2.m | 61 + octave_packages/m/miscellaneous/cast.m | 45 + octave_packages/m/miscellaneous/comma.m | 27 + .../m/miscellaneous/compare_versions.m | 253 ++ octave_packages/m/miscellaneous/computer.m | 91 + octave_packages/m/miscellaneous/copyfile.m | 130 + octave_packages/m/miscellaneous/debug.m | 93 + octave_packages/m/miscellaneous/delete.m | 63 + octave_packages/m/miscellaneous/dir.m | 142 + octave_packages/m/miscellaneous/dos.m | 71 + octave_packages/m/miscellaneous/dump_prefs.m | 98 + octave_packages/m/miscellaneous/edit.m | 540 ++++ octave_packages/m/miscellaneous/fact.m | 269 ++ octave_packages/m/miscellaneous/fileattrib.m | 144 + octave_packages/m/miscellaneous/fileparts.m | 96 + octave_packages/m/miscellaneous/fullfile.m | 80 + octave_packages/m/miscellaneous/getappdata.m | 59 + octave_packages/m/miscellaneous/getfield.m | 68 + octave_packages/m/miscellaneous/gunzip.m | 43 + octave_packages/m/miscellaneous/gzip.m | 72 + octave_packages/m/miscellaneous/info.m | 48 + octave_packages/m/miscellaneous/inputname.m | 56 + octave_packages/m/miscellaneous/isappdata.m | 48 + octave_packages/m/miscellaneous/isdeployed.m | 31 + octave_packages/m/miscellaneous/ismac.m | 36 + octave_packages/m/miscellaneous/ispc.m | 36 + octave_packages/m/miscellaneous/isunix.m | 36 + octave_packages/m/miscellaneous/license.m | 187 ++ octave_packages/m/miscellaneous/list_primes.m | 91 + octave_packages/m/miscellaneous/ls.m | 94 + octave_packages/m/miscellaneous/ls_command.m | 67 + octave_packages/m/miscellaneous/menu.m | 70 + octave_packages/m/miscellaneous/mex.m | 29 + octave_packages/m/miscellaneous/mexext.m | 29 + octave_packages/m/miscellaneous/mkoctfile.m | 169 ++ octave_packages/m/miscellaneous/movefile.m | 128 + .../m/miscellaneous/namelengthmax.m | 34 + octave_packages/m/miscellaneous/news.m | 63 + octave_packages/m/miscellaneous/orderfields.m | 195 ++ octave_packages/m/miscellaneous/pack.m | 29 + octave_packages/m/miscellaneous/paren.m | 27 + octave_packages/m/miscellaneous/parseparams.m | 107 + octave_packages/m/miscellaneous/perl.m | 44 + .../m/miscellaneous/private/__xzip__.m | 138 + octave_packages/m/miscellaneous/python.m | 47 + octave_packages/m/miscellaneous/recycle.m | 66 + octave_packages/m/miscellaneous/rmappdata.m | 44 + octave_packages/m/miscellaneous/run.m | 61 + octave_packages/m/miscellaneous/semicolon.m | 27 + octave_packages/m/miscellaneous/setappdata.m | 59 + octave_packages/m/miscellaneous/setfield.m | 71 + octave_packages/m/miscellaneous/substruct.m | 89 + octave_packages/m/miscellaneous/swapbytes.m | 64 + octave_packages/m/miscellaneous/symvar.m | 33 + octave_packages/m/miscellaneous/tar.m | 66 + octave_packages/m/miscellaneous/tempdir.m | 55 + octave_packages/m/miscellaneous/tempname.m | 35 + octave_packages/m/miscellaneous/unix.m | 70 + octave_packages/m/miscellaneous/unpack.m | 275 ++ octave_packages/m/miscellaneous/untar.m | 43 + octave_packages/m/miscellaneous/unzip.m | 43 + octave_packages/m/miscellaneous/usejava.m | 67 + octave_packages/m/miscellaneous/ver.m | 128 + octave_packages/m/miscellaneous/version.m | 43 + octave_packages/m/miscellaneous/warning_ids.m | 324 ++ octave_packages/m/miscellaneous/what.m | 110 + octave_packages/m/miscellaneous/xor.m | 71 + octave_packages/m/miscellaneous/zip.m | 68 + octave_packages/m/optimization/PKG_ADD | 14 + octave_packages/m/optimization/__all_opts__.m | 73 + octave_packages/m/optimization/fminbnd.m | 213 ++ octave_packages/m/optimization/fminunc.m | 416 +++ octave_packages/m/optimization/fsolve.m | 610 ++++ octave_packages/m/optimization/fzero.m | 363 +++ octave_packages/m/optimization/glpk.m | 597 ++++ octave_packages/m/optimization/lsqnonneg.m | 211 ++ octave_packages/m/optimization/optimget.m | 52 + octave_packages/m/optimization/optimset.m | 148 + octave_packages/m/optimization/pqpnonneg.m | 211 ++ .../m/optimization/private/__fdjac__.m | 48 + octave_packages/m/optimization/qp.m | 407 +++ octave_packages/m/optimization/sqp.m | 781 +++++ octave_packages/m/path/matlabroot.m | 35 + octave_packages/m/path/pathdef.m | 136 + octave_packages/m/path/savepath.m | 214 ++ octave_packages/m/pkg/pkg.m | 2443 +++++++++++++++ octave_packages/m/pkg/private/get_forge_pkg.m | 81 + octave_packages/m/plot/__gnuplot_drawnow__.m | 392 +++ octave_packages/m/plot/__plt_get_axis_arg__.m | 82 + octave_packages/m/plot/allchild.m | 57 + octave_packages/m/plot/ancestor.m | 86 + octave_packages/m/plot/area.m | 208 ++ octave_packages/m/plot/axes.m | 62 + octave_packages/m/plot/axis.m | 580 ++++ octave_packages/m/plot/bar.m | 99 + octave_packages/m/plot/barh.m | 58 + octave_packages/m/plot/box.m | 61 + octave_packages/m/plot/caxis.m | 88 + octave_packages/m/plot/cla.m | 102 + octave_packages/m/plot/clabel.m | 142 + octave_packages/m/plot/clf.m | 105 + octave_packages/m/plot/close.m | 93 + octave_packages/m/plot/closereq.m | 43 + octave_packages/m/plot/colorbar.m | 613 ++++ octave_packages/m/plot/colstyle.m | 89 + octave_packages/m/plot/comet.m | 88 + octave_packages/m/plot/comet3.m | 86 + octave_packages/m/plot/compass.m | 120 + octave_packages/m/plot/contour.m | 92 + octave_packages/m/plot/contour3.m | 86 + octave_packages/m/plot/contourc.m | 153 + octave_packages/m/plot/contourf.m | 93 + octave_packages/m/plot/cylinder.m | 92 + octave_packages/m/plot/daspect.m | 133 + octave_packages/m/plot/diffuse.m | 58 + octave_packages/m/plot/ellipsoid.m | 74 + octave_packages/m/plot/errorbar.m | 176 ++ octave_packages/m/plot/ezcontour.m | 68 + octave_packages/m/plot/ezcontourf.m | 67 + octave_packages/m/plot/ezmesh.m | 96 + octave_packages/m/plot/ezmeshc.m | 79 + octave_packages/m/plot/ezplot.m | 94 + octave_packages/m/plot/ezplot3.m | 69 + octave_packages/m/plot/ezpolar.m | 61 + octave_packages/m/plot/ezsurf.m | 96 + octave_packages/m/plot/ezsurfc.m | 79 + octave_packages/m/plot/feather.m | 117 + octave_packages/m/plot/figure.m | 102 + octave_packages/m/plot/fill.m | 131 + octave_packages/m/plot/findall.m | 60 + octave_packages/m/plot/findobj.m | 259 ++ octave_packages/m/plot/fplot.m | 136 + octave_packages/m/plot/gca.m | 60 + octave_packages/m/plot/gcbf.m | 36 + octave_packages/m/plot/gcbo.m | 46 + octave_packages/m/plot/gcf.m | 63 + octave_packages/m/plot/ginput.m | 48 + octave_packages/m/plot/gnuplot_binary.m | 61 + octave_packages/m/plot/graphics_toolkit.m | 95 + octave_packages/m/plot/grid.m | 121 + octave_packages/m/plot/gtext.m | 49 + octave_packages/m/plot/guidata.m | 52 + octave_packages/m/plot/guihandles.m | 70 + octave_packages/m/plot/hggroup.m | 53 + octave_packages/m/plot/hidden.m | 77 + octave_packages/m/plot/hist.m | 197 ++ octave_packages/m/plot/hold.m | 173 ++ octave_packages/m/plot/isfigure.m | 45 + octave_packages/m/plot/ishghandle.m | 59 + octave_packages/m/plot/ishold.m | 79 + octave_packages/m/plot/isocolors.m | 172 ++ octave_packages/m/plot/isonormals.m | 163 + octave_packages/m/plot/isosurface.m | 225 ++ octave_packages/m/plot/isprop.m | 55 + octave_packages/m/plot/legend.m | 1161 ++++++++ octave_packages/m/plot/line.m | 59 + octave_packages/m/plot/linkprop.m | 98 + octave_packages/m/plot/loglog.m | 109 + octave_packages/m/plot/loglogerr.m | 71 + octave_packages/m/plot/mesh.m | 67 + octave_packages/m/plot/meshc.m | 61 + octave_packages/m/plot/meshgrid.m | 103 + octave_packages/m/plot/meshz.m | 88 + octave_packages/m/plot/ndgrid.m | 97 + octave_packages/m/plot/newplot.m | 76 + octave_packages/m/plot/orient.m | 109 + octave_packages/m/plot/pareto.m | 122 + octave_packages/m/plot/patch.m | 235 ++ octave_packages/m/plot/pbaspect.m | 113 + octave_packages/m/plot/pcolor.m | 94 + octave_packages/m/plot/peaks.m | 86 + octave_packages/m/plot/pie.m | 87 + octave_packages/m/plot/pie3.m | 88 + octave_packages/m/plot/plot.m | 209 ++ octave_packages/m/plot/plot3.m | 345 +++ octave_packages/m/plot/plotmatrix.m | 188 ++ octave_packages/m/plot/plotyy.m | 327 ++ octave_packages/m/plot/polar.m | 230 ++ octave_packages/m/plot/print.m | 679 +++++ .../m/plot/private/__actual_axis_position__.m | 86 + .../m/plot/private/__add_datasource__.m | 55 + .../m/plot/private/__add_default_menu__.m | 109 + .../m/plot/private/__axes_limits__.m | 56 + .../m/plot/private/__axis_label__.m | 42 + octave_packages/m/plot/private/__bar__.m | 427 +++ octave_packages/m/plot/private/__clabel__.m | 115 + .../m/plot/private/__color_str_rgb__.m | 50 + octave_packages/m/plot/private/__contour__.m | 550 ++++ .../m/plot/private/__default_plot_options__.m | 34 + octave_packages/m/plot/private/__errcomm__.m | 78 + octave_packages/m/plot/private/__errplot__.m | 336 +++ octave_packages/m/plot/private/__ezplot__.m | 445 +++ .../m/plot/private/__file_filter__.m | 93 + .../m/plot/private/__fltk_file_filter__.m | 64 + .../m/plot/private/__fltk_ginput__.m | 105 + .../m/plot/private/__fltk_print__.m | 163 + .../m/plot/private/__getlegenddata__.m | 58 + .../m/plot/private/__ghostscript__.m | 167 ++ .../m/plot/private/__gnuplot_get_var__.m | 161 + .../m/plot/private/__gnuplot_ginput__.m | 154 + .../m/plot/private/__gnuplot_has_feature__.m | 61 + .../m/plot/private/__gnuplot_has_terminal__.m | 64 + .../m/plot/private/__gnuplot_open_stream__.m | 45 + .../m/plot/private/__gnuplot_print__.m | 306 ++ .../m/plot/private/__gnuplot_version__.m | 51 + .../m/plot/private/__go_draw_axes__.m | 2650 +++++++++++++++++ .../m/plot/private/__go_draw_figure__.m | 198 ++ .../m/plot/private/__interp_cube__.m | 184 ++ .../m/plot/private/__is_function__.m | 31 + octave_packages/m/plot/private/__line__.m | 121 + .../m/plot/private/__marching_cube__.m | 530 ++++ .../m/plot/private/__next_line_color__.m | 54 + .../m/plot/private/__next_line_style__.m | 61 + octave_packages/m/plot/private/__patch__.m | 368 +++ octave_packages/m/plot/private/__pie__.m | 200 ++ octave_packages/m/plot/private/__plt__.m | 604 ++++ octave_packages/m/plot/private/__pltopt__.m | 241 ++ .../m/plot/private/__print_parse_opts__.m | 608 ++++ octave_packages/m/plot/private/__quiver__.m | 437 +++ octave_packages/m/plot/private/__scatter__.m | 377 +++ octave_packages/m/plot/private/__stem__.m | 557 ++++ .../m/plot/private/__tight_eps_bbox__.m | 124 + .../m/plot/private/__uigetdir_fltk__.m | 34 + .../m/plot/private/__uigetfile_fltk__.m | 38 + .../m/plot/private/__uiobject_split_args__.m | 66 + .../m/plot/private/__uiputfile_fltk__.m | 38 + octave_packages/m/plot/quiver.m | 99 + octave_packages/m/plot/quiver3.m | 118 + octave_packages/m/plot/rectangle.m | 222 ++ octave_packages/m/plot/refresh.m | 42 + octave_packages/m/plot/refreshdata.m | 117 + octave_packages/m/plot/ribbon.m | 95 + octave_packages/m/plot/rose.m | 111 + octave_packages/m/plot/saveas.m | 107 + octave_packages/m/plot/scatter.m | 183 ++ octave_packages/m/plot/scatter3.m | 111 + octave_packages/m/plot/semilogx.m | 123 + octave_packages/m/plot/semilogxerr.m | 69 + octave_packages/m/plot/semilogy.m | 123 + octave_packages/m/plot/semilogyerr.m | 71 + octave_packages/m/plot/shading.m | 113 + octave_packages/m/plot/shg.m | 36 + octave_packages/m/plot/slice.m | 197 ++ octave_packages/m/plot/sombrero.m | 66 + octave_packages/m/plot/specular.m | 92 + octave_packages/m/plot/sphere.m | 61 + octave_packages/m/plot/spinmap.m | 57 + octave_packages/m/plot/stairs.m | 268 ++ octave_packages/m/plot/stem.m | 132 + octave_packages/m/plot/stem3.m | 58 + octave_packages/m/plot/subplot.m | 365 +++ octave_packages/m/plot/surf.m | 86 + octave_packages/m/plot/surface.m | 188 ++ octave_packages/m/plot/surfc.m | 94 + octave_packages/m/plot/surfl.m | 188 ++ octave_packages/m/plot/surfnorm.m | 157 + octave_packages/m/plot/text.m | 254 ++ octave_packages/m/plot/title.m | 83 + octave_packages/m/plot/trimesh.m | 69 + octave_packages/m/plot/triplot.m | 60 + octave_packages/m/plot/trisurf.m | 131 + octave_packages/m/plot/uicontextmenu.m | 30 + octave_packages/m/plot/uicontrol.m | 36 + octave_packages/m/plot/uigetdir.m | 66 + octave_packages/m/plot/uigetfile.m | 193 ++ octave_packages/m/plot/uimenu.m | 149 + octave_packages/m/plot/uipanel.m | 31 + octave_packages/m/plot/uipushtool.m | 39 + octave_packages/m/plot/uiputfile.m | 128 + octave_packages/m/plot/uiresume.m | 45 + octave_packages/m/plot/uitoggletool.m | 39 + octave_packages/m/plot/uitoolbar.m | 31 + octave_packages/m/plot/uiwait.m | 80 + octave_packages/m/plot/view.m | 124 + octave_packages/m/plot/waitbar.m | 188 ++ octave_packages/m/plot/waitforbuttonpress.m | 47 + octave_packages/m/plot/whitebg.m | 164 + octave_packages/m/plot/xlabel.m | 63 + octave_packages/m/plot/xlim.m | 100 + octave_packages/m/plot/ylabel.m | 57 + octave_packages/m/plot/ylim.m | 96 + octave_packages/m/plot/zlabel.m | 70 + octave_packages/m/plot/zlim.m | 96 + octave_packages/m/polynomial/compan.m | 93 + octave_packages/m/polynomial/conv.m | 141 + octave_packages/m/polynomial/deconv.m | 110 + octave_packages/m/polynomial/mkpp.m | 112 + octave_packages/m/polynomial/mpoles.m | 122 + octave_packages/m/polynomial/pchip.m | 172 ++ octave_packages/m/polynomial/poly.m | 91 + octave_packages/m/polynomial/polyaffine.m | 88 + octave_packages/m/polynomial/polyder.m | 99 + octave_packages/m/polynomial/polyfit.m | 177 ++ octave_packages/m/polynomial/polygcd.m | 102 + octave_packages/m/polynomial/polyint.m | 77 + octave_packages/m/polynomial/polyout.m | 103 + octave_packages/m/polynomial/polyreduce.m | 65 + octave_packages/m/polynomial/polyval.m | 152 + octave_packages/m/polynomial/polyvalm.m | 68 + octave_packages/m/polynomial/ppder.m | 70 + octave_packages/m/polynomial/ppint.m | 58 + octave_packages/m/polynomial/ppjumps.m | 84 + octave_packages/m/polynomial/ppval.m | 116 + octave_packages/m/polynomial/residue.m | 430 +++ octave_packages/m/polynomial/roots.m | 141 + octave_packages/m/polynomial/spline.m | 305 ++ octave_packages/m/polynomial/unmkpp.m | 83 + octave_packages/m/prefs/addpref.m | 74 + octave_packages/m/prefs/getpref.m | 95 + octave_packages/m/prefs/ispref.m | 60 + octave_packages/m/prefs/private/loadprefs.m | 43 + octave_packages/m/prefs/private/prefsfile.m | 53 + octave_packages/m/prefs/private/saveprefs.m | 36 + octave_packages/m/prefs/rmpref.m | 61 + octave_packages/m/prefs/setpref.m | 67 + octave_packages/m/set/intersect.m | 115 + octave_packages/m/set/ismember.m | 209 ++ octave_packages/m/set/powerset.m | 83 + octave_packages/m/set/private/validargs.m | 57 + octave_packages/m/set/setdiff.m | 105 + octave_packages/m/set/setxor.m | 101 + octave_packages/m/set/union.m | 100 + octave_packages/m/set/unique.m | 214 ++ octave_packages/m/signal/arch_fit.m | 118 + octave_packages/m/signal/arch_rnd.m | 102 + octave_packages/m/signal/arch_test.m | 96 + octave_packages/m/signal/arma_rnd.m | 81 + octave_packages/m/signal/autoreg_matrix.m | 62 + octave_packages/m/signal/bartlett.m | 63 + octave_packages/m/signal/blackman.m | 63 + octave_packages/m/signal/detrend.m | 89 + octave_packages/m/signal/diffpara.m | 88 + octave_packages/m/signal/durbinlevinson.m | 93 + octave_packages/m/signal/fftconv.m | 106 + octave_packages/m/signal/fftfilt.m | 151 + octave_packages/m/signal/fftshift.m | 131 + octave_packages/m/signal/filter2.m | 58 + octave_packages/m/signal/fractdiff.m | 69 + octave_packages/m/signal/freqz.m | 197 ++ octave_packages/m/signal/freqz_plot.m | 66 + octave_packages/m/signal/hamming.m | 61 + octave_packages/m/signal/hanning.m | 61 + octave_packages/m/signal/hurst.m | 48 + octave_packages/m/signal/ifftshift.m | 116 + octave_packages/m/signal/periodogram.m | 190 ++ .../m/signal/private/rectangle_lw.m | 39 + .../m/signal/private/rectangle_sw.m | 72 + .../m/signal/private/triangle_lw.m | 38 + .../m/signal/private/triangle_sw.m | 72 + octave_packages/m/signal/sinc.m | 54 + octave_packages/m/signal/sinetone.m | 67 + octave_packages/m/signal/sinewave.m | 55 + octave_packages/m/signal/spectral_adf.m | 65 + octave_packages/m/signal/spectral_xdf.m | 62 + octave_packages/m/signal/spencer.m | 53 + octave_packages/m/signal/stft.m | 134 + octave_packages/m/signal/synthesis.m | 72 + octave_packages/m/signal/unwrap.m | 156 + octave_packages/m/signal/yulewalker.m | 60 + octave_packages/m/sparse/bicg.m | 262 ++ octave_packages/m/sparse/bicgstab.m | 247 ++ octave_packages/m/sparse/cgs.m | 225 ++ octave_packages/m/sparse/colperm.m | 37 + octave_packages/m/sparse/etreeplot.m | 36 + octave_packages/m/sparse/gmres.m | 218 ++ octave_packages/m/sparse/gplot.m | 84 + octave_packages/m/sparse/nonzeros.m | 40 + octave_packages/m/sparse/pcg.m | 532 ++++ octave_packages/m/sparse/pcr.m | 432 +++ .../m/sparse/private/__sprand_impl__.m | 63 + octave_packages/m/sparse/spaugment.m | 101 + octave_packages/m/sparse/spconvert.m | 67 + octave_packages/m/sparse/spdiags.m | 94 + octave_packages/m/sparse/speye.m | 57 + octave_packages/m/sparse/spfun.m | 49 + octave_packages/m/sparse/spones.m | 40 + octave_packages/m/sparse/sprand.m | 82 + octave_packages/m/sparse/sprandn.m | 74 + octave_packages/m/sparse/sprandsym.m | 176 ++ octave_packages/m/sparse/spstats.m | 65 + octave_packages/m/sparse/spy.m | 75 + octave_packages/m/sparse/svds.m | 296 ++ octave_packages/m/sparse/treelayout.m | 227 ++ octave_packages/m/sparse/treeplot.m | 205 ++ octave_packages/m/specfun/bessel.m | 94 + octave_packages/m/specfun/beta.m | 82 + octave_packages/m/specfun/betaln.m | 57 + octave_packages/m/specfun/factor.m | 95 + octave_packages/m/specfun/factorial.m | 42 + octave_packages/m/specfun/isprime.m | 87 + octave_packages/m/specfun/lcm.m | 61 + octave_packages/m/specfun/legendre.m | 315 ++ octave_packages/m/specfun/nchoosek.m | 157 + octave_packages/m/specfun/nthroot.m | 98 + octave_packages/m/specfun/perms.m | 73 + octave_packages/m/specfun/pow2.m | 69 + octave_packages/m/specfun/primes.m | 102 + octave_packages/m/specfun/reallog.m | 40 + octave_packages/m/specfun/realpow.m | 45 + octave_packages/m/specfun/realsqrt.m | 40 + octave_packages/m/special-matrix/hadamard.m | 175 ++ octave_packages/m/special-matrix/hankel.m | 98 + octave_packages/m/special-matrix/hilb.m | 79 + octave_packages/m/special-matrix/invhilb.m | 128 + octave_packages/m/special-matrix/magic.m | 97 + octave_packages/m/special-matrix/pascal.m | 90 + octave_packages/m/special-matrix/rosser.m | 48 + octave_packages/m/special-matrix/toeplitz.m | 134 + octave_packages/m/special-matrix/vander.m | 95 + octave_packages/m/special-matrix/wilkinson.m | 61 + octave_packages/m/startup/__finish__.m | 40 + octave_packages/m/startup/inputrc | 21 + octave_packages/m/statistics/base/center.m | 83 + octave_packages/m/statistics/base/cloglog.m | 55 + octave_packages/m/statistics/base/corr.m | 112 + octave_packages/m/statistics/base/cov.m | 165 + octave_packages/m/statistics/base/gls.m | 145 + octave_packages/m/statistics/base/histc.m | 176 ++ octave_packages/m/statistics/base/iqr.m | 98 + octave_packages/m/statistics/base/kendall.m | 134 + octave_packages/m/statistics/base/kurtosis.m | 100 + octave_packages/m/statistics/base/logit.m | 59 + .../m/statistics/base/mahalanobis.m | 80 + octave_packages/m/statistics/base/mean.m | 151 + octave_packages/m/statistics/base/meansq.m | 89 + octave_packages/m/statistics/base/median.m | 123 + octave_packages/m/statistics/base/mode.m | 167 ++ octave_packages/m/statistics/base/moment.m | 199 ++ octave_packages/m/statistics/base/ols.m | 173 ++ octave_packages/m/statistics/base/ppplot.m | 84 + octave_packages/m/statistics/base/prctile.m | 175 ++ octave_packages/m/statistics/base/probit.m | 44 + octave_packages/m/statistics/base/qqplot.m | 99 + octave_packages/m/statistics/base/quantile.m | 415 +++ octave_packages/m/statistics/base/range.m | 61 + octave_packages/m/statistics/base/ranks.m | 104 + octave_packages/m/statistics/base/run_count.m | 113 + octave_packages/m/statistics/base/runlength.m | 66 + octave_packages/m/statistics/base/skewness.m | 100 + octave_packages/m/statistics/base/spearman.m | 94 + .../m/statistics/base/statistics.m | 89 + octave_packages/m/statistics/base/std.m | 127 + octave_packages/m/statistics/base/table.m | 73 + octave_packages/m/statistics/base/var.m | 118 + octave_packages/m/statistics/base/zscore.m | 84 + .../m/statistics/distributions/betacdf.m | 93 + .../m/statistics/distributions/betainv.m | 136 + .../m/statistics/distributions/betapdf.m | 130 + .../m/statistics/distributions/betarnd.m | 137 + .../m/statistics/distributions/binocdf.m | 98 + .../m/statistics/distributions/binoinv.m | 115 + .../m/statistics/distributions/binopdf.m | 101 + .../m/statistics/distributions/binornd.m | 154 + .../m/statistics/distributions/cauchy_cdf.m | 91 + .../m/statistics/distributions/cauchy_inv.m | 98 + .../m/statistics/distributions/cauchy_pdf.m | 97 + .../m/statistics/distributions/cauchy_rnd.m | 132 + .../m/statistics/distributions/chi2cdf.m | 73 + .../m/statistics/distributions/chi2inv.m | 72 + .../m/statistics/distributions/chi2pdf.m | 72 + .../m/statistics/distributions/chi2rnd.m | 120 + .../m/statistics/distributions/discrete_cdf.m | 81 + .../m/statistics/distributions/discrete_inv.m | 95 + .../m/statistics/distributions/discrete_pdf.m | 85 + .../m/statistics/distributions/discrete_rnd.m | 104 + .../statistics/distributions/empirical_cdf.m | 62 + .../statistics/distributions/empirical_inv.m | 61 + .../statistics/distributions/empirical_pdf.m | 60 + .../statistics/distributions/empirical_rnd.m | 69 + .../m/statistics/distributions/expcdf.m | 91 + .../m/statistics/distributions/expinv.m | 95 + .../m/statistics/distributions/exppdf.m | 84 + .../m/statistics/distributions/exprnd.m | 117 + .../m/statistics/distributions/fcdf.m | 96 + .../m/statistics/distributions/finv.m | 93 + .../m/statistics/distributions/fpdf.m | 105 + .../m/statistics/distributions/frnd.m | 132 + .../m/statistics/distributions/gamcdf.m | 91 + .../m/statistics/distributions/gaminv.m | 129 + .../m/statistics/distributions/gampdf.m | 103 + .../m/statistics/distributions/gamrnd.m | 135 + .../m/statistics/distributions/geocdf.m | 89 + .../m/statistics/distributions/geoinv.m | 85 + .../m/statistics/distributions/geopdf.m | 85 + .../m/statistics/distributions/geornd.m | 125 + .../m/statistics/distributions/hygecdf.m | 109 + .../m/statistics/distributions/hygeinv.m | 114 + .../m/statistics/distributions/hygepdf.m | 112 + .../m/statistics/distributions/hygernd.m | 148 + .../distributions/kolmogorov_smirnov_cdf.m | 95 + .../m/statistics/distributions/laplace_cdf.m | 56 + .../m/statistics/distributions/laplace_inv.m | 64 + .../m/statistics/distributions/laplace_pdf.m | 56 + .../m/statistics/distributions/laplace_rnd.m | 74 + .../m/statistics/distributions/logistic_cdf.m | 56 + .../m/statistics/distributions/logistic_inv.m | 69 + .../m/statistics/distributions/logistic_pdf.m | 56 + .../m/statistics/distributions/logistic_rnd.m | 73 + .../m/statistics/distributions/logncdf.m | 100 + .../m/statistics/distributions/logninv.m | 99 + .../m/statistics/distributions/lognpdf.m | 96 + .../m/statistics/distributions/lognrnd.m | 132 + .../m/statistics/distributions/nbincdf.m | 105 + .../m/statistics/distributions/nbininv.m | 128 + .../m/statistics/distributions/nbinpdf.m | 102 + .../m/statistics/distributions/nbinrnd.m | 140 + .../m/statistics/distributions/normcdf.m | 99 + .../m/statistics/distributions/norminv.m | 93 + .../m/statistics/distributions/normpdf.m | 98 + .../m/statistics/distributions/normrnd.m | 131 + .../m/statistics/distributions/poisscdf.m | 90 + .../m/statistics/distributions/poissinv.m | 103 + .../m/statistics/distributions/poisspdf.m | 85 + .../m/statistics/distributions/poissrnd.m | 122 + .../statistics/distributions/stdnormal_cdf.m | 57 + .../statistics/distributions/stdnormal_inv.m | 57 + .../statistics/distributions/stdnormal_pdf.m | 57 + .../statistics/distributions/stdnormal_rnd.m | 74 + .../m/statistics/distributions/tcdf.m | 94 + .../m/statistics/distributions/tinv.m | 108 + .../m/statistics/distributions/tpdf.m | 93 + .../m/statistics/distributions/trnd.m | 117 + .../m/statistics/distributions/unidcdf.m | 89 + .../m/statistics/distributions/unidinv.m | 81 + .../m/statistics/distributions/unidpdf.m | 87 + .../m/statistics/distributions/unidrnd.m | 111 + .../m/statistics/distributions/unifcdf.m | 98 + .../m/statistics/distributions/unifinv.m | 91 + .../m/statistics/distributions/unifpdf.m | 93 + .../m/statistics/distributions/unifrnd.m | 132 + .../m/statistics/distributions/wblcdf.m | 113 + .../m/statistics/distributions/wblinv.m | 99 + .../m/statistics/distributions/wblpdf.m | 112 + .../m/statistics/distributions/wblrnd.m | 132 + .../m/statistics/distributions/wienrnd.m | 54 + .../m/statistics/models/logistic_regression.m | 192 ++ .../private/logistic_regression_derivatives.m | 47 + .../private/logistic_regression_likelihood.m | 43 + octave_packages/m/statistics/tests/anova.m | 110 + .../m/statistics/tests/bartlett_test.m | 67 + .../tests/chisquare_test_homogeneity.m | 68 + .../tests/chisquare_test_independence.m | 53 + octave_packages/m/statistics/tests/cor_test.m | 135 + .../m/statistics/tests/f_test_regression.m | 77 + .../m/statistics/tests/hotelling_test.m | 72 + .../m/statistics/tests/hotelling_test_2.m | 86 + .../tests/kolmogorov_smirnov_test.m | 126 + .../tests/kolmogorov_smirnov_test_2.m | 104 + .../m/statistics/tests/kruskal_wallis_test.m | 98 + octave_packages/m/statistics/tests/manova.m | 161 + .../m/statistics/tests/mcnemar_test.m | 67 + .../m/statistics/tests/prop_test_2.m | 80 + octave_packages/m/statistics/tests/run_test.m | 58 + .../m/statistics/tests/sign_test.m | 83 + octave_packages/m/statistics/tests/t_test.m | 83 + octave_packages/m/statistics/tests/t_test_2.m | 84 + .../m/statistics/tests/t_test_regression.m | 96 + octave_packages/m/statistics/tests/u_test.m | 85 + octave_packages/m/statistics/tests/var_test.m | 80 + .../m/statistics/tests/welch_test.m | 85 + .../m/statistics/tests/wilcoxon_test.m | 91 + octave_packages/m/statistics/tests/z_test.m | 87 + octave_packages/m/statistics/tests/z_test_2.m | 88 + octave_packages/m/strings/base2dec.m | 136 + octave_packages/m/strings/bin2dec.m | 74 + octave_packages/m/strings/blanks.m | 65 + octave_packages/m/strings/cstrcat.m | 69 + octave_packages/m/strings/deblank.m | 89 + octave_packages/m/strings/dec2base.m | 167 ++ octave_packages/m/strings/dec2bin.m | 63 + octave_packages/m/strings/dec2hex.m | 63 + octave_packages/m/strings/findstr.m | 143 + octave_packages/m/strings/hex2dec.m | 65 + octave_packages/m/strings/index.m | 116 + octave_packages/m/strings/isletter.m | 40 + octave_packages/m/strings/isstrprop.m | 135 + octave_packages/m/strings/mat2str.m | 147 + octave_packages/m/strings/regexptranslate.m | 87 + octave_packages/m/strings/rindex.m | 67 + octave_packages/m/strings/str2num.m | 84 + octave_packages/m/strings/strcat.m | 127 + octave_packages/m/strings/strchr.m | 80 + octave_packages/m/strings/strjust.m | 112 + octave_packages/m/strings/strmatch.m | 119 + octave_packages/m/strings/strsplit.m | 118 + octave_packages/m/strings/strtok.m | 224 ++ octave_packages/m/strings/strtrim.m | 88 + octave_packages/m/strings/strtrunc.m | 78 + octave_packages/m/strings/substr.m | 113 + octave_packages/m/strings/untabify.m | 123 + octave_packages/m/strings/validatestring.m | 163 + octave_packages/m/testfun/assert.m | 337 +++ octave_packages/m/testfun/demo.m | 154 + octave_packages/m/testfun/example.m | 104 + octave_packages/m/testfun/fail.m | 144 + octave_packages/m/testfun/rundemos.m | 89 + octave_packages/m/testfun/runtests.m | 108 + octave_packages/m/testfun/speed.m | 444 +++ octave_packages/m/testfun/test.m | 840 ++++++ octave_packages/m/time/addtodate.m | 125 + octave_packages/m/time/asctime.m | 54 + octave_packages/m/time/calendar.m | 104 + octave_packages/m/time/clock.m | 61 + octave_packages/m/time/ctime.m | 54 + octave_packages/m/time/date.m | 43 + octave_packages/m/time/datenum.m | 185 ++ octave_packages/m/time/datestr.m | 337 +++ octave_packages/m/time/datetick.m | 305 ++ octave_packages/m/time/datevec.m | 304 ++ octave_packages/m/time/eomday.m | 65 + octave_packages/m/time/etime.m | 79 + octave_packages/m/time/is_leap_year.m | 60 + octave_packages/m/time/now.m | 61 + octave_packages/m/time/weekday.m | 124 + 872 files changed, 106188 insertions(+) create mode 100644 octave_packages/m/@ftp/ascii.m create mode 100644 octave_packages/m/@ftp/binary.m create mode 100644 octave_packages/m/@ftp/cd.m create mode 100644 octave_packages/m/@ftp/close.m create mode 100644 octave_packages/m/@ftp/delete.m create mode 100644 octave_packages/m/@ftp/dir.m create mode 100644 octave_packages/m/@ftp/display.m create mode 100644 octave_packages/m/@ftp/ftp.m create mode 100644 octave_packages/m/@ftp/loadobj.m create mode 100644 octave_packages/m/@ftp/mget.m create mode 100644 octave_packages/m/@ftp/mkdir.m create mode 100644 octave_packages/m/@ftp/mput.m create mode 100644 octave_packages/m/@ftp/rename.m create mode 100644 octave_packages/m/@ftp/rmdir.m create mode 100644 octave_packages/m/@ftp/saveobj.m create mode 100644 octave_packages/m/audio/lin2mu.m create mode 100644 octave_packages/m/audio/loadaudio.m create mode 100644 octave_packages/m/audio/mu2lin.m create mode 100644 octave_packages/m/audio/playaudio.m create mode 100644 octave_packages/m/audio/record.m create mode 100644 octave_packages/m/audio/saveaudio.m create mode 100644 octave_packages/m/audio/setaudio.m create mode 100644 octave_packages/m/audio/wavread.m create mode 100644 octave_packages/m/audio/wavwrite.m create mode 100644 octave_packages/m/deprecated/__error_text__.m create mode 100644 octave_packages/m/deprecated/autocor.m create mode 100644 octave_packages/m/deprecated/autocov.m create mode 100644 octave_packages/m/deprecated/betai.m create mode 100644 octave_packages/m/deprecated/cellidx.m create mode 100644 octave_packages/m/deprecated/clg.m create mode 100644 octave_packages/m/deprecated/cor.m create mode 100644 octave_packages/m/deprecated/corrcoef.m create mode 100644 octave_packages/m/deprecated/cquad.m create mode 100644 octave_packages/m/deprecated/cut.m create mode 100644 octave_packages/m/deprecated/dispatch.m create mode 100644 octave_packages/m/deprecated/error_text.m create mode 100644 octave_packages/m/deprecated/fstat.m create mode 100644 octave_packages/m/deprecated/gammai.m create mode 100644 octave_packages/m/deprecated/glpkmex.m create mode 100644 octave_packages/m/deprecated/intwarning.m create mode 100644 octave_packages/m/deprecated/is_duplicate_entry.m create mode 100644 octave_packages/m/deprecated/is_global.m create mode 100644 octave_packages/m/deprecated/isstr.m create mode 100644 octave_packages/m/deprecated/krylovb.m create mode 100644 octave_packages/m/deprecated/perror.m create mode 100644 octave_packages/m/deprecated/polyderiv.m create mode 100644 octave_packages/m/deprecated/replot.m create mode 100644 octave_packages/m/deprecated/saveimage.m create mode 100644 octave_packages/m/deprecated/setstr.m create mode 100644 octave_packages/m/deprecated/shell_cmd.m create mode 100644 octave_packages/m/deprecated/strerror.m create mode 100644 octave_packages/m/deprecated/studentize.m create mode 100644 octave_packages/m/deprecated/sylvester_matrix.m create mode 100644 octave_packages/m/deprecated/values.m create mode 100644 octave_packages/m/deprecated/weibcdf.m create mode 100644 octave_packages/m/deprecated/weibinv.m create mode 100644 octave_packages/m/deprecated/weibpdf.m create mode 100644 octave_packages/m/deprecated/weibrnd.m create mode 100644 octave_packages/m/elfun/acosd.m create mode 100644 octave_packages/m/elfun/acot.m create mode 100644 octave_packages/m/elfun/acotd.m create mode 100644 octave_packages/m/elfun/acoth.m create mode 100644 octave_packages/m/elfun/acsc.m create mode 100644 octave_packages/m/elfun/acscd.m create mode 100644 octave_packages/m/elfun/acsch.m create mode 100644 octave_packages/m/elfun/asec.m create mode 100644 octave_packages/m/elfun/asecd.m create mode 100644 octave_packages/m/elfun/asech.m create mode 100644 octave_packages/m/elfun/asind.m create mode 100644 octave_packages/m/elfun/atand.m create mode 100644 octave_packages/m/elfun/cosd.m create mode 100644 octave_packages/m/elfun/cot.m create mode 100644 octave_packages/m/elfun/cotd.m create mode 100644 octave_packages/m/elfun/coth.m create mode 100644 octave_packages/m/elfun/csc.m create mode 100644 octave_packages/m/elfun/cscd.m create mode 100644 octave_packages/m/elfun/csch.m create mode 100644 octave_packages/m/elfun/sec.m create mode 100644 octave_packages/m/elfun/secd.m create mode 100644 octave_packages/m/elfun/sech.m create mode 100644 octave_packages/m/elfun/sind.m create mode 100644 octave_packages/m/elfun/tand.m create mode 100644 octave_packages/m/general/accumarray.m create mode 100644 octave_packages/m/general/accumdim.m create mode 100644 octave_packages/m/general/bicubic.m create mode 100644 octave_packages/m/general/bitcmp.m create mode 100644 octave_packages/m/general/bitget.m create mode 100644 octave_packages/m/general/bitset.m create mode 100644 octave_packages/m/general/blkdiag.m create mode 100644 octave_packages/m/general/cart2pol.m create mode 100644 octave_packages/m/general/cart2sph.m create mode 100644 octave_packages/m/general/cell2mat.m create mode 100644 octave_packages/m/general/celldisp.m create mode 100644 octave_packages/m/general/chop.m create mode 100644 octave_packages/m/general/circshift.m create mode 100644 octave_packages/m/general/colon.m create mode 100644 octave_packages/m/general/common_size.m create mode 100644 octave_packages/m/general/cplxpair.m create mode 100644 octave_packages/m/general/cumtrapz.m create mode 100644 octave_packages/m/general/curl.m create mode 100644 octave_packages/m/general/dblquad.m create mode 100644 octave_packages/m/general/deal.m create mode 100644 octave_packages/m/general/del2.m create mode 100644 octave_packages/m/general/display.m create mode 100644 octave_packages/m/general/divergence.m create mode 100644 octave_packages/m/general/flipdim.m create mode 100644 octave_packages/m/general/fliplr.m create mode 100644 octave_packages/m/general/flipud.m create mode 100644 octave_packages/m/general/genvarname.m create mode 100644 octave_packages/m/general/gradient.m create mode 100644 octave_packages/m/general/idivide.m create mode 100644 octave_packages/m/general/int2str.m create mode 100644 octave_packages/m/general/interp1.m create mode 100644 octave_packages/m/general/interp1q.m create mode 100644 octave_packages/m/general/interp2.m create mode 100644 octave_packages/m/general/interp3.m create mode 100644 octave_packages/m/general/interpft.m create mode 100644 octave_packages/m/general/interpn.m create mode 100644 octave_packages/m/general/isa.m create mode 100644 octave_packages/m/general/iscolumn.m create mode 100644 octave_packages/m/general/isdir.m create mode 100644 octave_packages/m/general/isequal.m create mode 100644 octave_packages/m/general/isequalwithequalnans.m create mode 100644 octave_packages/m/general/isrow.m create mode 100644 octave_packages/m/general/isscalar.m create mode 100644 octave_packages/m/general/issquare.m create mode 100644 octave_packages/m/general/isvector.m create mode 100644 octave_packages/m/general/loadobj.m create mode 100644 octave_packages/m/general/logspace.m create mode 100644 octave_packages/m/general/nargchk.m create mode 100644 octave_packages/m/general/narginchk.m create mode 100644 octave_packages/m/general/nargoutchk.m create mode 100644 octave_packages/m/general/nextpow2.m create mode 100644 octave_packages/m/general/nthargout.m create mode 100644 octave_packages/m/general/num2str.m create mode 100644 octave_packages/m/general/pol2cart.m create mode 100644 octave_packages/m/general/polyarea.m create mode 100644 octave_packages/m/general/postpad.m create mode 100644 octave_packages/m/general/prepad.m create mode 100644 octave_packages/m/general/private/__isequal__.m create mode 100644 octave_packages/m/general/private/__splinen__.m create mode 100644 octave_packages/m/general/profexplore.m create mode 100644 octave_packages/m/general/profile.m create mode 100644 octave_packages/m/general/profshow.m create mode 100644 octave_packages/m/general/quadgk.m create mode 100644 octave_packages/m/general/quadl.m create mode 100644 octave_packages/m/general/quadv.m create mode 100644 octave_packages/m/general/randi.m create mode 100644 octave_packages/m/general/rat.m create mode 100644 octave_packages/m/general/repmat.m create mode 100644 octave_packages/m/general/rot90.m create mode 100644 octave_packages/m/general/rotdim.m create mode 100644 octave_packages/m/general/saveobj.m create mode 100644 octave_packages/m/general/shift.m create mode 100644 octave_packages/m/general/shiftdim.m create mode 100644 octave_packages/m/general/sortrows.m create mode 100644 octave_packages/m/general/sph2cart.m create mode 100644 octave_packages/m/general/structfun.m create mode 100644 octave_packages/m/general/subsindex.m create mode 100644 octave_packages/m/general/trapz.m create mode 100644 octave_packages/m/general/triplequad.m create mode 100644 octave_packages/m/geometry/convhull.m create mode 100644 octave_packages/m/geometry/delaunay.m create mode 100644 octave_packages/m/geometry/delaunay3.m create mode 100644 octave_packages/m/geometry/delaunayn.m create mode 100644 octave_packages/m/geometry/dsearch.m create mode 100644 octave_packages/m/geometry/dsearchn.m create mode 100644 octave_packages/m/geometry/griddata.m create mode 100644 octave_packages/m/geometry/griddata3.m create mode 100644 octave_packages/m/geometry/griddatan.m create mode 100644 octave_packages/m/geometry/inpolygon.m create mode 100644 octave_packages/m/geometry/rectint.m create mode 100644 octave_packages/m/geometry/tsearchn.m create mode 100644 octave_packages/m/geometry/voronoi.m create mode 100644 octave_packages/m/geometry/voronoin.m create mode 100644 octave_packages/m/help/__makeinfo__.m create mode 100644 octave_packages/m/help/doc.m create mode 100644 octave_packages/m/help/gen_doc_cache.m create mode 100644 octave_packages/m/help/get_first_help_sentence.m create mode 100644 octave_packages/m/help/help.m create mode 100644 octave_packages/m/help/lookfor.m create mode 100644 octave_packages/m/help/print_usage.m create mode 100644 octave_packages/m/help/private/__additional_help_message__.m create mode 100644 octave_packages/m/help/private/__strip_html_tags__.m create mode 100644 octave_packages/m/help/type.m create mode 100644 octave_packages/m/help/unimplemented.m create mode 100644 octave_packages/m/help/which.m create mode 100644 octave_packages/m/image/autumn.m create mode 100644 octave_packages/m/image/bone.m create mode 100644 octave_packages/m/image/brighten.m create mode 100644 octave_packages/m/image/colormap.m create mode 100644 octave_packages/m/image/contrast.m create mode 100644 octave_packages/m/image/cool.m create mode 100644 octave_packages/m/image/copper.m create mode 100644 octave_packages/m/image/flag.m create mode 100644 octave_packages/m/image/gmap40.m create mode 100644 octave_packages/m/image/gray.m create mode 100644 octave_packages/m/image/gray2ind.m create mode 100644 octave_packages/m/image/hot.m create mode 100644 octave_packages/m/image/hsv.m create mode 100644 octave_packages/m/image/hsv2rgb.m create mode 100644 octave_packages/m/image/image.m create mode 100644 octave_packages/m/image/imagesc.m create mode 100644 octave_packages/m/image/imfinfo.m create mode 100644 octave_packages/m/image/imread.m create mode 100644 octave_packages/m/image/imshow.m create mode 100644 octave_packages/m/image/imwrite.m create mode 100644 octave_packages/m/image/ind2gray.m create mode 100644 octave_packages/m/image/ind2rgb.m create mode 100644 octave_packages/m/image/jet.m create mode 100644 octave_packages/m/image/ntsc2rgb.m create mode 100644 octave_packages/m/image/ocean.m create mode 100644 octave_packages/m/image/pink.m create mode 100644 octave_packages/m/image/prism.m create mode 100644 octave_packages/m/image/rainbow.m create mode 100644 octave_packages/m/image/rgb2hsv.m create mode 100644 octave_packages/m/image/rgb2ind.m create mode 100644 octave_packages/m/image/rgb2ntsc.m create mode 100644 octave_packages/m/image/spring.m create mode 100644 octave_packages/m/image/summer.m create mode 100644 octave_packages/m/image/white.m create mode 100644 octave_packages/m/image/winter.m create mode 100644 octave_packages/m/io/beep.m create mode 100644 octave_packages/m/io/csvread.m create mode 100644 octave_packages/m/io/csvwrite.m create mode 100644 octave_packages/m/io/dlmwrite.m create mode 100644 octave_packages/m/io/fileread.m create mode 100644 octave_packages/m/io/is_valid_file_id.m create mode 100644 octave_packages/m/io/strread.m create mode 100644 octave_packages/m/io/textread.m create mode 100644 octave_packages/m/io/textscan.m create mode 100644 octave_packages/m/linear-algebra/commutation_matrix.m create mode 100644 octave_packages/m/linear-algebra/cond.m create mode 100644 octave_packages/m/linear-algebra/condest.m create mode 100644 octave_packages/m/linear-algebra/cross.m create mode 100644 octave_packages/m/linear-algebra/duplication_matrix.m create mode 100644 octave_packages/m/linear-algebra/expm.m create mode 100644 octave_packages/m/linear-algebra/housh.m create mode 100644 octave_packages/m/linear-algebra/isdefinite.m create mode 100644 octave_packages/m/linear-algebra/ishermitian.m create mode 100644 octave_packages/m/linear-algebra/issymmetric.m create mode 100644 octave_packages/m/linear-algebra/krylov.m create mode 100644 octave_packages/m/linear-algebra/logm.m create mode 100644 octave_packages/m/linear-algebra/normest.m create mode 100644 octave_packages/m/linear-algebra/null.m create mode 100644 octave_packages/m/linear-algebra/onenormest.m create mode 100644 octave_packages/m/linear-algebra/orth.m create mode 100644 octave_packages/m/linear-algebra/planerot.m create mode 100644 octave_packages/m/linear-algebra/qzhess.m create mode 100644 octave_packages/m/linear-algebra/rank.m create mode 100644 octave_packages/m/linear-algebra/rref.m create mode 100644 octave_packages/m/linear-algebra/subspace.m create mode 100644 octave_packages/m/linear-algebra/trace.m create mode 100644 octave_packages/m/linear-algebra/vech.m create mode 100644 octave_packages/m/miscellaneous/ans.m create mode 100644 octave_packages/m/miscellaneous/bincoeff.m create mode 100644 octave_packages/m/miscellaneous/bug_report.m create mode 100644 octave_packages/m/miscellaneous/bunzip2.m create mode 100644 octave_packages/m/miscellaneous/bzip2.m create mode 100644 octave_packages/m/miscellaneous/cast.m create mode 100644 octave_packages/m/miscellaneous/comma.m create mode 100644 octave_packages/m/miscellaneous/compare_versions.m create mode 100644 octave_packages/m/miscellaneous/computer.m create mode 100644 octave_packages/m/miscellaneous/copyfile.m create mode 100644 octave_packages/m/miscellaneous/debug.m create mode 100644 octave_packages/m/miscellaneous/delete.m create mode 100644 octave_packages/m/miscellaneous/dir.m create mode 100644 octave_packages/m/miscellaneous/dos.m create mode 100644 octave_packages/m/miscellaneous/dump_prefs.m create mode 100644 octave_packages/m/miscellaneous/edit.m create mode 100644 octave_packages/m/miscellaneous/fact.m create mode 100644 octave_packages/m/miscellaneous/fileattrib.m create mode 100644 octave_packages/m/miscellaneous/fileparts.m create mode 100644 octave_packages/m/miscellaneous/fullfile.m create mode 100644 octave_packages/m/miscellaneous/getappdata.m create mode 100644 octave_packages/m/miscellaneous/getfield.m create mode 100644 octave_packages/m/miscellaneous/gunzip.m create mode 100644 octave_packages/m/miscellaneous/gzip.m create mode 100644 octave_packages/m/miscellaneous/info.m create mode 100644 octave_packages/m/miscellaneous/inputname.m create mode 100644 octave_packages/m/miscellaneous/isappdata.m create mode 100644 octave_packages/m/miscellaneous/isdeployed.m create mode 100644 octave_packages/m/miscellaneous/ismac.m create mode 100644 octave_packages/m/miscellaneous/ispc.m create mode 100644 octave_packages/m/miscellaneous/isunix.m create mode 100644 octave_packages/m/miscellaneous/license.m create mode 100644 octave_packages/m/miscellaneous/list_primes.m create mode 100644 octave_packages/m/miscellaneous/ls.m create mode 100644 octave_packages/m/miscellaneous/ls_command.m create mode 100644 octave_packages/m/miscellaneous/menu.m create mode 100644 octave_packages/m/miscellaneous/mex.m create mode 100644 octave_packages/m/miscellaneous/mexext.m create mode 100644 octave_packages/m/miscellaneous/mkoctfile.m create mode 100644 octave_packages/m/miscellaneous/movefile.m create mode 100644 octave_packages/m/miscellaneous/namelengthmax.m create mode 100644 octave_packages/m/miscellaneous/news.m create mode 100644 octave_packages/m/miscellaneous/orderfields.m create mode 100644 octave_packages/m/miscellaneous/pack.m create mode 100644 octave_packages/m/miscellaneous/paren.m create mode 100644 octave_packages/m/miscellaneous/parseparams.m create mode 100644 octave_packages/m/miscellaneous/perl.m create mode 100644 octave_packages/m/miscellaneous/private/__xzip__.m create mode 100644 octave_packages/m/miscellaneous/python.m create mode 100644 octave_packages/m/miscellaneous/recycle.m create mode 100644 octave_packages/m/miscellaneous/rmappdata.m create mode 100644 octave_packages/m/miscellaneous/run.m create mode 100644 octave_packages/m/miscellaneous/semicolon.m create mode 100644 octave_packages/m/miscellaneous/setappdata.m create mode 100644 octave_packages/m/miscellaneous/setfield.m create mode 100644 octave_packages/m/miscellaneous/substruct.m create mode 100644 octave_packages/m/miscellaneous/swapbytes.m create mode 100644 octave_packages/m/miscellaneous/symvar.m create mode 100644 octave_packages/m/miscellaneous/tar.m create mode 100644 octave_packages/m/miscellaneous/tempdir.m create mode 100644 octave_packages/m/miscellaneous/tempname.m create mode 100644 octave_packages/m/miscellaneous/unix.m create mode 100644 octave_packages/m/miscellaneous/unpack.m create mode 100644 octave_packages/m/miscellaneous/untar.m create mode 100644 octave_packages/m/miscellaneous/unzip.m create mode 100644 octave_packages/m/miscellaneous/usejava.m create mode 100644 octave_packages/m/miscellaneous/ver.m create mode 100644 octave_packages/m/miscellaneous/version.m create mode 100644 octave_packages/m/miscellaneous/warning_ids.m create mode 100644 octave_packages/m/miscellaneous/what.m create mode 100644 octave_packages/m/miscellaneous/xor.m create mode 100644 octave_packages/m/miscellaneous/zip.m create mode 100644 octave_packages/m/optimization/PKG_ADD create mode 100644 octave_packages/m/optimization/__all_opts__.m create mode 100644 octave_packages/m/optimization/fminbnd.m create mode 100644 octave_packages/m/optimization/fminunc.m create mode 100644 octave_packages/m/optimization/fsolve.m create mode 100644 octave_packages/m/optimization/fzero.m create mode 100644 octave_packages/m/optimization/glpk.m create mode 100644 octave_packages/m/optimization/lsqnonneg.m create mode 100644 octave_packages/m/optimization/optimget.m create mode 100644 octave_packages/m/optimization/optimset.m create mode 100644 octave_packages/m/optimization/pqpnonneg.m create mode 100644 octave_packages/m/optimization/private/__fdjac__.m create mode 100644 octave_packages/m/optimization/qp.m create mode 100644 octave_packages/m/optimization/sqp.m create mode 100644 octave_packages/m/path/matlabroot.m create mode 100644 octave_packages/m/path/pathdef.m create mode 100644 octave_packages/m/path/savepath.m create mode 100644 octave_packages/m/pkg/pkg.m create mode 100644 octave_packages/m/pkg/private/get_forge_pkg.m create mode 100644 octave_packages/m/plot/__gnuplot_drawnow__.m create mode 100644 octave_packages/m/plot/__plt_get_axis_arg__.m create mode 100644 octave_packages/m/plot/allchild.m create mode 100644 octave_packages/m/plot/ancestor.m create mode 100644 octave_packages/m/plot/area.m create mode 100644 octave_packages/m/plot/axes.m create mode 100644 octave_packages/m/plot/axis.m create mode 100644 octave_packages/m/plot/bar.m create mode 100644 octave_packages/m/plot/barh.m create mode 100644 octave_packages/m/plot/box.m create mode 100644 octave_packages/m/plot/caxis.m create mode 100644 octave_packages/m/plot/cla.m create mode 100644 octave_packages/m/plot/clabel.m create mode 100644 octave_packages/m/plot/clf.m create mode 100644 octave_packages/m/plot/close.m create mode 100644 octave_packages/m/plot/closereq.m create mode 100644 octave_packages/m/plot/colorbar.m create mode 100644 octave_packages/m/plot/colstyle.m create mode 100644 octave_packages/m/plot/comet.m create mode 100644 octave_packages/m/plot/comet3.m create mode 100644 octave_packages/m/plot/compass.m create mode 100644 octave_packages/m/plot/contour.m create mode 100644 octave_packages/m/plot/contour3.m create mode 100644 octave_packages/m/plot/contourc.m create mode 100644 octave_packages/m/plot/contourf.m create mode 100644 octave_packages/m/plot/cylinder.m create mode 100644 octave_packages/m/plot/daspect.m create mode 100644 octave_packages/m/plot/diffuse.m create mode 100644 octave_packages/m/plot/ellipsoid.m create mode 100644 octave_packages/m/plot/errorbar.m create mode 100644 octave_packages/m/plot/ezcontour.m create mode 100644 octave_packages/m/plot/ezcontourf.m create mode 100644 octave_packages/m/plot/ezmesh.m create mode 100644 octave_packages/m/plot/ezmeshc.m create mode 100644 octave_packages/m/plot/ezplot.m create mode 100644 octave_packages/m/plot/ezplot3.m create mode 100644 octave_packages/m/plot/ezpolar.m create mode 100644 octave_packages/m/plot/ezsurf.m create mode 100644 octave_packages/m/plot/ezsurfc.m create mode 100644 octave_packages/m/plot/feather.m create mode 100644 octave_packages/m/plot/figure.m create mode 100644 octave_packages/m/plot/fill.m create mode 100644 octave_packages/m/plot/findall.m create mode 100644 octave_packages/m/plot/findobj.m create mode 100644 octave_packages/m/plot/fplot.m create mode 100644 octave_packages/m/plot/gca.m create mode 100644 octave_packages/m/plot/gcbf.m create mode 100644 octave_packages/m/plot/gcbo.m create mode 100644 octave_packages/m/plot/gcf.m create mode 100644 octave_packages/m/plot/ginput.m create mode 100644 octave_packages/m/plot/gnuplot_binary.m create mode 100644 octave_packages/m/plot/graphics_toolkit.m create mode 100644 octave_packages/m/plot/grid.m create mode 100644 octave_packages/m/plot/gtext.m create mode 100644 octave_packages/m/plot/guidata.m create mode 100644 octave_packages/m/plot/guihandles.m create mode 100644 octave_packages/m/plot/hggroup.m create mode 100644 octave_packages/m/plot/hidden.m create mode 100644 octave_packages/m/plot/hist.m create mode 100644 octave_packages/m/plot/hold.m create mode 100644 octave_packages/m/plot/isfigure.m create mode 100644 octave_packages/m/plot/ishghandle.m create mode 100644 octave_packages/m/plot/ishold.m create mode 100644 octave_packages/m/plot/isocolors.m create mode 100644 octave_packages/m/plot/isonormals.m create mode 100644 octave_packages/m/plot/isosurface.m create mode 100644 octave_packages/m/plot/isprop.m create mode 100644 octave_packages/m/plot/legend.m create mode 100644 octave_packages/m/plot/line.m create mode 100644 octave_packages/m/plot/linkprop.m create mode 100644 octave_packages/m/plot/loglog.m create mode 100644 octave_packages/m/plot/loglogerr.m create mode 100644 octave_packages/m/plot/mesh.m create mode 100644 octave_packages/m/plot/meshc.m create mode 100644 octave_packages/m/plot/meshgrid.m create mode 100644 octave_packages/m/plot/meshz.m create mode 100644 octave_packages/m/plot/ndgrid.m create mode 100644 octave_packages/m/plot/newplot.m create mode 100644 octave_packages/m/plot/orient.m create mode 100644 octave_packages/m/plot/pareto.m create mode 100644 octave_packages/m/plot/patch.m create mode 100644 octave_packages/m/plot/pbaspect.m create mode 100644 octave_packages/m/plot/pcolor.m create mode 100644 octave_packages/m/plot/peaks.m create mode 100644 octave_packages/m/plot/pie.m create mode 100644 octave_packages/m/plot/pie3.m create mode 100644 octave_packages/m/plot/plot.m create mode 100644 octave_packages/m/plot/plot3.m create mode 100644 octave_packages/m/plot/plotmatrix.m create mode 100644 octave_packages/m/plot/plotyy.m create mode 100644 octave_packages/m/plot/polar.m create mode 100644 octave_packages/m/plot/print.m create mode 100644 octave_packages/m/plot/private/__actual_axis_position__.m create mode 100644 octave_packages/m/plot/private/__add_datasource__.m create mode 100644 octave_packages/m/plot/private/__add_default_menu__.m create mode 100644 octave_packages/m/plot/private/__axes_limits__.m create mode 100644 octave_packages/m/plot/private/__axis_label__.m create mode 100644 octave_packages/m/plot/private/__bar__.m create mode 100644 octave_packages/m/plot/private/__clabel__.m create mode 100644 octave_packages/m/plot/private/__color_str_rgb__.m create mode 100644 octave_packages/m/plot/private/__contour__.m create mode 100644 octave_packages/m/plot/private/__default_plot_options__.m create mode 100644 octave_packages/m/plot/private/__errcomm__.m create mode 100644 octave_packages/m/plot/private/__errplot__.m create mode 100644 octave_packages/m/plot/private/__ezplot__.m create mode 100644 octave_packages/m/plot/private/__file_filter__.m create mode 100644 octave_packages/m/plot/private/__fltk_file_filter__.m create mode 100644 octave_packages/m/plot/private/__fltk_ginput__.m create mode 100644 octave_packages/m/plot/private/__fltk_print__.m create mode 100644 octave_packages/m/plot/private/__getlegenddata__.m create mode 100644 octave_packages/m/plot/private/__ghostscript__.m create mode 100644 octave_packages/m/plot/private/__gnuplot_get_var__.m create mode 100644 octave_packages/m/plot/private/__gnuplot_ginput__.m create mode 100644 octave_packages/m/plot/private/__gnuplot_has_feature__.m create mode 100644 octave_packages/m/plot/private/__gnuplot_has_terminal__.m create mode 100644 octave_packages/m/plot/private/__gnuplot_open_stream__.m create mode 100644 octave_packages/m/plot/private/__gnuplot_print__.m create mode 100644 octave_packages/m/plot/private/__gnuplot_version__.m create mode 100644 octave_packages/m/plot/private/__go_draw_axes__.m create mode 100644 octave_packages/m/plot/private/__go_draw_figure__.m create mode 100644 octave_packages/m/plot/private/__interp_cube__.m create mode 100644 octave_packages/m/plot/private/__is_function__.m create mode 100644 octave_packages/m/plot/private/__line__.m create mode 100644 octave_packages/m/plot/private/__marching_cube__.m create mode 100644 octave_packages/m/plot/private/__next_line_color__.m create mode 100644 octave_packages/m/plot/private/__next_line_style__.m create mode 100644 octave_packages/m/plot/private/__patch__.m create mode 100644 octave_packages/m/plot/private/__pie__.m create mode 100644 octave_packages/m/plot/private/__plt__.m create mode 100644 octave_packages/m/plot/private/__pltopt__.m create mode 100644 octave_packages/m/plot/private/__print_parse_opts__.m create mode 100644 octave_packages/m/plot/private/__quiver__.m create mode 100644 octave_packages/m/plot/private/__scatter__.m create mode 100644 octave_packages/m/plot/private/__stem__.m create mode 100644 octave_packages/m/plot/private/__tight_eps_bbox__.m create mode 100644 octave_packages/m/plot/private/__uigetdir_fltk__.m create mode 100644 octave_packages/m/plot/private/__uigetfile_fltk__.m create mode 100644 octave_packages/m/plot/private/__uiobject_split_args__.m create mode 100644 octave_packages/m/plot/private/__uiputfile_fltk__.m create mode 100644 octave_packages/m/plot/quiver.m create mode 100644 octave_packages/m/plot/quiver3.m create mode 100644 octave_packages/m/plot/rectangle.m create mode 100644 octave_packages/m/plot/refresh.m create mode 100644 octave_packages/m/plot/refreshdata.m create mode 100644 octave_packages/m/plot/ribbon.m create mode 100644 octave_packages/m/plot/rose.m create mode 100644 octave_packages/m/plot/saveas.m create mode 100644 octave_packages/m/plot/scatter.m create mode 100644 octave_packages/m/plot/scatter3.m create mode 100644 octave_packages/m/plot/semilogx.m create mode 100644 octave_packages/m/plot/semilogxerr.m create mode 100644 octave_packages/m/plot/semilogy.m create mode 100644 octave_packages/m/plot/semilogyerr.m create mode 100644 octave_packages/m/plot/shading.m create mode 100644 octave_packages/m/plot/shg.m create mode 100644 octave_packages/m/plot/slice.m create mode 100644 octave_packages/m/plot/sombrero.m create mode 100644 octave_packages/m/plot/specular.m create mode 100644 octave_packages/m/plot/sphere.m create mode 100644 octave_packages/m/plot/spinmap.m create mode 100644 octave_packages/m/plot/stairs.m create mode 100644 octave_packages/m/plot/stem.m create mode 100644 octave_packages/m/plot/stem3.m create mode 100644 octave_packages/m/plot/subplot.m create mode 100644 octave_packages/m/plot/surf.m create mode 100644 octave_packages/m/plot/surface.m create mode 100644 octave_packages/m/plot/surfc.m create mode 100644 octave_packages/m/plot/surfl.m create mode 100644 octave_packages/m/plot/surfnorm.m create mode 100644 octave_packages/m/plot/text.m create mode 100644 octave_packages/m/plot/title.m create mode 100644 octave_packages/m/plot/trimesh.m create mode 100644 octave_packages/m/plot/triplot.m create mode 100644 octave_packages/m/plot/trisurf.m create mode 100644 octave_packages/m/plot/uicontextmenu.m create mode 100644 octave_packages/m/plot/uicontrol.m create mode 100644 octave_packages/m/plot/uigetdir.m create mode 100644 octave_packages/m/plot/uigetfile.m create mode 100644 octave_packages/m/plot/uimenu.m create mode 100644 octave_packages/m/plot/uipanel.m create mode 100644 octave_packages/m/plot/uipushtool.m create mode 100644 octave_packages/m/plot/uiputfile.m create mode 100644 octave_packages/m/plot/uiresume.m create mode 100644 octave_packages/m/plot/uitoggletool.m create mode 100644 octave_packages/m/plot/uitoolbar.m create mode 100644 octave_packages/m/plot/uiwait.m create mode 100644 octave_packages/m/plot/view.m create mode 100644 octave_packages/m/plot/waitbar.m create mode 100644 octave_packages/m/plot/waitforbuttonpress.m create mode 100644 octave_packages/m/plot/whitebg.m create mode 100644 octave_packages/m/plot/xlabel.m create mode 100644 octave_packages/m/plot/xlim.m create mode 100644 octave_packages/m/plot/ylabel.m create mode 100644 octave_packages/m/plot/ylim.m create mode 100644 octave_packages/m/plot/zlabel.m create mode 100644 octave_packages/m/plot/zlim.m create mode 100644 octave_packages/m/polynomial/compan.m create mode 100644 octave_packages/m/polynomial/conv.m create mode 100644 octave_packages/m/polynomial/deconv.m create mode 100644 octave_packages/m/polynomial/mkpp.m create mode 100644 octave_packages/m/polynomial/mpoles.m create mode 100644 octave_packages/m/polynomial/pchip.m create mode 100644 octave_packages/m/polynomial/poly.m create mode 100644 octave_packages/m/polynomial/polyaffine.m create mode 100644 octave_packages/m/polynomial/polyder.m create mode 100644 octave_packages/m/polynomial/polyfit.m create mode 100644 octave_packages/m/polynomial/polygcd.m create mode 100644 octave_packages/m/polynomial/polyint.m create mode 100644 octave_packages/m/polynomial/polyout.m create mode 100644 octave_packages/m/polynomial/polyreduce.m create mode 100644 octave_packages/m/polynomial/polyval.m create mode 100644 octave_packages/m/polynomial/polyvalm.m create mode 100644 octave_packages/m/polynomial/ppder.m create mode 100644 octave_packages/m/polynomial/ppint.m create mode 100644 octave_packages/m/polynomial/ppjumps.m create mode 100644 octave_packages/m/polynomial/ppval.m create mode 100644 octave_packages/m/polynomial/residue.m create mode 100644 octave_packages/m/polynomial/roots.m create mode 100644 octave_packages/m/polynomial/spline.m create mode 100644 octave_packages/m/polynomial/unmkpp.m create mode 100644 octave_packages/m/prefs/addpref.m create mode 100644 octave_packages/m/prefs/getpref.m create mode 100644 octave_packages/m/prefs/ispref.m create mode 100644 octave_packages/m/prefs/private/loadprefs.m create mode 100644 octave_packages/m/prefs/private/prefsfile.m create mode 100644 octave_packages/m/prefs/private/saveprefs.m create mode 100644 octave_packages/m/prefs/rmpref.m create mode 100644 octave_packages/m/prefs/setpref.m create mode 100644 octave_packages/m/set/intersect.m create mode 100644 octave_packages/m/set/ismember.m create mode 100644 octave_packages/m/set/powerset.m create mode 100644 octave_packages/m/set/private/validargs.m create mode 100644 octave_packages/m/set/setdiff.m create mode 100644 octave_packages/m/set/setxor.m create mode 100644 octave_packages/m/set/union.m create mode 100644 octave_packages/m/set/unique.m create mode 100644 octave_packages/m/signal/arch_fit.m create mode 100644 octave_packages/m/signal/arch_rnd.m create mode 100644 octave_packages/m/signal/arch_test.m create mode 100644 octave_packages/m/signal/arma_rnd.m create mode 100644 octave_packages/m/signal/autoreg_matrix.m create mode 100644 octave_packages/m/signal/bartlett.m create mode 100644 octave_packages/m/signal/blackman.m create mode 100644 octave_packages/m/signal/detrend.m create mode 100644 octave_packages/m/signal/diffpara.m create mode 100644 octave_packages/m/signal/durbinlevinson.m create mode 100644 octave_packages/m/signal/fftconv.m create mode 100644 octave_packages/m/signal/fftfilt.m create mode 100644 octave_packages/m/signal/fftshift.m create mode 100644 octave_packages/m/signal/filter2.m create mode 100644 octave_packages/m/signal/fractdiff.m create mode 100644 octave_packages/m/signal/freqz.m create mode 100644 octave_packages/m/signal/freqz_plot.m create mode 100644 octave_packages/m/signal/hamming.m create mode 100644 octave_packages/m/signal/hanning.m create mode 100644 octave_packages/m/signal/hurst.m create mode 100644 octave_packages/m/signal/ifftshift.m create mode 100644 octave_packages/m/signal/periodogram.m create mode 100644 octave_packages/m/signal/private/rectangle_lw.m create mode 100644 octave_packages/m/signal/private/rectangle_sw.m create mode 100644 octave_packages/m/signal/private/triangle_lw.m create mode 100644 octave_packages/m/signal/private/triangle_sw.m create mode 100644 octave_packages/m/signal/sinc.m create mode 100644 octave_packages/m/signal/sinetone.m create mode 100644 octave_packages/m/signal/sinewave.m create mode 100644 octave_packages/m/signal/spectral_adf.m create mode 100644 octave_packages/m/signal/spectral_xdf.m create mode 100644 octave_packages/m/signal/spencer.m create mode 100644 octave_packages/m/signal/stft.m create mode 100644 octave_packages/m/signal/synthesis.m create mode 100644 octave_packages/m/signal/unwrap.m create mode 100644 octave_packages/m/signal/yulewalker.m create mode 100644 octave_packages/m/sparse/bicg.m create mode 100644 octave_packages/m/sparse/bicgstab.m create mode 100644 octave_packages/m/sparse/cgs.m create mode 100644 octave_packages/m/sparse/colperm.m create mode 100644 octave_packages/m/sparse/etreeplot.m create mode 100644 octave_packages/m/sparse/gmres.m create mode 100644 octave_packages/m/sparse/gplot.m create mode 100644 octave_packages/m/sparse/nonzeros.m create mode 100644 octave_packages/m/sparse/pcg.m create mode 100644 octave_packages/m/sparse/pcr.m create mode 100644 octave_packages/m/sparse/private/__sprand_impl__.m create mode 100644 octave_packages/m/sparse/spaugment.m create mode 100644 octave_packages/m/sparse/spconvert.m create mode 100644 octave_packages/m/sparse/spdiags.m create mode 100644 octave_packages/m/sparse/speye.m create mode 100644 octave_packages/m/sparse/spfun.m create mode 100644 octave_packages/m/sparse/spones.m create mode 100644 octave_packages/m/sparse/sprand.m create mode 100644 octave_packages/m/sparse/sprandn.m create mode 100644 octave_packages/m/sparse/sprandsym.m create mode 100644 octave_packages/m/sparse/spstats.m create mode 100644 octave_packages/m/sparse/spy.m create mode 100644 octave_packages/m/sparse/svds.m create mode 100644 octave_packages/m/sparse/treelayout.m create mode 100644 octave_packages/m/sparse/treeplot.m create mode 100644 octave_packages/m/specfun/bessel.m create mode 100644 octave_packages/m/specfun/beta.m create mode 100644 octave_packages/m/specfun/betaln.m create mode 100644 octave_packages/m/specfun/factor.m create mode 100644 octave_packages/m/specfun/factorial.m create mode 100644 octave_packages/m/specfun/isprime.m create mode 100644 octave_packages/m/specfun/lcm.m create mode 100644 octave_packages/m/specfun/legendre.m create mode 100644 octave_packages/m/specfun/nchoosek.m create mode 100644 octave_packages/m/specfun/nthroot.m create mode 100644 octave_packages/m/specfun/perms.m create mode 100644 octave_packages/m/specfun/pow2.m create mode 100644 octave_packages/m/specfun/primes.m create mode 100644 octave_packages/m/specfun/reallog.m create mode 100644 octave_packages/m/specfun/realpow.m create mode 100644 octave_packages/m/specfun/realsqrt.m create mode 100644 octave_packages/m/special-matrix/hadamard.m create mode 100644 octave_packages/m/special-matrix/hankel.m create mode 100644 octave_packages/m/special-matrix/hilb.m create mode 100644 octave_packages/m/special-matrix/invhilb.m create mode 100644 octave_packages/m/special-matrix/magic.m create mode 100644 octave_packages/m/special-matrix/pascal.m create mode 100644 octave_packages/m/special-matrix/rosser.m create mode 100644 octave_packages/m/special-matrix/toeplitz.m create mode 100644 octave_packages/m/special-matrix/vander.m create mode 100644 octave_packages/m/special-matrix/wilkinson.m create mode 100644 octave_packages/m/startup/__finish__.m create mode 100644 octave_packages/m/startup/inputrc create mode 100644 octave_packages/m/statistics/base/center.m create mode 100644 octave_packages/m/statistics/base/cloglog.m create mode 100644 octave_packages/m/statistics/base/corr.m create mode 100644 octave_packages/m/statistics/base/cov.m create mode 100644 octave_packages/m/statistics/base/gls.m create mode 100644 octave_packages/m/statistics/base/histc.m create mode 100644 octave_packages/m/statistics/base/iqr.m create mode 100644 octave_packages/m/statistics/base/kendall.m create mode 100644 octave_packages/m/statistics/base/kurtosis.m create mode 100644 octave_packages/m/statistics/base/logit.m create mode 100644 octave_packages/m/statistics/base/mahalanobis.m create mode 100644 octave_packages/m/statistics/base/mean.m create mode 100644 octave_packages/m/statistics/base/meansq.m create mode 100644 octave_packages/m/statistics/base/median.m create mode 100644 octave_packages/m/statistics/base/mode.m create mode 100644 octave_packages/m/statistics/base/moment.m create mode 100644 octave_packages/m/statistics/base/ols.m create mode 100644 octave_packages/m/statistics/base/ppplot.m create mode 100644 octave_packages/m/statistics/base/prctile.m create mode 100644 octave_packages/m/statistics/base/probit.m create mode 100644 octave_packages/m/statistics/base/qqplot.m create mode 100644 octave_packages/m/statistics/base/quantile.m create mode 100644 octave_packages/m/statistics/base/range.m create mode 100644 octave_packages/m/statistics/base/ranks.m create mode 100644 octave_packages/m/statistics/base/run_count.m create mode 100644 octave_packages/m/statistics/base/runlength.m create mode 100644 octave_packages/m/statistics/base/skewness.m create mode 100644 octave_packages/m/statistics/base/spearman.m create mode 100644 octave_packages/m/statistics/base/statistics.m create mode 100644 octave_packages/m/statistics/base/std.m create mode 100644 octave_packages/m/statistics/base/table.m create mode 100644 octave_packages/m/statistics/base/var.m create mode 100644 octave_packages/m/statistics/base/zscore.m create mode 100644 octave_packages/m/statistics/distributions/betacdf.m create mode 100644 octave_packages/m/statistics/distributions/betainv.m create mode 100644 octave_packages/m/statistics/distributions/betapdf.m create mode 100644 octave_packages/m/statistics/distributions/betarnd.m create mode 100644 octave_packages/m/statistics/distributions/binocdf.m create mode 100644 octave_packages/m/statistics/distributions/binoinv.m create mode 100644 octave_packages/m/statistics/distributions/binopdf.m create mode 100644 octave_packages/m/statistics/distributions/binornd.m create mode 100644 octave_packages/m/statistics/distributions/cauchy_cdf.m create mode 100644 octave_packages/m/statistics/distributions/cauchy_inv.m create mode 100644 octave_packages/m/statistics/distributions/cauchy_pdf.m create mode 100644 octave_packages/m/statistics/distributions/cauchy_rnd.m create mode 100644 octave_packages/m/statistics/distributions/chi2cdf.m create mode 100644 octave_packages/m/statistics/distributions/chi2inv.m create mode 100644 octave_packages/m/statistics/distributions/chi2pdf.m create mode 100644 octave_packages/m/statistics/distributions/chi2rnd.m create mode 100644 octave_packages/m/statistics/distributions/discrete_cdf.m create mode 100644 octave_packages/m/statistics/distributions/discrete_inv.m create mode 100644 octave_packages/m/statistics/distributions/discrete_pdf.m create mode 100644 octave_packages/m/statistics/distributions/discrete_rnd.m create mode 100644 octave_packages/m/statistics/distributions/empirical_cdf.m create mode 100644 octave_packages/m/statistics/distributions/empirical_inv.m create mode 100644 octave_packages/m/statistics/distributions/empirical_pdf.m create mode 100644 octave_packages/m/statistics/distributions/empirical_rnd.m create mode 100644 octave_packages/m/statistics/distributions/expcdf.m create mode 100644 octave_packages/m/statistics/distributions/expinv.m create mode 100644 octave_packages/m/statistics/distributions/exppdf.m create mode 100644 octave_packages/m/statistics/distributions/exprnd.m create mode 100644 octave_packages/m/statistics/distributions/fcdf.m create mode 100644 octave_packages/m/statistics/distributions/finv.m create mode 100644 octave_packages/m/statistics/distributions/fpdf.m create mode 100644 octave_packages/m/statistics/distributions/frnd.m create mode 100644 octave_packages/m/statistics/distributions/gamcdf.m create mode 100644 octave_packages/m/statistics/distributions/gaminv.m create mode 100644 octave_packages/m/statistics/distributions/gampdf.m create mode 100644 octave_packages/m/statistics/distributions/gamrnd.m create mode 100644 octave_packages/m/statistics/distributions/geocdf.m create mode 100644 octave_packages/m/statistics/distributions/geoinv.m create mode 100644 octave_packages/m/statistics/distributions/geopdf.m create mode 100644 octave_packages/m/statistics/distributions/geornd.m create mode 100644 octave_packages/m/statistics/distributions/hygecdf.m create mode 100644 octave_packages/m/statistics/distributions/hygeinv.m create mode 100644 octave_packages/m/statistics/distributions/hygepdf.m create mode 100644 octave_packages/m/statistics/distributions/hygernd.m create mode 100644 octave_packages/m/statistics/distributions/kolmogorov_smirnov_cdf.m create mode 100644 octave_packages/m/statistics/distributions/laplace_cdf.m create mode 100644 octave_packages/m/statistics/distributions/laplace_inv.m create mode 100644 octave_packages/m/statistics/distributions/laplace_pdf.m create mode 100644 octave_packages/m/statistics/distributions/laplace_rnd.m create mode 100644 octave_packages/m/statistics/distributions/logistic_cdf.m create mode 100644 octave_packages/m/statistics/distributions/logistic_inv.m create mode 100644 octave_packages/m/statistics/distributions/logistic_pdf.m create mode 100644 octave_packages/m/statistics/distributions/logistic_rnd.m create mode 100644 octave_packages/m/statistics/distributions/logncdf.m create mode 100644 octave_packages/m/statistics/distributions/logninv.m create mode 100644 octave_packages/m/statistics/distributions/lognpdf.m create mode 100644 octave_packages/m/statistics/distributions/lognrnd.m create mode 100644 octave_packages/m/statistics/distributions/nbincdf.m create mode 100644 octave_packages/m/statistics/distributions/nbininv.m create mode 100644 octave_packages/m/statistics/distributions/nbinpdf.m create mode 100644 octave_packages/m/statistics/distributions/nbinrnd.m create mode 100644 octave_packages/m/statistics/distributions/normcdf.m create mode 100644 octave_packages/m/statistics/distributions/norminv.m create mode 100644 octave_packages/m/statistics/distributions/normpdf.m create mode 100644 octave_packages/m/statistics/distributions/normrnd.m create mode 100644 octave_packages/m/statistics/distributions/poisscdf.m create mode 100644 octave_packages/m/statistics/distributions/poissinv.m create mode 100644 octave_packages/m/statistics/distributions/poisspdf.m create mode 100644 octave_packages/m/statistics/distributions/poissrnd.m create mode 100644 octave_packages/m/statistics/distributions/stdnormal_cdf.m create mode 100644 octave_packages/m/statistics/distributions/stdnormal_inv.m create mode 100644 octave_packages/m/statistics/distributions/stdnormal_pdf.m create mode 100644 octave_packages/m/statistics/distributions/stdnormal_rnd.m create mode 100644 octave_packages/m/statistics/distributions/tcdf.m create mode 100644 octave_packages/m/statistics/distributions/tinv.m create mode 100644 octave_packages/m/statistics/distributions/tpdf.m create mode 100644 octave_packages/m/statistics/distributions/trnd.m create mode 100644 octave_packages/m/statistics/distributions/unidcdf.m create mode 100644 octave_packages/m/statistics/distributions/unidinv.m create mode 100644 octave_packages/m/statistics/distributions/unidpdf.m create mode 100644 octave_packages/m/statistics/distributions/unidrnd.m create mode 100644 octave_packages/m/statistics/distributions/unifcdf.m create mode 100644 octave_packages/m/statistics/distributions/unifinv.m create mode 100644 octave_packages/m/statistics/distributions/unifpdf.m create mode 100644 octave_packages/m/statistics/distributions/unifrnd.m create mode 100644 octave_packages/m/statistics/distributions/wblcdf.m create mode 100644 octave_packages/m/statistics/distributions/wblinv.m create mode 100644 octave_packages/m/statistics/distributions/wblpdf.m create mode 100644 octave_packages/m/statistics/distributions/wblrnd.m create mode 100644 octave_packages/m/statistics/distributions/wienrnd.m create mode 100644 octave_packages/m/statistics/models/logistic_regression.m create mode 100644 octave_packages/m/statistics/models/private/logistic_regression_derivatives.m create mode 100644 octave_packages/m/statistics/models/private/logistic_regression_likelihood.m create mode 100644 octave_packages/m/statistics/tests/anova.m create mode 100644 octave_packages/m/statistics/tests/bartlett_test.m create mode 100644 octave_packages/m/statistics/tests/chisquare_test_homogeneity.m create mode 100644 octave_packages/m/statistics/tests/chisquare_test_independence.m create mode 100644 octave_packages/m/statistics/tests/cor_test.m create mode 100644 octave_packages/m/statistics/tests/f_test_regression.m create mode 100644 octave_packages/m/statistics/tests/hotelling_test.m create mode 100644 octave_packages/m/statistics/tests/hotelling_test_2.m create mode 100644 octave_packages/m/statistics/tests/kolmogorov_smirnov_test.m create mode 100644 octave_packages/m/statistics/tests/kolmogorov_smirnov_test_2.m create mode 100644 octave_packages/m/statistics/tests/kruskal_wallis_test.m create mode 100644 octave_packages/m/statistics/tests/manova.m create mode 100644 octave_packages/m/statistics/tests/mcnemar_test.m create mode 100644 octave_packages/m/statistics/tests/prop_test_2.m create mode 100644 octave_packages/m/statistics/tests/run_test.m create mode 100644 octave_packages/m/statistics/tests/sign_test.m create mode 100644 octave_packages/m/statistics/tests/t_test.m create mode 100644 octave_packages/m/statistics/tests/t_test_2.m create mode 100644 octave_packages/m/statistics/tests/t_test_regression.m create mode 100644 octave_packages/m/statistics/tests/u_test.m create mode 100644 octave_packages/m/statistics/tests/var_test.m create mode 100644 octave_packages/m/statistics/tests/welch_test.m create mode 100644 octave_packages/m/statistics/tests/wilcoxon_test.m create mode 100644 octave_packages/m/statistics/tests/z_test.m create mode 100644 octave_packages/m/statistics/tests/z_test_2.m create mode 100644 octave_packages/m/strings/base2dec.m create mode 100644 octave_packages/m/strings/bin2dec.m create mode 100644 octave_packages/m/strings/blanks.m create mode 100644 octave_packages/m/strings/cstrcat.m create mode 100644 octave_packages/m/strings/deblank.m create mode 100644 octave_packages/m/strings/dec2base.m create mode 100644 octave_packages/m/strings/dec2bin.m create mode 100644 octave_packages/m/strings/dec2hex.m create mode 100644 octave_packages/m/strings/findstr.m create mode 100644 octave_packages/m/strings/hex2dec.m create mode 100644 octave_packages/m/strings/index.m create mode 100644 octave_packages/m/strings/isletter.m create mode 100644 octave_packages/m/strings/isstrprop.m create mode 100644 octave_packages/m/strings/mat2str.m create mode 100644 octave_packages/m/strings/regexptranslate.m create mode 100644 octave_packages/m/strings/rindex.m create mode 100644 octave_packages/m/strings/str2num.m create mode 100644 octave_packages/m/strings/strcat.m create mode 100644 octave_packages/m/strings/strchr.m create mode 100644 octave_packages/m/strings/strjust.m create mode 100644 octave_packages/m/strings/strmatch.m create mode 100644 octave_packages/m/strings/strsplit.m create mode 100644 octave_packages/m/strings/strtok.m create mode 100644 octave_packages/m/strings/strtrim.m create mode 100644 octave_packages/m/strings/strtrunc.m create mode 100644 octave_packages/m/strings/substr.m create mode 100644 octave_packages/m/strings/untabify.m create mode 100644 octave_packages/m/strings/validatestring.m create mode 100644 octave_packages/m/testfun/assert.m create mode 100644 octave_packages/m/testfun/demo.m create mode 100644 octave_packages/m/testfun/example.m create mode 100644 octave_packages/m/testfun/fail.m create mode 100644 octave_packages/m/testfun/rundemos.m create mode 100644 octave_packages/m/testfun/runtests.m create mode 100644 octave_packages/m/testfun/speed.m create mode 100644 octave_packages/m/testfun/test.m create mode 100644 octave_packages/m/time/addtodate.m create mode 100644 octave_packages/m/time/asctime.m create mode 100644 octave_packages/m/time/calendar.m create mode 100644 octave_packages/m/time/clock.m create mode 100644 octave_packages/m/time/ctime.m create mode 100644 octave_packages/m/time/date.m create mode 100644 octave_packages/m/time/datenum.m create mode 100644 octave_packages/m/time/datestr.m create mode 100644 octave_packages/m/time/datetick.m create mode 100644 octave_packages/m/time/datevec.m create mode 100644 octave_packages/m/time/eomday.m create mode 100644 octave_packages/m/time/etime.m create mode 100644 octave_packages/m/time/is_leap_year.m create mode 100644 octave_packages/m/time/now.m create mode 100644 octave_packages/m/time/weekday.m diff --git a/octave_packages/m/@ftp/ascii.m b/octave_packages/m/@ftp/ascii.m new file mode 100644 index 0000000..0f8af58 --- /dev/null +++ b/octave_packages/m/@ftp/ascii.m @@ -0,0 +1,27 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ascii (@var{f}) +## Put the FTP connection @var{f} into ascii mode. +## @var{f} is an FTP object returned by the @code{ftp} function. +## @end deftypefn + +function ascii (f) + __ftp_ascii__ (f.curlhandle); +endfunction diff --git a/octave_packages/m/@ftp/binary.m b/octave_packages/m/@ftp/binary.m new file mode 100644 index 0000000..3900b46 --- /dev/null +++ b/octave_packages/m/@ftp/binary.m @@ -0,0 +1,27 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} binary (@var{f}) +## Put the FTP connection @var{f} into binary mode. +## @var{f} is an FTP object returned by the @code{ftp} function. +## @end deftypefn + +function binary (f) + __ftp_binary__ (f.curlhandle); +endfunction diff --git a/octave_packages/m/@ftp/cd.m b/octave_packages/m/@ftp/cd.m new file mode 100644 index 0000000..808873d --- /dev/null +++ b/octave_packages/m/@ftp/cd.m @@ -0,0 +1,27 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cd (@var{f}, @var{path}) +## Set the remote directory to @var{path} on the FTP connection @var{f}. +## @var{f} is an FTP object returned by the @code{ftp} function. +## @end deftypefn + +function cd (f, path) + __ftp_cwd__ (f.curlhandle, path); +endfunction diff --git a/octave_packages/m/@ftp/close.m b/octave_packages/m/@ftp/close.m new file mode 100644 index 0000000..abf4379 --- /dev/null +++ b/octave_packages/m/@ftp/close.m @@ -0,0 +1,27 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} close (@var{f}) +## Close the FTP connection represented by the given FTP object @var{f}. +## @var{f} is an FTP object returned by the @code{ftp} function. +## @end deftypefn + +function dir (f) + __ftp_close__ (f.curlhandle); +endfunction diff --git a/octave_packages/m/@ftp/delete.m b/octave_packages/m/@ftp/delete.m new file mode 100644 index 0000000..076ad8f --- /dev/null +++ b/octave_packages/m/@ftp/delete.m @@ -0,0 +1,27 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} delete (@var{f}, @var{file}) +## Delete the remote file @var{file}, over the FTP connection @var{f}. +## @var{f} is an FTP object returned by the @code{ftp} function. +## @end deftypefn + +function delete (f, file) + __ftp_delete__ (f.curlhandle, file); +endfunction diff --git a/octave_packages/m/@ftp/dir.m b/octave_packages/m/@ftp/dir.m new file mode 100644 index 0000000..0a3f6b8 --- /dev/null +++ b/octave_packages/m/@ftp/dir.m @@ -0,0 +1,31 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{lst} =} dir (@var{f}) +## List the current directory in verbose form for the FTP connection +## @var{f}. @var{f} is an FTP object returned by the @code{ftp} function. +## @end deftypefn + +function lst = dir (f) + if (nargout == 0) + __ftp_dir__ (f.curlhandle); + else + lst = __ftp_dir__ (f.curlhandle); + endif +endfunction diff --git a/octave_packages/m/@ftp/display.m b/octave_packages/m/@ftp/display.m new file mode 100644 index 0000000..e395cb8 --- /dev/null +++ b/octave_packages/m/@ftp/display.m @@ -0,0 +1,25 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function display (obj) + printf ("FTP Object\n"); + printf (" host: %s\n", obj.host); + printf (" user: %s\n", obj.username); + printf (" dir: %s\n", __ftp_pwd__ (obj.curlhandle)); + printf (" mode: %s\n", __ftp_mode__ (obj.curlhandle)); +endfunction \ No newline at end of file diff --git a/octave_packages/m/@ftp/ftp.m b/octave_packages/m/@ftp/ftp.m new file mode 100644 index 0000000..39004ae --- /dev/null +++ b/octave_packages/m/@ftp/ftp.m @@ -0,0 +1,45 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{f} =} ftp (@var{host}) +## @deftypefnx {Function File} {@var{f} =} ftp (@var{host}, @var{username}, @var{password}) +## Connect to the FTP server @var{host} with @var{username} and @var{password}. +## If @var{username} and @var{password} are not specified, user "anonymous" +## with no password is used. The returned FTP object @var{f} represents the +## established FTP connection. +## @end deftypefn + +function obj = ftp (host, username = "anonymous", password = "") + if (nargin == 0) + p.host = ""; + p.username = username; + p.password = password; + p.curlhandle = tmpnam ("ftp-"); + obj = class (p, "ftp"); + elseif (nargin == 1 && strcmp (class (host), "ftp")) + obj = host; + else + p.host = host; + p.username = username; + p.password = password; + p.curlhandle = tmpnam ("ftp-"); + __ftp__ (p.curlhandle, host, username, password); + obj = class (p, "ftp"); + endif +endfunction diff --git a/octave_packages/m/@ftp/loadobj.m b/octave_packages/m/@ftp/loadobj.m new file mode 100644 index 0000000..313990a --- /dev/null +++ b/octave_packages/m/@ftp/loadobj.m @@ -0,0 +1,36 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function b = loadobj (a) + b = a; + if (isfield (b, "jobject")) + b = rmfield (b, "jobject"); + endif + b.curlhandle = tmpnam ("ftp-"); + __ftp__ (b.curlhandle, b.host, b.username, b.password); + if (isfield (b, "dir")) + if (! isempty (b.dir)) + __ftp_cwd__ (b.curlhandle, b.dir); + endif + b = rmfield (b, "dir"); + elseif (isfield (b, "remotePwd")) + ## FIXME: Can we read matlab java stringBuffer objects? + warning ("can not change remote directory in loqded FTP object"); + b = rmfield (b, "remotePwd"); + endif +endfunction diff --git a/octave_packages/m/@ftp/mget.m b/octave_packages/m/@ftp/mget.m new file mode 100644 index 0000000..74bf5e3 --- /dev/null +++ b/octave_packages/m/@ftp/mget.m @@ -0,0 +1,37 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mget (@var{f}, @var{file}) +## @deftypefnx {Function File} {} mget (@var{f}, @var{dir}) +## @deftypefnx {Function File} {} mget (@dots{}, @var{target}) +## Download a remote file @var{file} or directory @var{dir} to the local +## directory on the FTP connection @var{f}. @var{f} is an FTP object +## returned by the @code{ftp} function. +## +## The arguments @var{file} and @var{dir} can include wildcards and any +## files or directories on the remote server that match will be downloaded. +## +## If a third argument @var{target} is given, then a single file or +## directory will be downloaded with the name @var{target} to the local +## directory. +## @end deftypefn + +function mget (f, file) + __ftp_mget__ (f.curlhandle, file); +endfunction diff --git a/octave_packages/m/@ftp/mkdir.m b/octave_packages/m/@ftp/mkdir.m new file mode 100644 index 0000000..6cdfc56 --- /dev/null +++ b/octave_packages/m/@ftp/mkdir.m @@ -0,0 +1,27 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mkdir (@var{f}, @var{path}) +## Create the remote directory @var{path}, over the FTP connection @var{f}. +## @var{f} is an FTP object returned by the @code{ftp} function. +## @end deftypefn + +function mkdir (f, path) + __ftp_mkdir__ (f.curlhandle, path); +endfunction diff --git a/octave_packages/m/@ftp/mput.m b/octave_packages/m/@ftp/mput.m new file mode 100644 index 0000000..58da4dc --- /dev/null +++ b/octave_packages/m/@ftp/mput.m @@ -0,0 +1,35 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mput (@var{f}, @var{file}) +## Upload the local file @var{file} into the current remote directory on +## the FTP connection @var{f}. @var{f} is an FTP object returned by the +## ftp function. +## +## The argument @var{file} is passed by the @dfn{glob} function and any +## files that match the wildcards in @var{file} will be uploaded. +## @end deftypefn + +function retval = mput (f, file) + if (nargout == 0) + __ftp_mput__ (f.curlhandle, file); + else + retval = __ftp_mput__ (f.curlhandle, file); + endif +endfunction diff --git a/octave_packages/m/@ftp/rename.m b/octave_packages/m/@ftp/rename.m new file mode 100644 index 0000000..5ec5c1a --- /dev/null +++ b/octave_packages/m/@ftp/rename.m @@ -0,0 +1,28 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rename (@var{f}, @var{oldname}, @var{newname}) +## Rename or move the remote file or directory @var{oldname} to @var{newname}, +## over the FTP connection @var{f}. @var{f} is an FTP object returned by the +## ftp function. +## @end deftypefn + +function rename (f, oldname, newname) + __ftp_rename__ (f.curlhandle, oldname, newname); +endfunction diff --git a/octave_packages/m/@ftp/rmdir.m b/octave_packages/m/@ftp/rmdir.m new file mode 100644 index 0000000..5e7042d --- /dev/null +++ b/octave_packages/m/@ftp/rmdir.m @@ -0,0 +1,27 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rmdir (@var{f}, @var{path}) +## Remove the remote directory @var{path}, over the FTP connection @var{f}. +## @var{f} is an FTP object returned by the @code{ftp} function. +## @end deftypefn + +function rmdir (f, path) + __ftp_rmdir__ (f.curlhandle, path); +endfunction diff --git a/octave_packages/m/@ftp/saveobj.m b/octave_packages/m/@ftp/saveobj.m new file mode 100644 index 0000000..1f8aa4f --- /dev/null +++ b/octave_packages/m/@ftp/saveobj.m @@ -0,0 +1,23 @@ +## Copyright (C) 2009-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +function b = saveobj (a) + b = a; + b = rmfield (b, "curlhandle"); + b.dir = __ftp_pwd (a.curlhandle); +endfunction diff --git a/octave_packages/m/audio/lin2mu.m b/octave_packages/m/audio/lin2mu.m new file mode 100644 index 0000000..86c9fad --- /dev/null +++ b/octave_packages/m/audio/lin2mu.m @@ -0,0 +1,76 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} lin2mu (@var{x}, @var{n}) +## Convert audio data from linear to mu-law. Mu-law values use 8-bit +## unsigned integers. Linear values use @var{n}-bit signed integers or +## floating point values in the range -1 @leq{} @var{x} @leq{} 1 if +## @var{n} is 0. +## +## If @var{n} is not specified it defaults to 0, 8, or 16 depending on +## the range of values in @var{x}. +## @seealso{mu2lin, loadaudio, saveaudio} +## @end deftypefn + + +## Author: Andreas Weingessel +## Created: 17 October 1994 +## Adapted-By: jwe + +function y = lin2mu (x, n) + + if (nargin == 1) + range = max (abs (x (:))); + if (range <= 1) + n = 0; + elseif (range <= 128) + n = 8; + warning ("lin2mu: no precision specified, so using %d", n); + else + n = 16; + endif + elseif (nargin == 2) + if (n != 0 && n != 8 && n != 16) + error ("lin2mu: N must be either 0, 8 or 16"); + endif + else + print_usage (); + endif + + ## Transform real and n-bit format to 16-bit. + if (n == 0) + ## [-1,1] -> [-32768, 32768] + x = 32768 * x; + elseif (n != 16) + x = 2^(16-n) .* x; + endif + + ## Determine sign of x, set sign(0) = 1. + sig = sign(x) + (x == 0); + + ## Take absolute value of x, but force it to be smaller than 32636; + ## add bias. + x = min (abs (x), 32635) + 132; + + ## Find exponent and fraction of bineary representation. + [f, e] = log2 (x); + + y = 64 * sig - 16 * e - fix (32 * f) + 335; + +endfunction diff --git a/octave_packages/m/audio/loadaudio.m b/octave_packages/m/audio/loadaudio.m new file mode 100644 index 0000000..990fea4 --- /dev/null +++ b/octave_packages/m/audio/loadaudio.m @@ -0,0 +1,81 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} loadaudio (@var{name}, @var{ext}, @var{bps}) +## Load audio data from the file @file{@var{name}.@var{ext}} into the +## vector @var{x}. +## +## The extension @var{ext} determines how the data in the audio file is +## interpreted; the extensions @file{lin} (default) and @file{raw} +## correspond to linear, the extensions @file{au}, @file{mu}, or @file{snd} +## to mu-law encoding. +## +## The argument @var{bps} can be either 8 (default) or 16, and specifies +## the number of bits per sample used in the audio file. +## @seealso{lin2mu, mu2lin, saveaudio, playaudio, setaudio, record} +## @end deftypefn + + +## Author: AW +## Created: 10 April 1994 +## Adapted-By: jwe + +function X = loadaudio (name, ext, bps) + + if (nargin == 0 || nargin > 3) + print_usage (); + endif + + if (nargin == 1) + ext = "lin"; + endif + + if (nargin < 3) + bps = 8; + elseif (bps != 8 && bps != 16) + error ("loadaudio: BPS must be either 8 or 16"); + endif + + name = [name, ".", ext]; + num = fopen (name, "rb"); + + if (strcmp (ext, "lin") || strcmp (ext, "raw") || strcmp (ext, "pcm")) + if (bps == 8) + [Y, c] = fread (num, inf, "uchar"); + X = Y - 127; + else + [X, c] = fread (num, inf, "short"); + endif + elseif (strcmp (ext, "mu") || strcmp (ext, "au") + || strcmp (ext, "snd") || strcmp(ext, "ul")) + [Y, c] = fread (num, inf, "uchar"); + ## remove file header + m = find (Y(1:64) == 0, 1, "last"); + if (! isempty (m)) + Y(1:m) = []; + endif + X = mu2lin (Y, bps); + else + fclose (num); + error ("loadaudio: unsupported extension"); + endif + + fclose (num); + +endfunction diff --git a/octave_packages/m/audio/mu2lin.m b/octave_packages/m/audio/mu2lin.m new file mode 100644 index 0000000..b6542fa --- /dev/null +++ b/octave_packages/m/audio/mu2lin.m @@ -0,0 +1,82 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mu2lin (@var{x}, @var{n}) +## Convert audio data from mu-law to linear. Mu-law values are 8-bit +## unsigned integers. Linear values use @var{n}-bit signed integers +## or floating point values in the range -1@leq{}y@leq{}1 if @var{n} +## is 0. +## +## If @var{n} is not specified it defaults to 0. +## @seealso{lin2mu, loadaudio, saveaudio} +## @end deftypefn + +## Author: Andreas Weingessel +## Created: 18 October 1994 +## Adapted-By: jwe + +function y = mu2lin (x, n = 0) + + if (nargin == 2) + if (n != 0 && n != 8 && n != 16) + error ("mu2lin: N must be either 0, 8, or 16"); + endif + elseif (nargin != 1) + print_usage (); + endif + + ulaw = [32124, 31100, 30076, 29052, 28028, 27004, 25980, 24956, \ + 23932, 22908, 21884, 20860, 19836, 18812, 17788, 16764, \ + 15996, 15484, 14972, 14460, 13948, 13436, 12924, 12412, \ + 11900, 11388, 10876, 10364, 9852, 9340, 8828, 8316, \ + 7932, 7676, 7420, 7164, 6908, 6652, 6396, 6140, \ + 5884, 5628, 5372, 5116, 4860, 4604, 4348, 4092, \ + 3900, 3772, 3644, 3516, 3388, 3260, 3132, 3004, \ + 2876, 2748, 2620, 2492, 2364, 2236, 2108, 1980, \ + 1884, 1820, 1756, 1692, 1628, 1564, 1500, 1436, \ + 1372, 1308, 1244, 1180, 1116, 1052, 988, 924, \ + 876, 844, 812, 780, 748, 716, 684, 652, \ + 620, 588, 556, 524, 492, 460, 428, 396, \ + 372, 356, 340, 324, 308, 292, 276, 260, \ + 244, 228, 212, 196, 180, 164, 148, 132, \ + 120, 112, 104, 96, 88, 80, 72, 64, \ + 56, 48, 40, 32, 24, 16, 8, 0 ]; + + ulaw = [ -ulaw, ulaw ]; + + ## Set the shape of y to that of x overwrites the contents of y with + ## ulaw of x. + y = x; + y(:) = ulaw (x + 1); + + ## Convert to real or 8-bit. + if (n == 0) + ## [ -32768, 32767 ] -> [ -1, 1) + y = y/32768; + elseif (n == 8) + ld = max (abs (y (:))); + if (ld < 16384 && ld > 0) + sc = 64 / ld; + else + sc = 1 / 256; + endif + y = fix (y * sc); + endif + +endfunction diff --git a/octave_packages/m/audio/playaudio.m b/octave_packages/m/audio/playaudio.m new file mode 100644 index 0000000..34f9674 --- /dev/null +++ b/octave_packages/m/audio/playaudio.m @@ -0,0 +1,88 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} playaudio (@var{name}, @var{ext}) +## @deftypefnx {Function File} {} playaudio (@var{x}) +## Play the audio file @file{@var{name}.@var{ext}} or the audio data +## stored in the vector @var{x}. +## @seealso{lin2mu, mu2lin, loadaudio, saveaudio, setaudio, record} +## @end deftypefn + +## Author: AW +## Created: 11 April 1994 +## Adapted-By: jwe + +function playaudio (name, ext) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1 && isnumeric (name)) + ## play a vector + if (! isvector (name)) + error ("playaudio: X must be a vector"); + endif + X = name(:) + 127; + unwind_protect + file = tmpnam (); + fid = fopen (file, "wb"); + fwrite (fid, X, "uchar"); + fclose (fid); + [status, out] = system (sprintf ('cat "%s" > /dev/dsp', file)); + if (status != 0) + system (sprintf ("paplay --raw \"%s\"", file)) + endif + unwind_protect_cleanup + unlink (file); + end_unwind_protect + elseif (nargin >= 1 && ischar (name)) + ## play a file + if (nargin == 1) + name = [name ".lin"]; + elseif (nargin == 2) + name = [name "." ext]; + endif + if (any (strcmp (ext, {"lin", "raw"}))) + [status, out] = system (sprintf ('cat "%s" > /dev/dsp', name)); + if (status != 0) + system (sprintf ('paplay --raw "%s"', name)) + endif + elseif (any (strcmp (ext, {"mu", "au" "snd", "ul"}))) + [status, out] = system (sprintf ('cat "%s" > /dev/audio', name)); + if (status != 0) + system (sprintf ('paplay "%s"', name)) + endif + else + error ("playaudio: unsupported extension '%s'", ext); + endif + else + print_usage (); + endif + +endfunction + + +%% Test input validation +%!error playaudio () +%!error playaudio (1,2,3) +%!error playaudio (magic (3)) +%!error playaudio ("file", "abc") +%!error playaudio ({"abc"}) + diff --git a/octave_packages/m/audio/record.m b/octave_packages/m/audio/record.m new file mode 100644 index 0000000..6b4f976 --- /dev/null +++ b/octave_packages/m/audio/record.m @@ -0,0 +1,65 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} record (@var{sec}, @var{sampling_rate}) +## Record @var{sec} seconds of audio input into the vector @var{x}. The +## default value for @var{sampling_rate} is 8000 samples per second, or +## 8kHz. The program waits until the user types @key{RET} and then +## immediately starts to record. +## @seealso{lin2mu, mu2lin, loadaudio, saveaudio, playaudio, setaudio} +## @end deftypefn + +## Author: AW +## Created: 19 September 1994 +## Adapted-By: jwe + +function X = record (sec, sampling_rate) + + if (nargin == 1) + sampling_rate = 8000; + elseif (nargin != 2) + print_usage (); + endif + + unwind_protect + + file = tmpnam (); + + input ("Please hit ENTER and speak afterwards!\n", 1); + + cmd = sprintf ("dd if=/dev/dsp of=\"%s\" bs=%d count=%d", + file, sampling_rate, sec); + + system (cmd); + + num = fopen (file, "rb"); + + [Y, c] = fread (num, sampling_rate * sec, "uchar"); + + fclose (num); + + unwind_protect_cleanup + + unlink (file); + + end_unwind_protect + + X = Y - 127; + +endfunction diff --git a/octave_packages/m/audio/saveaudio.m b/octave_packages/m/audio/saveaudio.m new file mode 100644 index 0000000..6361c87 --- /dev/null +++ b/octave_packages/m/audio/saveaudio.m @@ -0,0 +1,88 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} saveaudio (@var{name}, @var{x}, @var{ext}, @var{bps}) +## Save a vector @var{x} of audio data to the file +## @file{@var{name}.@var{ext}}. The optional parameters @var{ext} and +## @var{bps} determine the encoding and the number of bits per sample used +## in the audio file (see @code{loadaudio}); defaults are @file{lin} and +## 8, respectively. +## @seealso{lin2mu, mu2lin, loadaudio, playaudio, setaudio, record} +## @end deftypefn + +## Author: AW +## Created: 5 September 1994 +## Adapted-By: jwe + +function saveaudio (name, x, ext, bps) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (nargin == 2) + ext = "lin"; + endif + + if (nargin < 4) + bps = 8; + elseif (bps != 8 && bps != 16) + error ("saveaudio: BPS must be either 8 or 16"); + endif + + [nr, nc] = size (x); + if (nc != 1) + if (nr == 1) + x = x'; + nr = nc; + else + error ("saveaudio: X must be a vector"); + endif + endif + + num = fopen ([name, ".", ext], "wb"); + + if (strcmp (ext, "lin") || strcmp (ext, "raw")) + if (bps == 8) + ld = max (abs (x)); + if (ld > 127) # convert 16 to 8 bit + if (ld < 16384) + sc = 64 / ld; + else + sc = 1 / 256; + endif + x = fix (x * sc); + endif + x = x + 127; + c = fwrite (num, x, "uchar"); + else + c = fwrite (num, x, "short"); + endif + elseif (strcmp (ext, "mu") || strcmp (ext, "au") + || strcmp (ext, "snd") || strcmp (ext, "ul")) + y = lin2mu (x); + c = fwrite (num, y, "uchar"); + else + fclose (num); + error ("saveaudio: unsupported extension"); + endif + + fclose (num); + +endfunction diff --git a/octave_packages/m/audio/setaudio.m b/octave_packages/m/audio/setaudio.m new file mode 100644 index 0000000..4b74329 --- /dev/null +++ b/octave_packages/m/audio/setaudio.m @@ -0,0 +1,43 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} setaudio () +## @deftypefnx {Function File} {} setaudio (@var{w_type}) +## @deftypefnx {Function File} {} setaudio (@var{w_type}, @var{value}) +## Execute the shell command @samp{mixer}, possibly with optional +## arguments @var{w_type} and @var{value}. +## @end deftypefn + +## Author: AW +## Created: 5 October 1994 +## Adapted-By: jwe + +function setaudio (w_type, value) + + if (nargin == 0) + system ("mixer"); + elseif (nargin == 1) + system (sprintf ("mixer %s", w_type)); + elseif (nargin == 2) + system (sprintf ("mixer %s %d", w_type, value)); + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/audio/wavread.m b/octave_packages/m/audio/wavread.m new file mode 100644 index 0000000..2a03c7e --- /dev/null +++ b/octave_packages/m/audio/wavread.m @@ -0,0 +1,249 @@ +## Copyright (C) 2005-2012 Michael Zeising +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} wavread (@var{filename}) +## Load the RIFF/WAVE sound file @var{filename}, and return the samples +## in vector @var{y}. If the file contains multichannel data, then +## @var{y} is a matrix with the channels represented as columns. +## +## @deftypefnx {Function File} {[@var{y}, @var{Fs}, @var{bps}] =} wavread (@var{filename}) +## Additionally return the sample rate (@var{fs}) in Hz and the number of bits +## per sample (@var{bps}). +## +## @deftypefnx {Function File} {[@dots{}] =} wavread (@var{filename}, @var{n}) +## Read only the first @var{n} samples from each channel. +## +## @deftypefnx {Function File} {[@dots{}] =} wavread (@var{filename}, @var{n1} @var{n2}) +## Read only samples @var{n1} through @var{n2} from each channel. +## +## @deftypefnx {Function File} {[@var{samples}, @var{channels}] =} wavread (@var{filename}, "size") +## Return the number of samples (@var{n}) and channels (@var{ch}) +## instead of the audio data. +## @seealso{wavwrite} +## @end deftypefn + +## Author: Michael Zeising +## Created: 06 December 2005 + +function [y, samples_per_sec, bits_per_sample] = wavread (filename, param) + + FORMAT_PCM = 0x0001; # PCM (8/16/32 bit) + FORMAT_IEEE_FLOAT = 0x0003; # IEEE float (32/64 bit) + BYTEORDER = "ieee-le"; + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (! ischar (filename)) + error ("wavread: FILENAME must be a character string"); + endif + + fid = -1; + + unwind_protect + + [fid, msg] = fopen (filename, "rb"); + + if (fid < 0) + error ("wavread: %s", msg); + endif + + ## Get file size. + fseek (fid, 0, "eof"); + file_size = ftell (fid); + fseek (fid, 0, "bof"); + + ## Find RIFF chunk. + riff_size = find_chunk (fid, "RIFF", file_size); + riff_pos = ftell (fid); + if (riff_size == -1) + error ("wavread: file contains no RIFF chunk"); + endif + + riff_type = char (fread (fid, 4))'; + if (! strcmp (riff_type, "WAVE")) + error ("wavread: file contains no WAVE signature"); + endif + riff_pos = riff_pos + 4; + riff_size = riff_size - 4; + + ## Find format chunk inside the RIFF chunk. + fseek (fid, riff_pos, "bof"); + fmt_size = find_chunk (fid, "fmt ", riff_size); + fmt_pos = ftell(fid); + if (fmt_size == -1) + error ("wavread: file contains no format chunk"); + endif + + ## Find data chunk inside the RIFF chunk. + ## We don't assume that it comes after the format chunk. + fseek (fid, riff_pos, "bof"); + data_size = find_chunk (fid, "data", riff_size); + data_pos = ftell (fid); + if (data_size == -1) + error ("wavread: file contains no data chunk"); + endif + + ### Read format chunk. + fseek (fid, fmt_pos, "bof"); + + ## Sample format code. + format_tag = fread (fid, 1, "uint16", 0, BYTEORDER); + if (format_tag != FORMAT_PCM && format_tag != FORMAT_IEEE_FLOAT) + error ("wavread: sample format %#x is not supported", format_tag); + endif + + ## Number of interleaved channels. + channels = fread (fid, 1, "uint16", 0, BYTEORDER); + + ## Sample rate. + samples_per_sec = fread (fid, 1, "uint32", 0, BYTEORDER); + + ## Bits per sample. + fseek (fid, 6, "cof"); + bits_per_sample = fread (fid, 1, "uint16", 0, BYTEORDER); + + ### Read data chunk. + fseek (fid, data_pos, "bof"); + + ## Determine sample data type. + if (format_tag == FORMAT_PCM) + switch (bits_per_sample) + case 8 + format = "uint8"; + case 16 + format = "int16"; + case 24 + format = "uint8"; + case 32 + format = "int32"; + otherwise + error ("wavread: %d bits sample resolution is not supported with PCM", + bits_per_sample); + endswitch + else + switch (bits_per_sample) + case 32 + format = "float32"; + case 64 + format = "float64"; + otherwise + error ("wavread: %d bits sample resolution is not supported with IEEE float", + bits_per_sample); + endswitch + endif + + ## Parse arguments. + if (nargin == 1) + length = idivide (8 * data_size, bits_per_sample); + else + nparams = numel (param); + if (nparams == 1) + ## Number of samples is given. + length = param * channels; + elseif (nparams == 2) + ## Sample range is given. + if (fseek (fid, (param(1)-1) * channels * (bits_per_sample/8), "cof") < 0) + warning ("wavread: seeking failed"); + endif + length = (param(2)-param(1)+1) * channels; + elseif (nparams == 4 && char (param) == "size") + ## Size of the file is requested. + tmp = idivide (8 * data_size, channels * bits_per_sample); + y = [tmp, channels]; + return; + else + error ("wavread: invalid PARAM argument"); + endif + endif + + ## Read samples and close file. + if (bits_per_sample == 24) + length *= 3; + endif + + [yi, n] = fread (fid, length, format, 0, BYTEORDER); + + unwind_protect_cleanup + + if (fid >= 0) + fclose (fid); + endif + + end_unwind_protect + + ## Check data. + if (mod (numel (yi), channels) != 0) + error ("wavread: data in %s doesn't match the number of channels", + filename); + endif + + if (bits_per_sample == 24) + yi = reshape (yi, 3, rows(yi)/3)'; + yi(yi(:,3) >= 128, 3) -= 256; + yi = yi * [1; 256; 65536]; + endif + + if (format_tag == FORMAT_PCM) + ## Normalize samples. + switch (bits_per_sample) + case 8 + yi = (yi - 128)/128; + case 16 + yi /= 32768; + case 24 + yi /= 8388608; + case 32 + yi /= 2147483648; + endswitch + endif + + ## Deinterleave. + nr = numel (yi) / channels; + y = reshape (yi, channels, nr)'; + +endfunction + +## Given a chunk_id, scan through chunks from the current file position +## though at most size bytes. Return the size of the found chunk, with +## file position pointing to the start of the chunk data. Return -1 for +## size if chunk is not found. + +function chunk_size = find_chunk (fid, chunk_id, size) + id = ""; + offset = 8; + chunk_size = 0; + + while (! strcmp (id, chunk_id) && (offset < size)) + fseek (fid, chunk_size, "cof"); + id = char (fread (fid, 4))'; + chunk_size = fread (fid, 1, "uint32", 0, "ieee-le"); + ## Chunk sizes must be word-aligned (2 byte) + chunk_size += rem (chunk_size, 2); + offset = offset + 8 + chunk_size; + endwhile + if (! strcmp (id, chunk_id)) + chunk_size = -1; + endif +endfunction + +## Mark file as being tested. Tests for wavread/wavwrite pair are in +## wavwrite.m +%!assert(1) diff --git a/octave_packages/m/audio/wavwrite.m b/octave_packages/m/audio/wavwrite.m new file mode 100644 index 0000000..de62fae --- /dev/null +++ b/octave_packages/m/audio/wavwrite.m @@ -0,0 +1,183 @@ +## Copyright (C) 2005-2012 Michael Zeising +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} wavwrite (@var{y}, @var{filename}) +## @deftypefnx {Function File} {} wavwrite (@var{y}, @var{Fs}, @var{filename}) +## @deftypefnx {Function File} {} wavwrite (@var{y}, @var{Fs}, @var{bps}, @var{filename}) +## Write @var{y} to the canonical RIFF/WAVE sound file @var{filename} +## with sample rate @var{Fs} and bits per sample @var{bps}. The +## default sample rate is 8000 Hz with 16-bits per sample. Each column +## of the data represents a separate channel. +## @seealso{wavread} +## @end deftypefn + +## Author: Michael Zeising +## Created: 06 December 2005 + +function wavwrite (y, varargin) + + BYTEORDER = "ieee-le"; + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + ## Defaults. + samples_per_sec = 8000; + bits_per_sample = 16; + + filename = varargin{end}; + if (nargin > 2) + samples_per_sec = varargin{1}; + if (nargin > 3) + bits_per_sample = varargin{2}; + endif + endif + + ## test arguments + if (columns (y) < 1) + error ("wavwrite: Y must have at least one column"); + endif + if (columns (y) > 0x7FFF) + error ("wavwrite: Y has more than 32767 columns (too many for a WAV-file)"); + endif + + ## determine sample format + switch (bits_per_sample) + case 8 + format = "uint8"; + case 16 + format = "int16"; + case 32 + format = "int32"; + otherwise + error ("wavwrite: sample resolution not supported"); + endswitch + + ## calculate filesize + [n, channels] = size (y); + + ## size of data chunk + ck_size = n*channels*(bits_per_sample/8); + + if (! ischar (filename)) + error ("wavwrite: expecting FILENAME to be a character string"); + endif + + ## open file for writing binary + [fid, msg] = fopen (filename, "wb"); + if (fid < 0) + error ("wavwrite: %s", msg); + endif + + ## write RIFF/WAVE header + c = 0; + c += fwrite (fid, "RIFF", "uchar"); + + ## file size - 8 + c += fwrite (fid, ck_size + 36, "uint32", 0, BYTEORDER); + c += fwrite (fid, "WAVEfmt ", "uchar"); + + ## size of fmt chunk + c += fwrite (fid, 16, "uint32", 0, BYTEORDER); + + ## sample format code (PCM) + c += fwrite (fid, 1, "uint16", 0, BYTEORDER); + + ## channels + c += fwrite (fid, channels, "uint16", 0, BYTEORDER); + + ## sample rate + c += fwrite (fid, samples_per_sec, "uint32", 0, BYTEORDER); + + ## bytes per second + byteps = samples_per_sec*channels*bits_per_sample/8; + c += fwrite (fid, byteps, "uint32", 0, BYTEORDER); + + ## block align + c += fwrite (fid, channels*bits_per_sample/8, "uint16", 0, BYTEORDER); + + c += fwrite (fid, bits_per_sample, "uint16", 0, BYTEORDER); + c += fwrite (fid, "data", "uchar"); + c += fwrite (fid, ck_size, "uint32", 0, BYTEORDER); + + if (c < 25) + fclose (fid); + error ("wavwrite: writing to file failed"); + endif + + ## interleave samples + yi = reshape (y', n*channels, 1); + + ## scale samples + switch (bits_per_sample) + case 8 + yi = round (yi*128 + 128); + case 16 + yi = round (yi*32768); + case 32 + yi = round (yi*2147483648); + endswitch + + ## write to file + c = fwrite (fid, yi, format, 0, BYTEORDER); + + fclose (fid); + +endfunction + + +%!shared fname +%! fname = tmpnam (); + +%!test +%! A = [-1:0.1:1; -1:0.1:1]; +%! wavwrite (A, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/2^15); +%! assert (samples_per_sec, 8000); +%! assert (bits_per_sample, 16); +%! unlink (fname); +% +%!test +%! A = [-1:0.1:1; -1:0.1:1]; +%! wavwrite (A, 4000, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/2^15); +%! assert (samples_per_sec, 4000); +%! assert (bits_per_sample, 16); +%! unlink (fname); +% +%!test +%! A = [-1:0.1:1; -1:0.1:1]; +%! wavwrite (A, 4000, 8, fname); +%! [B, samples_per_sec, bits_per_sample] = wavread (fname); +%! assert (A,B, 1/128); +%! assert (samples_per_sec, 4000); +%! assert (bits_per_sample, 8); +%! unlink (fname); +% +%!test +%! A = [-2:2]; +%! wavwrite (A, fname); +%! B = wavread (fname); +%! B *= 32768; +%! assert (B, [-32768 -32768 0 32767 32767]); +%! unlink (fname); + diff --git a/octave_packages/m/deprecated/__error_text__.m b/octave_packages/m/deprecated/__error_text__.m new file mode 100644 index 0000000..10aecc4 --- /dev/null +++ b/octave_packages/m/deprecated/__error_text__.m @@ -0,0 +1,36 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} __error_text__ (@var{msg}, @var{msgid}) +## This function has been deprecated. Use @code{lasterr} instead. +## @seealso{lasterr} +## @end deftypefn + +function [msg, msgid] = __error_text__ (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "__error_text__ is obsolete and will be removed from a future version of Octave, please use lasterr instead"); + endif + + [msg, msgid] = lasterr (varargin{:}); + +endfunction diff --git a/octave_packages/m/deprecated/autocor.m b/octave_packages/m/deprecated/autocor.m new file mode 100644 index 0000000..f4aefcf --- /dev/null +++ b/octave_packages/m/deprecated/autocor.m @@ -0,0 +1,59 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} autocor (@var{x}, @var{h}) +## Return the autocorrelations from lag 0 to @var{h} of vector @var{x}. +## If @var{h} is omitted, all autocorrelations are computed. +## If @var{x} is a matrix, the autocorrelations of each column are +## computed. +## The particular algorithm used is from the field of statistics and +## differs from the definition used in signal processing. +## @end deftypefn + +## Author: FL +## Description: Compute autocorrelations + +## Deprecated in version 3.4 + +function retval = autocor (X, h) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "autocor is obsolete and will be removed from a future version of Octave; See the Octave-Forge signal package and the function xcor for a replacement"); + endif + + + if (nargin == 1) + retval = autocov (X); + elseif (nargin == 2) + retval = autocov (X, h); + else + print_usage (); + endif + + if (min (retval (1,:)) != 0) + retval = retval ./ (ones (rows (retval), 1) * retval(1,:)); + endif + +endfunction + + + diff --git a/octave_packages/m/deprecated/autocov.m b/octave_packages/m/deprecated/autocov.m new file mode 100644 index 0000000..dc3ac39 --- /dev/null +++ b/octave_packages/m/deprecated/autocov.m @@ -0,0 +1,62 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} autocov (@var{x}, @var{h}) +## Return the autocovariances from lag 0 to @var{h} of vector @var{x}. +## If @var{h} is omitted, all autocovariances are computed. +## If @var{x} is a matrix, the autocovariances of each column are +## computed. +## The particular algorithm used is from the field of statistics and +## differs from the definition used in signal processing. +## @end deftypefn + +## Author: FL +## Description: Compute autocovariances + +## Deprecated in version 3.4 + +function retval = autocov (X, h) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "autocov is obsolete and will be removed from a future version of Octave; See the Octave-Forge signal package and the function xcov for a replacement"); + endif + + [n, c] = size (X); + + if (isvector (X)) + n = length (X); + c = 1; + X = reshape (X, n, 1); + endif + + X = center (X); + + if (nargin == 1) + h = n - 1; + endif + + retval = zeros (h + 1, c); + + for i = 0 : h + retval(i+1, :) = diag (X(i+1:n, :).' * conj (X(1:n-i, :))).' / n; + endfor + +endfunction diff --git a/octave_packages/m/deprecated/betai.m b/octave_packages/m/deprecated/betai.m new file mode 100644 index 0000000..0eca51a --- /dev/null +++ b/octave_packages/m/deprecated/betai.m @@ -0,0 +1,47 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} betai (@var{a}, @var{b}, @var{x}) +## This function is provided for compatibility with older versions of +## Octave. New programs should use betainc instead. +## +## @code{betai (@var{a}, @var{b}, @var{x})} is the same as +## @code{betainc (@var{x}, @var{a}, @var{b})}. +## @end deftypefn + +## Author: jwe +## Created: 30 Jan 1998 + +## Deprecated in version 3.4 + +function retval = betai (a, b, x) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "betai is obsolete and will be removed from a future version of Octave; please use betainc instead"); + endif + + if (nargin == 3) + retval = betainc (x, a, b); + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/deprecated/cellidx.m b/octave_packages/m/deprecated/cellidx.m new file mode 100644 index 0000000..4da57de --- /dev/null +++ b/octave_packages/m/deprecated/cellidx.m @@ -0,0 +1,108 @@ +## Copyright (C) 2000-2012 Auburn University. All rights reserved. +## +## This file is part of Octave. +## +## Octave 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 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 +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{idxvec}, @var{errmsg}] =} cellidx (@var{listvar}, @var{strlist}) +## Return indices of string entries in @var{listvar} that match strings +## in @var{strlist}. +## +## Both @var{listvar} and @var{strlist} may be passed as strings or +## string matrices. If they are passed as string matrices, each entry +## is processed by @code{deblank} prior to searching for the entries. +## +## The first output is the vector of indices in @var{listvar}. +## +## If @var{strlist} contains a string not in @var{listvar}, then +## an error message is returned in @var{errmsg}. If only one output +## argument is requested, then @var{cellidx} prints @var{errmsg} to the +## screen and exits with an error. +## @end deftypefn + +## deprecated in version 3.4 + +function [idxvec,errmsg] = cellidx (listvar, strlist) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cellidx is obsolete and will be removed from a future version of Octave; use ismember instead"); + endif + + if (nargin != 2) + print_usage (); + endif + + if (ischar (strlist)) + tmp = strlist; + strlist = {}; + for kk = 1:rows(tmp) + strlist{kk} = deblank (tmp(kk,:)); + endfor + endif + + if (ischar (listvar)) + tmp = listvar; + listvar = {}; + for kk = 1:rows(tmp) + listvar{kk} = deblank (tmp(kk,:)); + endfor + endif + + ## initialize size of idxvec (for premature return) + idxvec = zeros (length(strlist), 1); + + errmsg = ""; + if (! iscellstr (listvar)) + errmsg = "listvar must be a list of strings"; + elseif (! iscellstr (strlist)) + errmsg = "strlist must be a list of strings"; + endif + + if (length (errmsg)) + if (nargout < 2) + error (errmsg); + else + return; + endif + endif + + nsigs = length(listvar); + for idx = 1:length(strlist) + signame = strlist{idx}; + for jdx = 1:nsigs + if (strcmp (signame, listvar{jdx})) + if (idxvec(idx) != 0) + warning ("Duplicate signal name %s (%d,%d)\n", + listvar{jdx}, jdx, idxvec(idx)); + else + idxvec(idx) = jdx; + endif + endif + endfor + if (idxvec(idx) == 0) + errmsg = sprintf ("Did not find %s", signame); + if (nargout == 1) + error (errmsg); + else + break; + endif + endif + endfor + +endfunction diff --git a/octave_packages/m/deprecated/clg.m b/octave_packages/m/deprecated/clg.m new file mode 100644 index 0000000..9846f74 --- /dev/null +++ b/octave_packages/m/deprecated/clg.m @@ -0,0 +1,40 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} clg () +## This function has been deprecated. Use clf instead. +## @end deftypefn + +## Author: jwe + +## Deprecated in version 3.0 +## Matlab still has this function, so don't remove just yet. + +function clg () + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "clg is obsolete and will be removed from a future version of Octave, please use clf instead"); + endif + + clf (); + +endfunction diff --git a/octave_packages/m/deprecated/cor.m b/octave_packages/m/deprecated/cor.m new file mode 100644 index 0000000..ee3a7b8 --- /dev/null +++ b/octave_packages/m/deprecated/cor.m @@ -0,0 +1,54 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cor (@var{x}) +## @deftypefnx {Function File} {} cor (@var{x}, @var{y}) +## Compute matrix of correlation coefficients. +## +## This is an alias for @code{corrcoef}. +## @seealso{corrcoef} +## @end deftypefn + +function retval = cor (x, y = x) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cor is obsolete and will be removed from a future version of Octave; please use corr instead"); + endif + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + retval = corrcoef (x, y); + +endfunction + + +%!test +%! x = rand (10, 2); +%! assert (cor (x), corrcoef (x), 5*eps); +%! assert (cor (x(:,1), x(:,2)) == corrcoef (x(:,1), x(:,2))); + +%% Test input validation +%!error corrcoef (); +%!error corrcoef (1, 2, 3); + diff --git a/octave_packages/m/deprecated/corrcoef.m b/octave_packages/m/deprecated/corrcoef.m new file mode 100644 index 0000000..de46f1d --- /dev/null +++ b/octave_packages/m/deprecated/corrcoef.m @@ -0,0 +1,119 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} corrcoef (@var{x}) +## @deftypefnx {Function File} {} corrcoef (@var{x}, @var{y}) +## Compute matrix of correlation coefficients. +## +## If each row of @var{x} and @var{y} is an observation and each column is +## a variable, then the @w{(@var{i}, @var{j})-th} entry of +## @code{corrcoef (@var{x}, @var{y})} is the correlation between the +## @var{i}-th variable in @var{x} and the @var{j}-th variable in @var{y}. +## @tex +## $$ +## {\rm corrcoef}(x,y) = {{\rm cov}(x,y) \over {\rm std}(x) {\rm std}(y)} +## $$ +## @end tex +## @ifnottex +## +## @example +## corrcoef(x,y) = cov(x,y)/(std(x)*std(y)) +## @end example +## +## @end ifnottex +## If called with one argument, compute @code{corrcoef (@var{x}, @var{x})}, +## the correlation between the columns of @var{x}. +## @seealso{cov} +## @end deftypefn + +## Author: Kurt Hornik +## Created: March 1993 +## Adapted-By: jwe + +function retval = corrcoef (x, y = []) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "corrcoef is not equivalent to Matlab and will be removed from a future version of Octave; for similar functionality see corr"); + endif + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + ## Input validation is done by cov.m. Don't repeat tests here + + ## Special case, scalar is always 100% correlated with itself + if (isscalar (x)) + if (isa (x, 'single')) + retval = single (1); + else + retval = 1; + endif + return; + endif + + ## No check for division by zero error, which happens only when + ## there is a constant vector and should be rare. + if (nargin == 2) + c = cov (x, y); + s = std (x)' * std (y); + retval = c ./ s; + else + c = cov (x); + s = sqrt (diag (c)); + retval = c ./ (s * s'); + endif + +endfunction + + +%!test +%! x = rand (10); +%! cc1 = corrcoef (x); +%! cc2 = corrcoef (x, x); +%! assert (size (cc1) == [10, 10] && size (cc2) == [10, 10]); +%! assert (cc1, cc2, sqrt (eps)); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (corrcoef (x,y), -1, 5*eps) +%! assert (corrcoef (x,flipud (y)), 1, 5*eps) +%! assert (corrcoef ([x, y]), [1 -1; -1 1], 5*eps) + +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (corrcoef (x,y), single (-1), 5*eps) +%! assert (corrcoef (x,flipud (y)), single (1), 5*eps) +%! assert (corrcoef ([x, y]), single ([1 -1; -1 1]), 5*eps) + +%!assert (corrcoef (5), 1); +%!assert (corrcoef (single(5)), single(1)); + +%% Test input validation +%!error corrcoef (); +%!error corrcoef (1, 2, 3); +%!error corrcoef ([1; 2], ["A", "B"]); +%!error corrcoef (ones (2,2,2)); +%!error corrcoef (ones (2,2), ones (2,2,2)); + diff --git a/octave_packages/m/deprecated/cquad.m b/octave_packages/m/deprecated/cquad.m new file mode 100644 index 0000000..623dfa2 --- /dev/null +++ b/octave_packages/m/deprecated/cquad.m @@ -0,0 +1,39 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{int}, @var{err}, @var{nr_points}] =} cquad (@var{f}, @var{a}, @var{b}, @var{tol}) +## @deftypefnx {Function File} {[@var{int}, @var{err}, @var{nr_points}] =} cquad (@var{f}, @var{a}, @var{b}, @var{tol}, @var{sing}) +## This function is an alias for compatibility with older versions of +## Octave. New programs should use @code{quadcc} instead. +## @seealso{quadcc} +## @end deftypefn + +## Deprecated in version 3.4 + +function retval = cquad (varargin) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cquad has been renamed to quadcc and this alias will be removed from a future version of Octave; please use quadcc instead"); + endif + + retval = quadcc (varargin{:}); + +endfunction diff --git a/octave_packages/m/deprecated/cut.m b/octave_packages/m/deprecated/cut.m new file mode 100644 index 0000000..4409070 --- /dev/null +++ b/octave_packages/m/deprecated/cut.m @@ -0,0 +1,71 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cut (@var{x}, @var{breaks}) +## Create categorical data from numerical or continuous data by +## cutting into intervals. +## +## If @var{breaks} is a scalar, the data is cut into that many +## equal-width intervals. If @var{breaks} is a vector of break points, +## the category has @code{length (@var{breaks}) - 1} groups. +## +## The returned value is a vector of the same size as @var{x} telling +## which group each point in @var{x} belongs to. Groups are labelled +## from 1 to the number of groups; points outside the range of +## @var{breaks} are labelled by @code{NaN}. +## @seealso{histc} +## @end deftypefn + +## Author: KH +## Description: Cut data into intervals + +function group = cut (x, breaks) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "cut is obsolete and will be removed from a future version of Octave; please use histc instead"); + endif + + if (nargin != 2) + print_usage (); + endif + + if (!isvector (x)) + error ("cut: X must be a vector"); + endif + if isscalar (breaks) + breaks = linspace (min (x), max (x), breaks + 1); + breaks(1) = breaks(1) - 1; + elseif isvector (breaks) + breaks = sort (breaks); + else + error ("cut: BREAKS must be a scalar or vector"); + endif + + group = NaN (size (x)); + m = length (breaks); + if any (k = find ((x >= min (breaks)) & (x < max (breaks)))) + n = length (k); + group(k) = sum ((ones (m, 1) * reshape (x(k), 1, n)) + >= (reshape (breaks, m, 1) * ones (1, n))); + endif + +endfunction diff --git a/octave_packages/m/deprecated/dispatch.m b/octave_packages/m/deprecated/dispatch.m new file mode 100644 index 0000000..6ab53b4 --- /dev/null +++ b/octave_packages/m/deprecated/dispatch.m @@ -0,0 +1,103 @@ +## Copyright (C) 2010-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {} dispatch (@var{f}, @var{r}, @var{type}) +## +## Replace the function @var{f} with a dispatch so that function @var{r} +## is called when @var{f} is called with the first argument of the named +## @var{type}. If the type is @var{any} then call @var{r} if no other type +## matches. The original function @var{f} is accessible using +## @code{builtin (@var{f}, @dots{})}. +## +## If @var{r} is omitted, clear dispatch function associated with @var{type}. +## +## If both @var{r} and @var{type} are omitted, list dispatch functions +## for @var{f}. +## @seealso{builtin} +## @end deftypefn + +## Deprecated in version 3.4 + +function varargout = dispatch (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "dispatch is obsolete and will be removed from a future version of Octave; please use classes instead"); + endif + + varargout = cell (nargout, 1); + [ varargout{:} ] = __dispatch__ (varargin{:}); + +endfunction + + +%!test # builtin function replacement +%! dispatch('sin','length','string') +%! assert(sin("abc"),3) +%! assert(sin(0),0,10*eps); + +%!test # 'any' function +%! dispatch('sin','exp','any') +%! assert(sin(0),1,eps); +%! assert(sin("abc"),3); + +%!test # 'builtin' function +%! assert(builtin('sin',0),0,eps); +%! builtin('eval','x=1;'); +%! assert(x,1); + +%!test # clear function mapping +%! dispatch('sin','string') +%! dispatch('sin','any') +%! assert(sin(0),0,10*eps); + +%!test # oct-file replacement +%! dispatch('fft','length','string') +%! assert(fft([1,1]),[2,0]); +%! assert(fft("abc"),3) +%! dispatch('fft','string'); + +%!test # m-file replacement +%! dispatch('hamming','length','string') +%! assert(hamming(1),1) +%! assert(hamming("abc"),3) +%! dispatch('hamming','string') + +%!test # override preloaded builtin +%! evalin('base','cos(1);'); +%! dispatch('cos','length','string') +%! evalin('base','assert(cos("abc"),3)'); +%! evalin('base','assert(cos(0),1,eps)'); +%! dispatch('cos','string') + +%!test # override pre-loaded oct-file +%! evalin('base','qr(1);'); +%! dispatch('qr','length','string') +%! evalin('base','assert(qr("abc"),3)'); +%! evalin('base','assert(qr(1),1)'); +%! dispatch('qr','string'); + +%!test # override pre-loaded m-file +%! evalin('base','hanning(1);'); +%! dispatch('hanning','length','string') +%! evalin('base','assert(hanning("abc"),3)'); +%! evalin('base','assert(hanning(1),1)'); +%! dispatch('hanning','string'); diff --git a/octave_packages/m/deprecated/error_text.m b/octave_packages/m/deprecated/error_text.m new file mode 100644 index 0000000..4d13286 --- /dev/null +++ b/octave_packages/m/deprecated/error_text.m @@ -0,0 +1,36 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Built-in Function} {[@var{msg}, @var{msgid}] =} error_text (@var{msg}, @var{msgid}) +## This function has been deprecated. Use @code{lasterr} instead. +## @seealso{lasterr} +## @end deftypefn + +function [msg, msgid] = error_text (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "error_text is obsolete and will be removed from a future version of Octave, please use lasterr instead"); + endif + + [msg, msgid] = lasterr (varargin{:}); + +endfunction diff --git a/octave_packages/m/deprecated/fstat.m b/octave_packages/m/deprecated/fstat.m new file mode 100644 index 0000000..9383c13 --- /dev/null +++ b/octave_packages/m/deprecated/fstat.m @@ -0,0 +1,35 @@ +## Copyright (C) 2010-2012 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{info}, @var{err}, @var{msg}] =} fstat (fid) +## This function has been deprecated. Use stat instead. +## @end deftypefn + +## Deprecated in version 3.4 + +function [info, err, msg] = fstat (fid) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "fstat is obsolete and will be removed from a future version of Octave, please use stat instead"); + endif + + [info, err, msg] = stat (fid); +endfunction diff --git a/octave_packages/m/deprecated/gammai.m b/octave_packages/m/deprecated/gammai.m new file mode 100644 index 0000000..b9e21c2 --- /dev/null +++ b/octave_packages/m/deprecated/gammai.m @@ -0,0 +1,47 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gammai (@var{a}, @var{x}) +## This function is provided for compatibility with older versions of +## Octave. New programs should use @code{gammainc} instead. +## +## @code{gammai (@var{a}, @var{x})} is the same as +## @code{gammainc (@var{x}, @var{a})}. +## @end deftypefn + +## Author: jwe +## Created: 30 Jan 1998 + +## Deprecated in version 3.4 + +function retval = gammai (a, x) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "gammai is obsolete and will be removed from a future version of Octave; please use gammainc instead"); + endif + + if (nargin == 2) + retval = gammainc (x, a); + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/deprecated/glpkmex.m b/octave_packages/m/deprecated/glpkmex.m new file mode 100644 index 0000000..d826c35 --- /dev/null +++ b/octave_packages/m/deprecated/glpkmex.m @@ -0,0 +1,117 @@ +## Copyright (C) 2005-2012 Nicolo' Giorgetti +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{xopt}, @var{fmin}, @var{status}, @var{extra}] =} glpkmex (@var{sense}, @var{c}, @var{A}, @var{b}, @var{ctype}, @var{lb}, @var{ub}, @var{vartype}, @var{param}, @var{lpsolver}, @var{save_pb}) +## This function is provided for compatibility with the old @sc{matlab} +## interface to the GNU @sc{glpk} library. For Octave code, you should use +## the @code{glpk} function instead. +## @seealso{glpk} +## @end deftypefn + +function [xopt, fopt, status, extra] = glpkmex (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "glpkmex is obsolete and will be removed from a future version of Octave; please use glpk instead"); + endif + + ## If there is no input output the version and syntax + if (nargin < 4 || nargin > 11) + print_usage (); + return; + endif + + ## reorder args: + ## + ## glpkmex glpk + ## + ## 1 sense c + ## 2 c a + ## 3 a b + ## 4 b lb + ## 5 ctype ub + ## 6 lb ctype + ## 7 ub vartype + ## 8 vartype sense + ## 9 param param + ## 10 lpsolver + ## 11 savepb + + sense = varargin{1}; + c = varargin{2}; + a = varargin{3}; + b = varargin{4}; + + nx = length (c); + + if (nargin > 4) + ctype = varargin{5}; + else + ctype = repmat ("U", nx, 1); + endif + + if (nargin > 5) + lb = varargin{6}; + else + lb = repmat (-Inf, nx, 1); + endif + + if (nargin > 6) + ub = varargin{7}; + else + ub = repmat (Inf, nx, 1); + endif + + if (nargin > 7) + vartype = varargin{8}; + else + vartype = repmat ("C", nx, 1); + endif + + if (nargin > 8) + param = varargin{9}; + else + param = struct (); + endif + + if (nargin > 9 && ! isfield (param, "lpsolver")) + param.lpsolver = varargin{10}; + endif + + if (nargin > 10 && ! isfield (param, "save")) + param.save = varargin{11}; + endif + + if (nargout == 0) + glpk (c, a, b, lb, ub, ctype, vartype, sense, param); + elseif (nargout == 1) + xopt = glpk (c, a, b, lb, ub, ctype, vartype, sense, param); + elseif (nargout == 2) + [xopt, fopt] = glpk (c, a, b, lb, ub, ctype, vartype, sense, param); + elseif (nargout == 3) + [xopt, fopt, status] = ... + glpk (c, a, b, lb, ub, ctype, vartype, sense, param); + else + [xopt, fopt, status, extra] = ... + glpk (c, a, b, lb, ub, ctype, vartype, sense, param); + endif + +endfunction diff --git a/octave_packages/m/deprecated/intwarning.m b/octave_packages/m/deprecated/intwarning.m new file mode 100644 index 0000000..60c1960 --- /dev/null +++ b/octave_packages/m/deprecated/intwarning.m @@ -0,0 +1,133 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} intwarning (@var{action}) +## @deftypefnx {Function File} {} intwarning (@var{s}) +## @deftypefnx {Function File} {@var{s} =} intwarning (@dots{}) +## Control the state of the warning for integer conversions and math +## operations. +## +## @table @asis +## @item "query" +## With an output argument, return the current state of the integer +## conversion and math warnings. With no output arguments, print the +## current state. +## @c Set example in small font to prevent overfull line +## +## @smallexample +## @group +## intwarning ("query") +## The state of warning "Octave:int-convert-nan" is "off" +## The state of warning "Octave:int-convert-non-int-val" is "off" +## The state of warning "Octave:int-convert-overflow" is "off" +## The state of warning "Octave:int-math-overflow" is "off" +## @end group +## @end smallexample +## +## @item "on" +## @itemx "off" +## Turn integer conversion and math warnings on (or off). If there is +## no output argument, then nothing is printed. Otherwise the original +## state of the state of the integer conversion and math warnings is +## returned in a structure array. +## @end table +## +## The original state of the integer warnings can be restored by passing +## the structure array returned by @code{intwarning} to a later call to +## @code{intwarning}. For example: +## +## @example +## @group +## s = intwarning ("off"); +## @dots{} +## intwarning (s); +## @end group +## @end example +## @seealso{warning} +## @end deftypefn + +## Deprecated in v. 3.4 + +function y = intwarning (x) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "intwarning is obsolete and will be removed from a future version of Octave; integer math no longer produces warnings -- supply your own checks if you need those"); + endif + + return; + + if (nargin != 1) + print_usage (); + else + if (nargout > 0) + y = warning("query", "Octave:int-convert-nan"); + y = [y; warning("query", "Octave:int-convert-non-int-val")]; + y = [y; warning("query", "Octave:int-convert-overflow")]; + y = [y; warning("query", "Octave:int-math-overflow")]; + endif + if (ischar (x)) + if (strcmpi (x, "query")) + if (nargout == 0) + __print_int_warn_state__ ("Octave:int-convert-nan"); + __print_int_warn_state__ ("Octave:int-convert-non-int-val"); + __print_int_warn_state__ ("Octave:int-convert-overflow"); + __print_int_warn_state__ ("Octave:int-math-overflow"); + printf("\n"); + endif + elseif (strcmpi (x, "on")) + warning ("on", "Octave:int-convert-nan"); + warning ("on", "Octave:int-convert-non-int-val"); + warning ("on", "Octave:int-convert-overflow"); + warning ("on", "Octave:int-math-overflow"); + elseif (strcmpi (x, "off")) + warning ("off", "Octave:int-convert-nan"); + warning ("off", "Octave:int-convert-non-int-val"); + warning ("off", "Octave:int-convert-overflow"); + warning ("off", "Octave:int-math-overflow"); + else + error ("intwarning: unrecognized argument"); + endif + elseif (isstruct(x)) + for fld = fieldnames (x) + if (strcmp ("Octave:int-convert-nan") + || strcmp ("Octave:int-convert-non-int-val") + || strcmp ("Octave:int-convert-overflow") + || strcmp ("Octave:int-cmath-overflow")) + s = getfield (x, fld); + if (! ischar (s) || !(strcmpi("s","on") || strcmpi("s","off"))) + error ("intwarning: unexpected warning state"); + endif + warning (s, fld); + else + error ("intwarning: unrecognized integer warning %s", fld); + endif + endfor + else + error ("intwarning: unexpected input"); + endif + endif +endfunction + +function __print_int_warn_state__ (s) + fprintf ("The state of warning \"%s\" is \"%s\"\n", + s, warning ("query", s).state); +endfunction diff --git a/octave_packages/m/deprecated/is_duplicate_entry.m b/octave_packages/m/deprecated/is_duplicate_entry.m new file mode 100644 index 0000000..7dd4b80 --- /dev/null +++ b/octave_packages/m/deprecated/is_duplicate_entry.m @@ -0,0 +1,53 @@ +## Copyright (C) 1996-2012 A. S. Hodel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} is_duplicate_entry (@var{x}) +## Return non-zero if any entries in @var{x} are duplicates of one +## another. +## @seealso{unique} +## @end deftypefn + +## Author: A. S. Hodel + +function retval = is_duplicate_entry (x) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "is_duplicate_entry is obsolete and will be removed from a future version of Octave; see the function unique for equivalent functionality"); + endif + + + if (nargin == 1) + if (ismatrix (x)) + lx = numel (x); + lx1 = lx-1; + x = sort (reshape (x, 1, lx)); + dx = x(1:lx1) - x(2:lx); + retval = sum (dx == 0); + else + error ("is_duplicate_entry: expecting matrix argument"); + endif + else + print_usage (); + endif + +endfunction + diff --git a/octave_packages/m/deprecated/is_global.m b/octave_packages/m/deprecated/is_global.m new file mode 100644 index 0000000..8482576 --- /dev/null +++ b/octave_packages/m/deprecated/is_global.m @@ -0,0 +1,37 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} is_global (@var{name}) +## This function is provided for compatibility with older versions of +## Octave. New programs should use isglobal instead. +## @end deftypefn + +## Deprecated in version 3.4 + +function retval = is_global (name) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "is_global is obsolete and will be removed from a future version of Octave; please use isglobal instead"); + endif + + retval = isglobal(name); + +endfunction diff --git a/octave_packages/m/deprecated/isstr.m b/octave_packages/m/deprecated/isstr.m new file mode 100644 index 0000000..c6c33de --- /dev/null +++ b/octave_packages/m/deprecated/isstr.m @@ -0,0 +1,40 @@ +## Copyright (C) 2003-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isstr (@var{a}) +## This function has been deprecated. Use ischar instead. +## @end deftypefn + +## Author: jwe + +## Deprecated in version 3.0 +## Matlab still has this function, so don't remove just yet. + +function retval = isstr (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "isstr is obsolete and will be removed from a future version of Octave, please use ischar instead"); + endif + + retval = ischar (varargin{:}); + +endfunction diff --git a/octave_packages/m/deprecated/krylovb.m b/octave_packages/m/deprecated/krylovb.m new file mode 100644 index 0000000..dab85a8 --- /dev/null +++ b/octave_packages/m/deprecated/krylovb.m @@ -0,0 +1,46 @@ +## Copyright (C) 1993-2012 A. Scottedward Hodel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{u}, @var{ucols}] =} krylovb (@var{A}, @var{V}, @var{k}, @var{eps1}, @var{pflg}) +## See @code{krylov}. +## @end deftypefn + +## Deprecated in version 3.4 + +function [Uret, Ucols] = krylovb (A, V, k, eps1, pflg) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "krylovb is obsolete and will be removed from a future version of Octave; please use [Uret, ~, Ucols] = krylov (...) instead"); + endif + + switch (nargin) + case (3) + [Uret, H, Ucols] = krylov (A, V, k); + case (4) + [Uret, H, Ucols] = krylov (A, V, k, eps1); + case (5) + [Uret, H, Ucols] = krylov (A, V, k, eps1, pflg); + otherwise + print_usage (); + endswitch + +endfunction diff --git a/octave_packages/m/deprecated/perror.m b/octave_packages/m/deprecated/perror.m new file mode 100644 index 0000000..1201d2a --- /dev/null +++ b/octave_packages/m/deprecated/perror.m @@ -0,0 +1,45 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} perror (@var{funcname}, @var{num}) +## Print the error message for function @var{funcname} corresponding to the +## error number @var{num}. This function is intended to be used to print +## useful error messages for those functions that return numeric error +## codes. +## @seealso{strerror} +## @end deftypefn + +## Author: jwe + +function perror (funcname, num) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "perror is obsolete and will be removed from a future version of Octave."); + endif + + if (nargin != 2) + print_usage (); + else + printf (strerror (funcname, num)); + endif + +endfunction diff --git a/octave_packages/m/deprecated/polyderiv.m b/octave_packages/m/deprecated/polyderiv.m new file mode 100644 index 0000000..47f5ea5 --- /dev/null +++ b/octave_packages/m/deprecated/polyderiv.m @@ -0,0 +1,108 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polyderiv (@var{p}) +## @deftypefnx {Function File} {[@var{k}] =} polyderiv (@var{a}, @var{b}) +## @deftypefnx {Function File} {[@var{q}, @var{d}] =} polyderiv (@var{b}, @var{a}) +## Return the coefficients of the derivative of the polynomial whose +## coefficients are given by the vector @var{p}. If a pair of polynomials +## is given, return the derivative of the product @math{@var{a}*@var{b}}. +## If two inputs and two outputs are given, return the derivative of the +## polynomial quotient @math{@var{b}/@var{a}}. The quotient numerator is +## in @var{q} and the denominator in @var{d}. +## @seealso{poly, polyint, polyreduce, roots, conv, deconv, residue, +## filter, polygcd, polyval, polyvalm} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function [q, d] = polyderiv (p, a) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "polyderiv is obsolete and will be removed from a future version of Octave; please use polyder instead"); + endif + + if (nargin == 1 || nargin == 2) + if (! isvector (p)) + error ("polyderiv: argument must be a vector"); + endif + if (nargin == 2) + if (! isvector (a)) + error ("polyderiv: argument must be a vector"); + endif + if (nargout == 1) + ## derivative of p*a returns a single polynomial + q = polyderiv (conv (p, a)); + else + ## derivative of p/a returns numerator and denominator + d = conv (a, a); + if (numel (p) == 1) + q = -p * polyderiv (a); + elseif (numel (a) == 1) + q = a * polyderiv (p); + else + q = conv (polyderiv (p), a) - conv (p, polyderiv (a)); + q = polyreduce (q); + endif + + ## remove common factors from numerator and denominator + x = polygcd (q, d); + if (length(x) != 1) + q = deconv (q, x); + d = deconv (d, x); + endif + + ## move all the gain into the numerator + q = q/d(1); + d = d/d(1); + endif + else + lp = numel (p); + if (lp == 1) + q = 0; + return; + elseif (lp == 0) + q = []; + return; + endif + + ## Force P to be a row vector. + p = p(:).'; + + q = p(1:(lp-1)) .* [(lp-1):-1:1]; + endif + else + print_usage (); + endif + +endfunction + +%!assert(all (all (polyderiv ([1, 2, 3]) == [2, 2]))); + +%!assert(polyderiv (13) == 0); + +%!error polyderiv ([]); + +%!error polyderiv ([1, 2; 3, 4]); + diff --git a/octave_packages/m/deprecated/replot.m b/octave_packages/m/deprecated/replot.m new file mode 100644 index 0000000..7e806e5 --- /dev/null +++ b/octave_packages/m/deprecated/replot.m @@ -0,0 +1,43 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} replot () +## Refresh the plot window. +## @end deftypefn + +## Author: jwe + +## Deprecated in version 3.4 + +function replot () + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "replot is obsolete and will be removed from a future version of Octave; please use refresh instead"); + endif + + if (nargin == 0) + drawnow (); + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/deprecated/saveimage.m b/octave_packages/m/deprecated/saveimage.m new file mode 100644 index 0000000..d28765f --- /dev/null +++ b/octave_packages/m/deprecated/saveimage.m @@ -0,0 +1,314 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} saveimage (@var{fname}, @var{img}, @var{fmt}) +## @deftypefnx {Function File} {} saveimage (@var{fname}, @var{img}, @var{fmt}, @var{map}) +## Save the matrix @var{img} to file @var{fname} in image format @var{fmt}. +## Valid values for @var{fmt} are +## +## @table @asis +## @item "img" +## Octave's image format. The current colormap is also saved in the file. +## +## @item "ppm" +## Portable pixmap format. +## +## @item "ps" +## PostScript format. +## @end table +## +## If the fourth argument is supplied, the specified colormap will also be +## saved along with the image. +## +## Note: if the colormap contains only two entries and these entries are +## black and white, the bitmap ppm and PostScript formats are used. If the +## image is a gray scale image (the entries within each row of the colormap +## are equal) the gray scale ppm and PostScript image formats are used, +## otherwise the full color formats are used. +## @seealso{imread, save, load, colormap} +## @end deftypefn + +## The conversion to PostScript is based on pbmtolps.c, which was +## written by +## +## George Phillips +## Department of Computer Science +## University of British Columbia +## +## and is part of the portable bitmap utilities, + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +## Rewritten by jwe to avoid using octoppm and pbm routines so that +## people who don't have the pbm stuff installed can still use this +## function. +## +## The conversion to PostScript is based on pnmtops.c, which is part of +## the portable bitmap utilties and bears this copyright notice: +## +## Copyright (C) 1989 by Jef Poskanzer. +## +## Permission to use, copy, modify, and distribute this software and its +## documentation for any purpose and without fee is hereby granted, provided +## that the above copyright notice appear in all copies and that both that +## copyright notice and this permission notice appear in supporting +## documentation. This software is provided "as is" without express or +## implied warranty. + +function saveimage (fname, img, fmt, map) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "saveimage is obsolete and will be removed from a future version of Octave; please use imwrite instead"); + endif + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (nargin < 4) + if (size(img, 3) == 3) + [img, map] = rgb2ind(img); + else + map = colormap (); + endif + endif + + [map_nr, map_nc] = size (map); + + if (map_nc != 3) + error ("saveimage: MAP must be an N x 3 matrix"); + endif + + if (nargin < 3) + fmt = "img"; + elseif (! ischar (fmt)) + error ("saveimage: FMT specification must be a string"); + elseif (! (strcmp (fmt, "img") + || strcmp (fmt, "ppm") + || strcmp (fmt, "ps"))) + error ("saveimage: unsupported image format specification"); + endif + + if (! ismatrix (img)) + warning ("IMG variable is not a matrix"); + endif + + if (! ischar (fname)) + error ("saveimage: FNAME must be a string"); + endif + + ## If we just want Octave image format, save and return. + + if (strcmp (fmt, "img")) + save ("-text", fname, "map", "img"); + return; + endif + + ## Convert to another format if requested. + + grey = all (map(:,1) == map(:,2) && map(:,1) == map (:,3)); + + pbm = pgm = ppm = 0; + + map_sz = map_nr * map_nc; + + map = reshape (map, map_sz, 1); + + map (map > 1) = 1; + map (map < 0) = 0; + + map = round (255 * map); + + bw = (map_nr == 2 + && ((map(1,1) == 0 && map(2,1) == 255) + || (map(1,1) == 255 && map(2,1) == 0))); + + img = round (img'); + [img_nr, img_nc] = size (img); + + img_sz = img_nr * img_nc; + img = reshape (img, img_sz, 1); + + img (img > map_nr) = map_nr; + img (img <= 0) = 1; + + if (strcmp (fmt, "ppm")) + + ## Would be nice to make this consistent with the line used by the + ## load/save functions, but we need a good way to get username and + ## hostname information. + + time_string = ctime (time ()); + time_string = time_string (1:length (time_string)-1); + tagline = sprintf ("# Created by Octave %s, %s", + OCTAVE_VERSION, time_string); + + if (grey && bw) + + if (map(1) != 0) + map = [0; 1]; + else + map = [1; 0]; + endif + + n_long = rem (img_nc, 8); + tmp = zeros (ceil (img_nc/8), img_nr); + + k = ceil (img_nr/8); + tmp = zeros (k, img_nc); + + ## Append columns with zeros to original image so that + ## mod (cols, 8) = 0. + + bwimg = postpad (reshape (map(img), img_nr, img_nc), k * 8, 0); + + b = kron (pow2 (7:-1:0)', ones (1, img_nc)); + + for i = 1:k + tmp(i,:) = sum (bwimg(8*(i-1)+1:8*i,:) .* b); + endfor + + fid = fopen (fname, "wb"); + fprintf (fid, "P4\n%s\n%d %d\n", tagline, img_nr, img_nc); + fwrite (fid, tmp, "uchar"); + fprintf (fid, "\n"); + fclose (fid); + + elseif (grey) + + fid = fopen (fname, "wb"); + fprintf (fid, "P5\n%s\n%d %d\n255\n", tagline, img_nr, img_nc); + fwrite (fid, map(img), "uchar"); + fprintf (fid, "\n"); + fclose (fid); + + else + + img_idx = ((1:3:3*img_sz)+2)'; + map_idx = ((2*map_nr+1):map_sz)'; + + tmap = map(map_idx); + tmp(img_idx--) = tmap(img); + + map_idx = map_idx - map_nr; + tmap = map(map_idx); + tmp(img_idx--) = tmap(img); + + map_idx = map_idx - map_nr; + tmap = map(map_idx); + tmp(img_idx--) = tmap(img); + + fid = fopen (fname, "wb"); + fprintf (fid, "P6\n%s\n%d %d\n255\n", tagline, img_nr, img_nc); + fwrite (fid, tmp, "uchar"); + fprintf (fid, "\n"); + fclose (fid); + + endif + + elseif (strcmp (fmt, "ps") == 1) + + if (! grey) + error ("saveimage: must have a greyscale colormap for conversion to PostScript"); + endif + + bps = 8; + dpi = 300; + pagewid = 612; + pagehgt = 762; + MARGIN = 0.95; + devpix = dpi / 72.0 + 0.5; + pixfac = 72.0 / dpi * devpix; + + ## Compute padding to round cols * bps up to the nearest multiple of 8 + ## (nr and nc are switched because we transposed the image above). + + padright = (((img_nr * bps + 7) / 8) * 8 - img_nr * bps) / bps; + + scols = img_nr * pixfac; + srows = img_nc * pixfac; + scale = 1; + + if (scols > pagewid * MARGIN || srows > pagehgt * MARGIN) + if (scols > pagewid * MARGIN) + scale = scale * (pagewid / scols * MARGIN); + scols = scale * img_nr * pixfac; + srows = scale * img_nc * pixfac; + endif + if (srows > pagehgt * MARGIN) + scale = scale * (pagehgt / srows * MARGIN); + scols = scale * img_nr * pixfac; + srows = scale * img_nc * pixfac; + endif + warning ("image too large for page, rescaling to %g", scale); + endif + + llx = (pagewid - scols) / 2; + lly = (pagehgt - srows) / 2; + urx = llx + fix (scols + 0.5); + ury = lly + fix (srows + 0.5); + + fid = fopen (fname, "wb"); + + fprintf (fid, "%%!PS-Adobe-2.0 EPSF-2.0\n"); + fprintf (fid, "%%%%Creator: Octave %s (saveimage.m)\n", OCTAVE_VERSION); + fprintf (fid, "%%%%Title: %s\n", fname); + fprintf (fid, "%%%%Pages: 1\n"); + fprintf (fid, "%%%%BoundingBox: %d %d %d %d\n", + fix (llx), fix (lly), fix (urx), fix (ury)); + fprintf (fid, "%%%%EndComments\n"); + fprintf (fid, "/readstring {\n"); + fprintf (fid, " currentfile exch readhexstring pop\n"); + fprintf (fid, "} bind def\n"); + fprintf (fid, "/picstr %d string def\n", + fix ((img_nr + padright) * bps / 8)); + fprintf (fid, "%%%%EndProlog\n"); + fprintf (fid, "%%%%Page: 1 1\n"); + fprintf (fid, "gsave\n"); + fprintf (fid, "%g %g translate\n", llx, lly); + fprintf (fid, "%g %g scale\n", scols, srows); + fprintf (fid, "%d %d %d\n", img_nr, img_nc, bps); + fprintf (fid, "[ %d 0 0 -%d 0 %d ]\n", img_nr, img_nc, img_nc); + fprintf (fid, "{ picstr readstring }\n"); + fprintf (fid, "image\n"); + + img = map(img); + + fmt = "%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x%02x\n"; + fprintf (fid, fmt, img); + + if (rem (img_sz, 30) != 0) + fprintf (fid, "\n"); + endif + + fprintf (fid, "grestore\n"); + fprintf (fid, "showpage\n"); + fprintf (fid, "%%%%Trailer\n"); + fclose (fid); + + else + error ("saveimage: what happened to the image type?"); + endif + +endfunction diff --git a/octave_packages/m/deprecated/setstr.m b/octave_packages/m/deprecated/setstr.m new file mode 100644 index 0000000..b7594cf --- /dev/null +++ b/octave_packages/m/deprecated/setstr.m @@ -0,0 +1,40 @@ +## Copyright (C) 2003-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} setstr (@var{s}) +## This function has been deprecated. Use char instead. +## @end deftypefn + +## Author: jwe + +## Deprecated in version 3.0 +## Matlab still has this function, so don't remove just yet. + +function retval = setstr (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "setstr is obsolete and will be removed from a future version of Octave; please use char instead"); + endif + + retval = char (varargin{:}); + +endfunction diff --git a/octave_packages/m/deprecated/shell_cmd.m b/octave_packages/m/deprecated/shell_cmd.m new file mode 100644 index 0000000..ad12c3b --- /dev/null +++ b/octave_packages/m/deprecated/shell_cmd.m @@ -0,0 +1,68 @@ +## Copyright (C) 2012 Rik Wehbring +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## "-*- texinfo -*- +## @deftypefn {Built-in Function} {} shell_cmd (@var{string}) +## @deftypefnx {Built-in Function} {} shell_cmd (@var{string}, @var{return_output}) +## @deftypefnx {Built-in Function} {} shell_cmd (@var{string}, @var{return_output}, @var{type}) +## @deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} shell_cmd (@dots{}) +## @deftypefnx {Built-in Function} {[@var{status}, @var{output}] =} shell_cmd (@var{string}, @var{return_output}, @var{type}) +## Execute a shell command specified by @var{string}. +## If the optional argument @var{type} is "async", the process +## is started in the background and the process id of the child process +## is returned immediately. Otherwise, the process is started and +## Octave waits until it exits. If the @var{type} argument is omitted, it +## defaults to a value of "sync". +## +## If the optional argument @var{return_output} is true and the subprocess +## is started synchronously, or if @var{shell_cmd} is called with one input +## argument and one or more output arguments, then the output from the command +## is returned. Otherwise, if the subprocess is executed synchronously, its +## output is sent to the standard output. +## +## The @code{shell_cmd} function can return two values. The first is the +## exit status of the command and the second is any output from the +## command that was written to the standard output stream. For example, +## +## @example +## [status, output] = shell_cmd ("echo foo; exit 2"); +## @end example +## +## @noindent +## will set the variable @code{output} to the string @samp{foo}, and the +## variable @code{status} to the integer @samp{2}. +## +## For commands run asynchronously, @var{status} is the process id of the +## command shell that is started to run the command. +## @seealso{system, unix, dos} +## @end deftypefn + +## Deprecated in version 3.6 + +function [status, output] = shell_cmd (varargin) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "shell_cmd is obsolete and will be removed from a future version of Octave; please use system instead"); + endif + + [status, output] = system (varargin{:}); + +endfunction + diff --git a/octave_packages/m/deprecated/strerror.m b/octave_packages/m/deprecated/strerror.m new file mode 100644 index 0000000..9f6d14d --- /dev/null +++ b/octave_packages/m/deprecated/strerror.m @@ -0,0 +1,72 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} strerror (@var{name}, @var{num}) +## Return the text of an error message for function @var{name} +## corresponding to the error number @var{num}. This function is intended +## to be used to print useful error messages for those functions that +## return numeric error codes. +## @end deftypefn + +## Author: jwe + +function msg = strerror (name, num) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "strerror is obsolete and will be removed from a future version of Octave."); + endif + + if (nargin != 2) + print_usage (); + endif + + if (! ischar (name)) + error ("strerror: first argument must be a string"); + endif + + if (! isscalar (num)) + error ("strerror: second argument must be a scalar"); + endif + + if (strcmp (name, "fsolve")) + + if (num == -2) + msg = "input error\n"; + elseif (num == -1) + msg = "error encountered in user-supplied function\n"; + elseif (num == 1) + msg = "solution converged to requested tolerance\n"; + elseif (num == 3) + msg = "iteration is not making good progress\n"; + elseif (num == 4) + msg = "iteration limit exceeded\n"; + else + error ("strerror: unrecognized error code for fsolve"); + endif + + else + + error ("strerror: unrecognized function NAME"); + + endif + +endfunction diff --git a/octave_packages/m/deprecated/studentize.m b/octave_packages/m/deprecated/studentize.m new file mode 100644 index 0000000..20cef2d --- /dev/null +++ b/octave_packages/m/deprecated/studentize.m @@ -0,0 +1,94 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} studentize (@var{x}) +## @deftypefnx {Function File} {} studentize (@var{x}, @var{dim}) +## If @var{x} is a vector, subtract its mean and divide by its standard +## deviation. +## +## If @var{x} is a matrix, do the above along the first non-singleton +## dimension. +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{center} +## @end deftypefn + +## Author: KH +## Description: Subtract mean and divide by standard deviation + +function t = studentize (x, dim) + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "studentize is obsolete and will be removed from a future version of Octave; please use zscore instead"); + endif + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! isnumeric(x)) + error ("studentize: X must be a numeric vector or matrix"); + endif + + if (isinteger (x)) + x = double (x); + endif + + nd = ndims (x); + sz = size (x); + if (nargin != 2) + ## Find the first non-singleton dimension. + dim = find (sz > 1, 1); + if (isempty (dim)) + dim = 1; + endif + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("studentize: DIM must be an integer and a valid dimension"); + endif + endif + + c = sz(dim); + if (c == 0) + t = x; + else + idx = ones (1, nd); + idx(dim) = c; + t = x - repmat (mean (x, dim), idx); + t = t ./ repmat (max (cat (dim, std(t, [], dim), ! any (t, dim)), [], dim), idx); + endif + +endfunction + +%!assert(studentize ([1,2,3]), [-1,0,1]) +%!assert(studentize (int8 ([1,2,3])), [-1,0,1]) +#%!assert(studentize (ones (3,2,0,2)), zeros (3,2,0,2)) +%!assert(studentize ([2,0,-2;0,2,0;-2,-2,2]), [1,0,-1;0,1,0;-1,-1,1]) + +%% Test input validation +%!error studentize () +%!error studentize (1, 2, 3) +%!error studentize ([true true]) +%!error studentize (1, ones(2,2)) +%!error studentize (1, 1.5) +%!error studentize (1, 0) +%!error studentize (1, 3) + diff --git a/octave_packages/m/deprecated/sylvester_matrix.m b/octave_packages/m/deprecated/sylvester_matrix.m new file mode 100644 index 0000000..7c79ced --- /dev/null +++ b/octave_packages/m/deprecated/sylvester_matrix.m @@ -0,0 +1,69 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} sylvester_matrix (@var{k}) +## Return the Sylvester matrix of order +## @tex +## $n = 2^k$. +## @end tex +## @ifnottex +## n = 2^@var{k}. +## @end ifnottex +## +## @seealso{toeplitz, hankel} +## @end deftypefn + +## Author: jwe + +function retval = sylvester_matrix (k) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "sylvester_matrix is obsolete and will be removed from a future version of Octave; please use hadamard(2^k) instead"); + endif + + if (nargin != 1) + print_usage (); + endif + + if (isscalar (k)) + if (k < 1) + retval = 1; + else + tmp = sylvester_matrix (k-1); + retval = [tmp, tmp; tmp, -tmp]; + endif + else + error ("sylvester_matrix: expecting scalar argument"); + endif + +endfunction + +%!assert((sylvester_matrix (1) == [1, 1; 1, -1] +%! && (sylvester_matrix (2) +%! == [1, 1, 1, 1; 1, -1, 1, -1; 1, 1, -1, -1; 1, -1, -1, 1]))); + +%!error sylvester_matrix ([1, 2; 3, 4]); + +%!error sylvester_matrix (); + +%!error sylvester_matrix (1, 2); + diff --git a/octave_packages/m/deprecated/values.m b/octave_packages/m/deprecated/values.m new file mode 100644 index 0000000..c1d803b --- /dev/null +++ b/octave_packages/m/deprecated/values.m @@ -0,0 +1,61 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} values (@var{x}) +## Return the different values in a column vector, arranged in ascending +## order. +## +## As an example, @code{values([1, 2, 3, 1])} returns the vector +## @code{[1, 2, 3]}. +## @end deftypefn + +## Author: KH +## Description: Extract unique elements + +## Deprecated in version 3.4 + +function v = values (x) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "values is obsolete and will be removed from a future version of Octave; please use unique instead"); + endif + + if (nargin != 1) + print_usage (); + endif + + if (! (isvector (x))) + error ("values: X must be a vector"); + endif + + i = any (isnan (x)); + ## HACK! + x = x(find(!isnan (x))); + n = length (x); + x = reshape (x, n, 1); + s = sort (x); + v = s([1; (find (s(2:n) > s(1:n-1)) + 1)]); + if (i) + v = [v; NaN]; + endif + +endfunction diff --git a/octave_packages/m/deprecated/weibcdf.m b/octave_packages/m/deprecated/weibcdf.m new file mode 100644 index 0000000..3131e53 --- /dev/null +++ b/octave_packages/m/deprecated/weibcdf.m @@ -0,0 +1,47 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} weibcdf (@var{x}, @var{scale}, @var{shape}) +## Compute the cumulative distribution function (CDF) at @var{x} of the +## Weibull distribution with shape parameter @var{scale} and scale +## parameter @var{shape}, which is +## +## @example +## 1 - exp(-(x/shape)^scale) +## @end example +## +## @noindent +## for @var{x} @geq{} 0. +## @end deftypefn + +## Deprecated in version 3.0 +## Matlab still has this function, so don't remove just yet. + +function cdf = weibcdf (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "weibcdf is obsolete and will be removed from a future version of Octave; please use wblcdf instead"); + endif + + cdf = wblcdf (varargin{:}); + +endfunction diff --git a/octave_packages/m/deprecated/weibinv.m b/octave_packages/m/deprecated/weibinv.m new file mode 100644 index 0000000..4356594 --- /dev/null +++ b/octave_packages/m/deprecated/weibinv.m @@ -0,0 +1,40 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} weibinv (@var{x}, @var{scale}, @var{shape}) +## Compute the quantile (the inverse of the CDF) at @var{x} of the +## Weibull distribution with shape parameter @var{scale} and scale +## parameter @var{shape}. +## @end deftypefn + +## Deprecated in version 3.0 +## Matlab still has this function, so don't remove just yet. + +function inv = weibinv (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "weibinv is obsolete and will be removed from a future version of Octave; please use wblinv instead"); + endif + + inv = wblinv (varargin{:}); + +endfunction diff --git a/octave_packages/m/deprecated/weibpdf.m b/octave_packages/m/deprecated/weibpdf.m new file mode 100644 index 0000000..3b2a462 --- /dev/null +++ b/octave_packages/m/deprecated/weibpdf.m @@ -0,0 +1,47 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} weibpdf (@var{x}, @var{scale}, @var{shape}) +## Compute the probability density function (PDF) at @var{x} of the +## Weibull distribution with shape parameter @var{scale} and scale +## parameter @var{shape} which is given by +## +## @example +## scale * shape^(-scale) * x^(scale-1) * exp(-(x/shape)^scale) +## @end example +## +## @noindent +## for @var{x} > 0. +## @end deftypefn + +## Deprecated in version 3.0 +## Matlab still has this function, so don't remove just yet. + +function pdf = weibpdf (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "weibpdf is obsolete and will be removed from a future version of Octave; please use wblpdf instead"); + endif + + pdf = wblpdf (varargin{:}); + +endfunction diff --git a/octave_packages/m/deprecated/weibrnd.m b/octave_packages/m/deprecated/weibrnd.m new file mode 100644 index 0000000..a419934 --- /dev/null +++ b/octave_packages/m/deprecated/weibrnd.m @@ -0,0 +1,46 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} weibrnd (@var{scale}, @var{shape}, @var{r}, @var{c}) +## @deftypefnx {Function File} {} weibrnd (@var{scale}, @var{shape}, @var{sz}) +## Return an @var{r} by @var{c} matrix of random samples from the +## Weibull distribution with parameters @var{scale} and @var{shape} +## which must be scalar or of size @var{r} by @var{c}. Or if @var{sz} +## is a vector return a matrix of size @var{sz}. +## +## If @var{r} and @var{c} are omitted, the size of the result matrix is +## the common size of @var{alpha} and @var{sigma}. +## @end deftypefn + +## Deprecated in version 3.0 +## Matlab still has this function, so don't remove just yet. + +function rnd = weibrnd (varargin) + + persistent warned = false; + if (! warned) + warned = true; + warning ("Octave:deprecated-function", + "weibrnd is obsolete and will be removed from a future version of Octave; please use wblrnd instead"); + endif + + rnd = wblrnd (varargin{:}); + +endfunction + diff --git a/octave_packages/m/elfun/acosd.m b/octave_packages/m/elfun/acosd.m new file mode 100644 index 0000000..b2cdc11 --- /dev/null +++ b/octave_packages/m/elfun/acosd.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} acosd (@var{x}) +## Compute the inverse cosine in degrees for each element of @var{x}. +## @seealso{cosd, acos} +## @end deftypefn + +## Author: David Bateman + +function y = acosd (x) + if (nargin != 1) + print_usage (); + endif + y = acos(x) .* 180 ./ pi; +endfunction + +%!error(acosd()) +%!error(acosd(1,2)) +%!assert(acosd(0:0.1:1),180/pi*acos(0:0.1:1),-10*eps) diff --git a/octave_packages/m/elfun/acot.m b/octave_packages/m/elfun/acot.m new file mode 100644 index 0000000..3967214 --- /dev/null +++ b/octave_packages/m/elfun/acot.m @@ -0,0 +1,47 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} acot (@var{x}) +## Compute the inverse cotangent in radians for each element of @var{x}. +## @seealso{cot, acotd} +## @end deftypefn + +## Author: jwe + +function y = acot (x) + + if (nargin != 1) + print_usage (); + endif + + y = atan (1./x); + +endfunction + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = [rt3, 1, rt3/3, 0, -rt3/3, -1, -rt3]; +%! v = [pi/6, pi/4, pi/3, pi/2, -pi/3, -pi/4, -pi/6]; +%! assert(all (abs (acot (x) - v) < sqrt (eps))); + +%!error acot (); + +%!error acot (1, 2); + diff --git a/octave_packages/m/elfun/acotd.m b/octave_packages/m/elfun/acotd.m new file mode 100644 index 0000000..ced3644 --- /dev/null +++ b/octave_packages/m/elfun/acotd.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} acotd (@var{x}) +## Compute the inverse cotangent in degrees for each element of @var{x}. +## @seealso{cotd, acot} +## @end deftypefn + +## Author: David Bateman + +function y = acotd (x) + if (nargin != 1) + print_usage (); + endif + y = atand (1 ./ x); +endfunction + +%!error(acotd()) +%!error(acotd(1,2)) +%!assert(acotd(0:10:90),180./pi.*acot(0:10:90),-10*eps) diff --git a/octave_packages/m/elfun/acoth.m b/octave_packages/m/elfun/acoth.m new file mode 100644 index 0000000..548a133 --- /dev/null +++ b/octave_packages/m/elfun/acoth.m @@ -0,0 +1,47 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} acoth (@var{x}) +## Compute the inverse hyperbolic cotangent of each element of @var{x}. +## @seealso{coth} +## @end deftypefn + +## Author: jwe + +function y = acoth (x) + + if (nargin != 1) + print_usage (); + endif + + y = atanh (1 ./ x); + +endfunction + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = -i*[pi/6, pi/4, pi/3, -pi/3, -pi/4, -pi/6]; +%! x = i*[rt3, 1, rt3/3, -rt3/3, -1, -rt3]; +%! assert(all (abs (acoth (x) - v) < sqrt (eps))); + +%!error acoth (); + +%!error acoth (1, 2); + diff --git a/octave_packages/m/elfun/acsc.m b/octave_packages/m/elfun/acsc.m new file mode 100644 index 0000000..89b66a3 --- /dev/null +++ b/octave_packages/m/elfun/acsc.m @@ -0,0 +1,47 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} acsc (@var{x}) +## Compute the inverse cosecant in radians for each element of @var{x}. +## @seealso{csc, acscd} +## @end deftypefn + +## Author: jwe + +function y = acsc (x) + + if (nargin != 1) + print_usage (); + endif + + y = asin (1 ./ x); + +endfunction + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = [pi/6, pi/4, pi/3, pi/2, pi/3, pi/4, pi/6]; +%! x = [2, rt2, 2*rt3/3, 1, 2*rt3/3, rt2, 2]; +%! assert(all (abs (acsc (x) - v) < sqrt (eps))); + +%!error acsc (); + +%!error acsc (1, 2); + diff --git a/octave_packages/m/elfun/acscd.m b/octave_packages/m/elfun/acscd.m new file mode 100644 index 0000000..4de4098 --- /dev/null +++ b/octave_packages/m/elfun/acscd.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} acscd (@var{x}) +## Compute the inverse cosecant in degrees for each element of @var{x}. +## @seealso{cscd, acsc} +## @end deftypefn + +## Author: David Bateman + +function y = acscd (x) + if (nargin != 1) + print_usage (); + endif + y = acsc(x) .* 180 ./ pi; +endfunction + +%!error(acscd()) +%!error(acscd(1,2)) +%!assert(acscd(0:10:90),180/pi*acsc(0:10:90),-10*eps) diff --git a/octave_packages/m/elfun/acsch.m b/octave_packages/m/elfun/acsch.m new file mode 100644 index 0000000..7926df4 --- /dev/null +++ b/octave_packages/m/elfun/acsch.m @@ -0,0 +1,45 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} acsch (@var{x}) +## Compute the inverse hyperbolic cosecant of each element of @var{x}. +## @seealso{csch} +## @end deftypefn + +## Author: jwe + +function y = acsch (x) + + if (nargin != 1) + print_usage (); + endif + + y = asinh (1 ./ x); + +endfunction + +%!test +%! v = [pi/2*i, -pi/2*i]; +%! x = [-i, i]; +%! assert(all (abs (acsch (x) - v) < sqrt (eps))); + +%!error acsch (); + +%!error acsch (1, 2); + diff --git a/octave_packages/m/elfun/asec.m b/octave_packages/m/elfun/asec.m new file mode 100644 index 0000000..e67283d --- /dev/null +++ b/octave_packages/m/elfun/asec.m @@ -0,0 +1,46 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} asec (@var{x}) +## Compute the inverse secant in radians for each element of @var{x}. +## @seealso{sec, asecd} +## @end deftypefn + +## Author: jwe + +function y = asec (x) + + if (nargin != 1) + print_usage (); + endif + + y = acos (1 ./ x); + +endfunction + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! v = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! x = [1, 2*rt3/3, rt2, 2, -2, -rt2, -2*rt3/3, -1]; +%! assert(all (abs (asec (x) - v) < sqrt (eps))); + +%!error asec (); + +%!error asec (1, 2); diff --git a/octave_packages/m/elfun/asecd.m b/octave_packages/m/elfun/asecd.m new file mode 100644 index 0000000..1698263 --- /dev/null +++ b/octave_packages/m/elfun/asecd.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} asecd (@var{x}) +## Compute the inverse secant in degrees for each element of @var{x}. +## @seealso{secd, asec} +## @end deftypefn + +## Author: David Bateman + +function y = asecd (x) + if (nargin != 1) + print_usage (); + endif + y = asec (x) .* 180 ./ pi; +endfunction; + +%!error(asecd()) +%!error(asecd(1,2)) +%!assert(asecd(0:10:90),180./pi.*asec(0:10:90),-10*eps) diff --git a/octave_packages/m/elfun/asech.m b/octave_packages/m/elfun/asech.m new file mode 100644 index 0000000..0bf1d48 --- /dev/null +++ b/octave_packages/m/elfun/asech.m @@ -0,0 +1,45 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} asech (@var{x}) +## Compute the inverse hyperbolic secant of each element of @var{x}. +## @seealso{sech} +## @end deftypefn + +## Author: jwe + +function y = asech (x) + + if (nargin != 1) + print_usage (); + endif + + y = acosh (1 ./ x); + +endfunction + +%!test +%! v = [0, pi*i]; +%! x = [1, -1]; +%! assert(all (abs (asech (x) - v) < sqrt (eps))); + +%!error asech (); + +%!error asech (1, 2); + diff --git a/octave_packages/m/elfun/asind.m b/octave_packages/m/elfun/asind.m new file mode 100644 index 0000000..38a5b62 --- /dev/null +++ b/octave_packages/m/elfun/asind.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} asind (@var{x}) +## Compute the inverse sine in degrees for each element of @var{x}. +## @seealso{sind, asin} +## @end deftypefn + +## Author: David Bateman + +function y = asind (x) + if (nargin != 1) + print_usage (); + endif + y = asin(x) .* 180 ./ pi; +endfunction + +%!error(asind()) +%!error(asind(1,2)) +%!assert(asind(0:0.1:1),180/pi*asin(0:0.1:1),-10*eps) diff --git a/octave_packages/m/elfun/atand.m b/octave_packages/m/elfun/atand.m new file mode 100644 index 0000000..57e9d77 --- /dev/null +++ b/octave_packages/m/elfun/atand.m @@ -0,0 +1,36 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} atand (@var{x}) +## Compute the inverse tangent in degrees for each element of @var{x}. +## @seealso{tand, atan} +## @end deftypefn + +## Author: David Bateman + +function y = atand (x) + if (nargin != 1) + print_usage (); + endif + y = 180 ./ pi .* atan (x); +endfunction + +%!error(atand()) +%!error(atand(1,2)) +%!assert(atand(0:10:90),180./pi.*atan(0:10:90),-10*eps) diff --git a/octave_packages/m/elfun/cosd.m b/octave_packages/m/elfun/cosd.m new file mode 100644 index 0000000..0e3206c --- /dev/null +++ b/octave_packages/m/elfun/cosd.m @@ -0,0 +1,42 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cosd (@var{x}) +## Compute the cosine for each element of @var{x} in degrees. Returns zero +## for elements where @code{(@var{x}-90)/180} is an integer. +## @seealso{acosd, cos} +## @end deftypefn + +## Author: David Bateman + +function y = cosd (x) + if (nargin != 1) + print_usage (); + endif + I = x / 180; + y = cos (I .* pi); + I = I + 0.5; + y(I == fix (I) & finite (I)) = 0; +endfunction + +%!error(cosd()) +%!error(cosd(1,2)) +%!assert(cosd(0:10:80),cos(pi*[0:10:80]/180),-10*eps) +%!assert(cosd([0,180,360]) != 0) +%!assert(cosd([90,270]) == 0) diff --git a/octave_packages/m/elfun/cot.m b/octave_packages/m/elfun/cot.m new file mode 100644 index 0000000..1e2e243 --- /dev/null +++ b/octave_packages/m/elfun/cot.m @@ -0,0 +1,47 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} cot (@var{x}) +## Compute the cotangent for each element of @var{x} in radians. +## @seealso{acot, cotd, coth} +## @end deftypefn + +## Author: jwe + +function y = cot (x) + + if (nargin != 1) + print_usage (); + endif + + y = 1 ./ tan(x); + +endfunction + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = [pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6]; +%! v = [rt3, 1, rt3/3, 0, -rt3/3, -1, -rt3]; +%! assert(all (abs (cot (x) - v) < sqrt (eps))); + +%!error cot (); + +%!error cot (1, 2); + diff --git a/octave_packages/m/elfun/cotd.m b/octave_packages/m/elfun/cotd.m new file mode 100644 index 0000000..7741034 --- /dev/null +++ b/octave_packages/m/elfun/cotd.m @@ -0,0 +1,38 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cotd (@var{x}) +## Compute the cotangent for each element of @var{x} in degrees. +## @seealso{acotd, cot} +## @end deftypefn + +## Author: David Bateman + +function y = cotd (x) + if (nargin != 1) + print_usage (); + endif + y = 1 ./ tand (x); +endfunction + +%!error(cotd()) +%!error(cotd(1,2)) +%!assert(cotd(10:10:80),cot(pi*[10:10:80]/180),-10*eps) +%!assert(cotd([0,180,360]) == Inf) +%!assert(cotd([90,270]) == 0) diff --git a/octave_packages/m/elfun/coth.m b/octave_packages/m/elfun/coth.m new file mode 100644 index 0000000..4ae42bb --- /dev/null +++ b/octave_packages/m/elfun/coth.m @@ -0,0 +1,45 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} coth (@var{x}) +## Compute the hyperbolic cotangent of each element of @var{x}. +## @seealso{acoth} +## @end deftypefn + +## Author: jwe + +function y = coth (x) + + if (nargin != 1) + print_usage (); + endif + + y = 1 ./ tanh (x); + +endfunction + +%!test +%! x = [pi/2*i, 3*pi/2*i]; +%! v = [0, 0]; +%! assert(all (abs (coth (x) - v) < sqrt (eps))); + +%!error coth (); + +%!error coth (1, 2); + diff --git a/octave_packages/m/elfun/csc.m b/octave_packages/m/elfun/csc.m new file mode 100644 index 0000000..1dcf416 --- /dev/null +++ b/octave_packages/m/elfun/csc.m @@ -0,0 +1,47 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} csc (@var{x}) +## Compute the cosecant for each element of @var{x} in radians. +## @seealso{acsc, cscd, csch} +## @end deftypefn + +## Author: jwe + +function y = csc (x) + + if (nargin != 1) + print_usage (); + endif + + y = 1 ./ sin(x); + +endfunction + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = [pi/6, pi/4, pi/3, pi/2, 2*pi/3, 3*pi/4, 5*pi/6]; +%! v = [2, rt2, 2*rt3/3, 1, 2*rt3/3, rt2, 2]; +%! assert(all (abs (csc (x) - v) < sqrt (eps))); + +%!error csc (); + +%!error csc (1, 2); + diff --git a/octave_packages/m/elfun/cscd.m b/octave_packages/m/elfun/cscd.m new file mode 100644 index 0000000..98c66ae --- /dev/null +++ b/octave_packages/m/elfun/cscd.m @@ -0,0 +1,39 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cscd (@var{x}) +## Compute the cosecant for each element of @var{x} in degrees. +## @seealso{acscd, csc} +## @end deftypefn + +## Author: David Bateman + +function y = cscd (x) + if (nargin != 1) + print_usage (); + endif + y = 1 ./ sind (x); +endfunction + +%!error(cscd()) +%!error(cscd(1,2)) +%!assert(cscd(10:10:90),csc(pi*[10:10:90]/180),-10*eps) +%!assert(cscd([0,180,360]) == Inf) +%!assert(cscd([90,270]) != Inf) + diff --git a/octave_packages/m/elfun/csch.m b/octave_packages/m/elfun/csch.m new file mode 100644 index 0000000..4cd8740 --- /dev/null +++ b/octave_packages/m/elfun/csch.m @@ -0,0 +1,45 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} csch (@var{x}) +## Compute the hyperbolic cosecant of each element of @var{x}. +## @seealso{acsch} +## @end deftypefn + +## Author: jwe + +function y = csch (x) + + if (nargin != 1) + print_usage (); + endif + + y = 1 ./ sinh(x); + +endfunction + +%!test +%! x = [pi/2*i, 3*pi/2*i]; +%! v = [-i, i]; +%! assert(all (abs (csch (x) - v) < sqrt (eps))); + +%!error csch (); + +%!error csch (1, 2); + diff --git a/octave_packages/m/elfun/sec.m b/octave_packages/m/elfun/sec.m new file mode 100644 index 0000000..1ba7824 --- /dev/null +++ b/octave_packages/m/elfun/sec.m @@ -0,0 +1,47 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} sec (@var{x}) +## Compute the secant for each element of @var{x} in radians. +## @seealso{asec, secd, sech} +## @end deftypefn + +## Author: jwe + +function y = sec (x) + + if (nargin != 1) + print_usage (); + endif + + y = 1 ./ cos(x); + +endfunction + +%!test +%! rt2 = sqrt (2); +%! rt3 = sqrt (3); +%! x = [0, pi/6, pi/4, pi/3, 2*pi/3, 3*pi/4, 5*pi/6, pi]; +%! v = [1, 2*rt3/3, rt2, 2, -2, -rt2, -2*rt3/3, -1]; +%! assert(all (abs (sec (x) - v) < sqrt (eps))); + +%!error sec (); + +%!error sec (1, 2); + diff --git a/octave_packages/m/elfun/secd.m b/octave_packages/m/elfun/secd.m new file mode 100644 index 0000000..dec922d --- /dev/null +++ b/octave_packages/m/elfun/secd.m @@ -0,0 +1,38 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} secd (@var{x}) +## Compute the secant for each element of @var{x} in degrees. +## @seealso{asecd, sec} +## @end deftypefn + +## Author: David Bateman + +function y = secd (x) + if (nargin != 1) + print_usage (); + endif + y = 1 ./ cosd (x); +endfunction + +%!error(secd()) +%!error(secd(1,2)) +%!assert(secd(0:10:80),sec(pi*[0:10:80]/180),-10*eps) +%!assert(secd([0,180,360]) != Inf) +%!assert(secd([90,270]) == Inf) diff --git a/octave_packages/m/elfun/sech.m b/octave_packages/m/elfun/sech.m new file mode 100644 index 0000000..17d0d38 --- /dev/null +++ b/octave_packages/m/elfun/sech.m @@ -0,0 +1,45 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} sech (@var{x}) +## Compute the hyperbolic secant of each element of @var{x}. +## @seealso{asech} +## @end deftypefn + +## Author: jwe + +function y = sech (x) + +if (nargin != 1) + print_usage (); + endif + + y = 1 ./ cosh(x); + +endfunction + +%!test +%! x = [0, pi*i]; +%! v = [1, -1]; +%! assert(all (abs (sech (x) - v) < sqrt (eps))); + +%!error sech (); + +%!error sech (1, 2); + diff --git a/octave_packages/m/elfun/sind.m b/octave_packages/m/elfun/sind.m new file mode 100644 index 0000000..7bde16a --- /dev/null +++ b/octave_packages/m/elfun/sind.m @@ -0,0 +1,41 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} sind (@var{x}) +## Compute the sine for each element of @var{x} in degrees. Returns zero +## for elements where @code{@var{x}/180} is an integer. +## @seealso{asind, sin} +## @end deftypefn + +## Author: David Bateman + +function y = sind (x) + if (nargin != 1) + print_usage (); + endif + I = x / 180; + y = sin (I .* pi); + y(I == fix (I) & finite (I)) = 0; +endfunction + +%!error(sind()) +%!error(sind(1,2)) +%!assert(sind(10:10:90),sin(pi*[10:10:90]/180),-10*eps) +%!assert(sind([0,180,360]) == 0) +%!assert(sind([90,270]) != 0) diff --git a/octave_packages/m/elfun/tand.m b/octave_packages/m/elfun/tand.m new file mode 100644 index 0000000..86b1775 --- /dev/null +++ b/octave_packages/m/elfun/tand.m @@ -0,0 +1,44 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} tand (@var{x}) +## Compute the tangent for each element of @var{x} in degrees. Returns zero +## for elements where @code{@var{x}/180} is an integer and @code{Inf} for +## elements where @code{(@var{x}-90)/180} is an integer. +## @seealso{atand, tan} +## @end deftypefn + +## Author: David Bateman + +function y = tand (x) + if (nargin != 1) + print_usage (); + endif + I0 = x / 180; + I90 = (x-90) / 180; + y = tan (I0 .* pi); + y(I0 == fix (I0) & finite (I0)) = 0; + y(I90 == fix (I90) & finite (I90)) = Inf; +endfunction; + +%!error(tand()) +%!error(tand(1,2)) +%!assert(tand(10:10:80),tan(pi*[10:10:80]/180),-10*eps) +%!assert(tand([0,180,360]) == 0) +%!assert(tand([90,270]) == Inf) diff --git a/octave_packages/m/general/accumarray.m b/octave_packages/m/general/accumarray.m new file mode 100644 index 0000000..b18c966 --- /dev/null +++ b/octave_packages/m/general/accumarray.m @@ -0,0 +1,408 @@ +## Copyright (C) 2007-2012 David Bateman +## Copyright (C) 2009-2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} accumarray (@var{subs}, @var{vals}, @var{sz}, @var{func}, @var{fillval}, @var{issparse}) +## @deftypefnx {Function File} {} accumarray (@var{subs}, @var{vals}, @dots{}) +## +## Create an array by accumulating the elements of a vector into the +## positions defined by their subscripts. The subscripts are defined by +## the rows of the matrix @var{subs} and the values by @var{vals}. Each +## row of @var{subs} corresponds to one of the values in @var{vals}. If +## @var{vals} is a scalar, it will be used for each of the row of +## @var{subs}. If @var{subs} is a cell array of vectors, all vectors +## must be of the same length, and the subscripts in the @var{k}th +## vector must correspond to the @var{k}th dimension of the result. +## +## The size of the matrix will be determined by the subscripts +## themselves. However, if @var{sz} is defined it determines the matrix +## size. The length of @var{sz} must correspond to the number of columns +## in @var{subs}. An exception is if @var{subs} has only one column, in +## which case @var{sz} may be the dimensions of a vector and the +## subscripts of @var{subs} are taken as the indices into it. +## +## The default action of @code{accumarray} is to sum the elements with +## the same subscripts. This behavior can be modified by defining the +## @var{func} function. This should be a function or function handle +## that accepts a column vector and returns a scalar. The result of the +## function should not depend on the order of the subscripts. +## +## The elements of the returned array that have no subscripts associated +## with them are set to zero. Defining @var{fillval} to some other value +## allows these values to be defined. This behavior changes, however, +## for certain values of @var{func}. If @var{func} is @code{min} +## (respectively, @code{max}) then the result will be filled with the +## minimum (respectively, maximum) integer if @var{vals} is of integral +## type, logical false (respectively, logical true) if @var{vals} is of +## logical type, zero if @var{fillval} is zero and all values are +## non-positive (respectively, non-negative), and NaN otherwise. +## +## By default @code{accumarray} returns a full matrix. If +## @var{issparse} is logically true, then a sparse matrix is returned +## instead. +## +## The following @code{accumarray} example constructs a frequency table +## that in the first column counts how many occurrences each number in +## the second column has, taken from the vector @var{x}. Note the usage +## of @code{unique} for assigning to all repeated elements of @var{x} +## the same index (@pxref{doc-unique}). +## +## @example +## @group +## @var{x} = [91, 92, 90, 92, 90, 89, 91, 89, 90, 100, 100, 100]; +## [@var{u}, ~, @var{j}] = unique (@var{x}); +## [accumarray(@var{j}', 1), @var{u}'] +## @result{} 2 89 +## 3 90 +## 2 91 +## 2 92 +## 3 100 +## @end group +## @end example +## +## Another example, where the result is a multi-dimensional 3-D array and +## the default value (zero) appears in the output: +## +## @example +## @group +## accumarray ([1, 1, 1; +## 2, 1, 2; +## 2, 3, 2; +## 2, 1, 2; +## 2, 3, 2], 101:105) +## @result{} ans(:,:,1) = [101, 0, 0; 0, 0, 0] +## @result{} ans(:,:,2) = [0, 0, 0; 206, 0, 208] +## @end group +## @end example +## +## The sparse option can be used as an alternative to the @code{sparse} +## constructor (@pxref{doc-sparse}). Thus +## +## @example +## sparse (@var{i}, @var{j}, @var{sv}) +## @end example +## +## @noindent +## can be written with @code{accumarray} as +## +## @example +## accumarray ([@var{i}, @var{j}], @var{sv}', [], [], 0, true) +## @end example +## +## @noindent +## For repeated indices, @code{sparse} adds the corresponding value. To +## take the minimum instead, use @code{min} as an accumulator function: +## +## @example +## accumarray ([@var{i}, @var{j}], @var{sv}', [], @@min, 0, true) +## @end example +## +## The complexity of accumarray in general for the non-sparse case is +## generally O(M+N), where N is the number of subscripts and M is the +## maximum subscript (linearized in multi-dimensional case). If +## @var{func} is one of @code{@@sum} (default), @code{@@max}, +## @code{@@min} or @code{@@(x) @{x@}}, an optimized code path is used. +## Note that for general reduction function the interpreter overhead can +## play a major part and it may be more efficient to do multiple +## accumarray calls and compute the results in a vectorized manner. +## +## @seealso{accumdim, unique, sparse} +## @end deftypefn + +function A = accumarray (subs, vals, sz = [], func = [], fillval = [], issparse = []) + + if (nargin < 2 || nargin > 6) + print_usage (); + endif + + lenvals = length (vals); + + if (iscell (subs)) + subs = cellfun (@vec, subs, "uniformoutput", false); + ndims = numel (subs); + if (ndims == 1) + subs = subs{1}; + endif + + lensubs = cellfun (@length, subs); + + if (any (lensubs != lensubs(1)) || + (lenvals > 1 && lenvals != lensubs(1))) + error ("accumarray: dimension mismatch"); + endif + + else + ndims = columns (subs); + if (lenvals > 1 && lenvals != rows (subs)) + error ("accumarray: dimension mismatch") + endif + endif + + if (isempty (fillval)) + fillval = 0; + endif + + if (isempty (issparse)) + issparse = false; + endif + + if (issparse) + + ## Sparse case. Avoid linearizing the subscripts, because it could + ## overflow. + + if (fillval != 0) + error ("accumarray: FILLVAL must be zero in the sparse case"); + endif + + ## Ensure subscripts are a two-column matrix. + if (iscell (subs)) + subs = [subs{:}]; + endif + + ## Validate dimensions. + if (ndims == 1) + subs(:,2) = 1; + elseif (ndims != 2) + error ("accumarray: in the sparse case, needs 1 or 2 subscripts"); + endif + + if (isnumeric (vals) || islogical (vals)) + vals = double (vals); + else + error ("accumarray: in the sparse case, values must be numeric or logical"); + endif + + if (! (isempty (func) || func == @sum)) + + ## Reduce values. This is not needed if we're about to sum them, + ## because "sparse" can do that. + + ## Sort indices. + [subs, idx] = sortrows (subs); + n = rows (subs); + ## Identify runs. + jdx = find (any (diff (subs, 1, 1), 2)); + jdx = [jdx; n]; + + vals = cellfun (func, mat2cell (vals(:)(idx), diff ([0; jdx]))); + subs = subs(jdx, :); + mode = "unique"; + else + mode = "sum"; + endif + + ## Form the sparse matrix. + if (isempty (sz)) + A = sparse (subs(:,1), subs(:,2), vals, mode); + elseif (length (sz) == 2) + + ## Row vector case + if (sz(1) == 1) + [i, j] = deal (subs(:,2), subs(:,1)); + else + [i, j] = deal (subs(:,1), subs(:,2)); + endif + A = sparse (i, j, vals, sz(1), sz(2), mode); + else + error ("accumarray: dimensions mismatch"); + endif + + else + + ## Linearize subscripts. + if (ndims > 1) + if (isempty (sz)) + if (iscell (subs)) + sz = cellfun ("max", subs); + else + sz = max (subs, [], 1); + endif + elseif (ndims != length (sz)) + error ("accumarray: dimensions mismatch"); + endif + + ## Convert multidimensional subscripts. + if (ismatrix (subs)) + subs = num2cell (subs, 1); + endif + subs = sub2ind (sz, subs{:}); # creates index cache + elseif (! isempty (sz) && length (sz) < 2) + error ("accumarray: needs at least 2 dimensions"); + elseif (! isindex (subs)) # creates index cache + error ("accumarray: indices must be positive integers"); + endif + + + ## Some built-in reductions handled efficiently. + + if (isempty (func) || func == @sum) + ## Fast summation. + if (isempty (sz)) + A = __accumarray_sum__ (subs, vals); + else + A = __accumarray_sum__ (subs, vals, prod (sz)); + ## set proper shape. + A = reshape (A, sz); + endif + + ## we fill in nonzero fill value. + if (fillval != 0) + mask = true (size (A)); + mask(subs) = false; + A(mask) = fillval; + endif + elseif (func == @max) + ## Fast maximization. + + if (isinteger (vals)) + zero = intmin (class (vals)); + elseif (islogical (vals)) + zero = false; + elseif (fillval == 0 && all (vals(:) >= 0)) + ## This is a common case - fillval is zero, all numbers + ## nonegative. + zero = 0; + else + zero = NaN; # Neutral value. + endif + + if (isempty (sz)) + A = __accumarray_max__ (subs, vals, zero); + else + A = __accumarray_max__ (subs, vals, zero, prod (sz)); + A = reshape (A, sz); + endif + + if (fillval != zero && ! (isnan (fillval) || isnan (zero))) + mask = true (size (A)); + mask(subs) = false; + A(mask) = fillval; + endif + elseif (func == @min) + ## Fast minimization. + + if (isinteger (vals)) + zero = intmax (class (vals)); + elseif (islogical (vals)) + zero = true; + elseif (fillval == 0 && all (vals(:) <= 0)) + ## This is a common case - fillval is zero, all numbers + ## non-positive. + zero = 0; + else + zero = NaN; # Neutral value. + endif + + if (isempty (sz)) + A = __accumarray_min__ (subs, vals, zero); + else + A = __accumarray_min__ (subs, vals, zero, prod (sz)); + A = reshape (A, sz); + endif + + if (fillval != zero && ! (isnan (fillval) || isnan (zero))) + mask = true (size (A)); + mask(subs) = false; + A(mask) = fillval; + endif + else + + ## The general case. Reduce values. + n = rows (subs); + if (numel (vals) == 1) + vals = vals(ones (1, n), 1); + else + vals = vals(:); + endif + + ## Sort indices. + [subs, idx] = sort (subs); + ## Identify runs. + jdx = find (subs(1:n-1) != subs(2:n)); + jdx = [jdx; n]; + vals = mat2cell (vals(idx), diff ([0; jdx])); + ## Optimize the case when function is @(x) {x}, i.e. we just want + ## to collect the values to cells. + persistent simple_cell_str = func2str (@(x) {x}); + if (! strcmp (func2str (func), simple_cell_str)) + vals = cellfun (func, vals); + endif + subs = subs(jdx); + + if (isempty (sz)) + sz = max (subs); + if (length (sz) == 1) + sz(2) = 1; + endif + endif + + ## Construct matrix of fillvals. + if (iscell (vals)) + A = cell (sz); + elseif (fillval == 0) + A = zeros (sz, class (vals)); + else + A = repmat (fillval, sz); + endif + + ## Set the reduced values. + A(subs) = vals; + endif + endif +endfunction + +%!error (accumarray (1:5)) +%!error (accumarray ([1,2,3],1:2)) +%!assert (accumarray ([1;2;4;2;4],101:105), [101;206;0;208]) +%!assert (accumarray ([1,1,1;2,1,2;2,3,2;2,1,2;2,3,2],101:105),cat(3, [101,0,0;0,0,0],[0,0,0;206,0,208])) +%!assert (accumarray ([1,1,1;2,1,2;2,3,2;2,1,2;2,3,2],101:105,[],@(x)sin(sum(x))),sin(cat(3, [101,0,0;0,0,0],[0,0,0;206,0,208]))) +%!assert (accumarray ({[1 3 3 2 3 1 2 2 3 3 1 2],[3 4 2 1 4 3 4 2 2 4 3 4],[1 1 2 2 1 1 2 1 1 1 2 2]},101:112),cat(3,[0,0,207,0;0,108,0,0;0,109,0,317],[0,0,111,0;104,0,0,219;0,103,0,0])) +%!assert (accumarray ([1,1;2,1;2,3;2,1;2,3],101:105,[2,4],@max,NaN),[101,NaN,NaN,NaN;104,NaN,105,NaN]) +%!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105, [], @prod), [101, 0, 0; 10608, 0, 10815]) +%!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2 4],@prod,0,true),sparse([1,2,2],[1,1,3],[101,10608,10815],2,4)) +%!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],1,[2,4]), [1,0,0,0;2,0,2,0]) +%!assert (accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2,4],@(x)length(x)>1),[false,false,false,false;true,false,true,false]) +%!assert (accumarray ([1; 2], [3; 4], [2, 1], @min, [], 0), [3; 4]) +%!assert (accumarray ([1; 2], [3; 4], [2, 1], @min, [], 1), sparse ([3; 4])) +%!assert (accumarray ([1; 2], [3; 4], [1, 2], @min, [], 0), [3, 4]) +%!assert (accumarray ([1; 2], [3; 4], [1, 2], @min, [], 1), sparse ([3, 4])) +%!test +%! A = accumarray ([1 1; 2 1; 2 3; 2 1; 2 3],101:105,[2,4],@(x){x}); +%! assert (A{2},[102;104]) +%!test +%! subs = ceil (rand (2000, 3)*10); +%! vals = rand (2000, 1); +%! assert (accumarray (subs, vals, [], @max), accumarray (subs, vals, [], @(x) max (x))); +%!test +%! subs = ceil (rand (2000, 1)*100); +%! vals = rand (2000, 1); +%! assert (accumarray (subs, vals, [100, 1], @min, NaN), accumarray (subs, vals, [100, 1], @(x) min (x), NaN)); +%!test +%! subs = ceil (rand (2000, 2)*30); +%! subsc = num2cell (subs, 1); +%! vals = rand (2000, 1); +%! assert (accumarray (subsc, vals, [], [], 0, true), accumarray (subs, vals, [], [], 0, true)); +%!test +%! subs = ceil (rand (2000, 3)*10); +%! subsc = num2cell (subs, 1); +%! vals = rand (2000, 1); +%! assert (accumarray (subsc, vals, [], @max), accumarray (subs, vals, [], @max)); + + diff --git a/octave_packages/m/general/accumdim.m b/octave_packages/m/general/accumdim.m new file mode 100644 index 0000000..16a0acc --- /dev/null +++ b/octave_packages/m/general/accumdim.m @@ -0,0 +1,158 @@ +## Copyright (C) 2010-2012 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} accumdim (@var{subs}, @var{vals}, @var{dim}, @var{n}, @var{func}, @var{fillval}) +## Create an array by accumulating the slices of an array into the +## positions defined by their subscripts along a specified dimension. +## The subscripts are defined by the index vector @var{subs}. +## The dimension is specified by @var{dim}. If not given, it defaults +## to the first non-singleton dimension. The length of @var{subs} must +## be equal to @code{size (@var{vals}, @var{dim})}. +## +## The extent of the result matrix in the working dimension will be +## determined by the subscripts themselves. However, if @var{n} is +## defined it determines this extent. +## +## The default action of @code{accumdim} is to sum the subarrays with the +## same subscripts. This behavior can be modified by defining the +## @var{func} function. This should be a function or function handle +## that accepts an array and a dimension, and reduces the array along +## this dimension. As a special exception, the built-in @code{min} and +## @code{max} functions can be used directly, and @code{accumdim} +## accounts for the middle empty argument that is used in their calling. +## +## The slices of the returned array that have no subscripts associated +## with them are set to zero. Defining @var{fillval} to some other +## value allows these values to be defined. +## +## An example of the use of @code{accumdim} is: +## +## @example +## @group +## accumdim ([1, 2, 1, 2, 1], [ 7, -10, 4; +## -5, -12, 8; +## -12, 2, 8; +## -10, 9, -3; +## -5, -3, -13]) +## @result{} [-10,-11,-1;-15,-3,5] +## @end group +## @end example +## +## @seealso{accumarray} +## @end deftypefn + +function A = accumdim (subs, vals, dim, n = 0, func = [], fillval = 0) + + if (nargin < 2 || nargin > 5) + print_usage (); + endif + + if (isempty (fillval)) + fillval = 0; + endif + + if (! isvector (subs)) + error ("accumdim: SUBS must be a subscript vector"); + elseif (! isindex (subs)) # creates index cache + error ("accumdim: indices must be positive integers"); + else + m = max (subs); + if (n == 0 || isempty (n)) + n = m; + elseif (n < m) + error ("accumdim: N index out of range"); + endif + endif + + sz = size (vals); + + if (nargin < 3) + [~, dim] = max (sz != 1); # first non-singleton dim + elseif (! isindex (dim)) + error ("accumdim: DIM must be a valid dimension"); + elseif (dim > length (sz)) + sz(end+1:dim) = 1; + endif + sz(dim) = n; + + if (length (subs) != size (vals, dim)) + error ("accumdim: dimension mismatch") + endif + + if (isempty (func) || func == @sum) + ## Fast summation case. + A = __accumdim_sum__ (subs, vals, dim, n); + + ## Fill in nonzero fill value + if (fillval != 0) + mask = true (n, 1); + mask(subs) = false; + subsc = {':'}(ones (1, length (sz))); + subsc{dim} = mask; + A(subsc{:}) = fillval; + endif + return + endif + + ## The general case. + ns = length (subs); + ## Sort indices. + [subs, idx] = sort (subs(:)); + ## Identify runs. + jdx = find (subs(1:ns-1) != subs(2:ns)); + jdx = [jdx; ns]; + ## Collect common slices. + szc = num2cell (sz); + szc{dim} = diff ([0; jdx]); + subsc = {':'}(ones (1, length (sz))); + subsc{dim} = idx; + vals = mat2cell (vals(subsc{:}), szc{:}); + ## Apply reductions. Special case min, max. + if (func == @min || func == @max) + vals = cellfun (func, vals, {[]}, {dim}, "uniformoutput", false); + else + vals = cellfun (func, vals, {dim}, "uniformoutput", false); + endif + subs = subs(jdx); + + ## Concatenate reduced slices. + vals = cat (dim, vals{:}); + + ## Construct matrix of fillvals. + if (fillval == 0) + A = zeros (sz, class (vals)); + else + A = repmat (fillval, sz); + endif + + ## Set the reduced values. + subsc{dim} = subs; + A(subsc{:}) = vals; + +endfunction + +%%test accumdim vs. accumarray + +%!shared a +%! a = rand (5, 5, 5); + +%!assert (accumdim ([1;3;1;3;3], a)(:,2,3), accumarray ([1;3;1;3;3], a(:,2,3))) +%!assert (accumdim ([2;3;2;2;2], a, 2, 4)(4,:,2), accumarray ([2;3;2;2;2], a(4,:,2), [1,4])) +%!assert (accumdim ([2;3;2;1;2], a, 3, 3, @min)(1,5,:), accumarray ([2;3;2;1;2], a(1,5,:), [1,1,3], @min)) +%!assert (accumdim ([1;3;2;2;1], a, 2, 3, @median)(4,:,5), accumarray ([1;3;2;2;1], a(4,:,5), [1,3], @median)) diff --git a/octave_packages/m/general/bicubic.m b/octave_packages/m/general/bicubic.m new file mode 100644 index 0000000..7b504b1 --- /dev/null +++ b/octave_packages/m/general/bicubic.m @@ -0,0 +1,208 @@ +## Copyright (C) 2005-2012 Hoxide Ma +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{zi} =} bicubic (@var{x}, @var{y}, @var{z}, @var{xi}, @var{yi}, @var{extrapval}) +## +## Return a matrix @var{zi} corresponding to the bicubic +## interpolations at @var{xi} and @var{yi} of the data supplied +## as @var{x}, @var{y} and @var{z}. Points outside the grid are set +## to @var{extrapval}. +## +## See @url{http://wiki.woodpecker.org.cn/moin/Octave/Bicubic} +## for further information. +## @seealso{interp2} +## @end deftypefn + +## Bicubic interpolation method. +## Author: Hoxide Ma + +function zi = bicubic (x, y, z, xi, yi, extrapval, spline_alpha) + + if (nargin < 1 || nargin > 7) + print_usage (); + endif + + if (nargin == 7 && isscalar(spline_alpha)) + a = spline_alpha; + else + a = 0.5; + endif + + if (nargin < 6) + extrapval = NaN; + endif + + if (isa (x, "single") || isa (y, "single") || isa (z, "single") + || isa (xi, "single") || isa (yi, "single")) + myeps = eps("single"); + else + myeps = eps; + endif + + if (nargin <= 2) + ## bicubic (z) or bicubic (z, 2) + if (nargin == 1) + n = 1; + else + n = y; + endif + z = x; + x = []; + [rz, cz] = size (z); + s = linspace (1, cz, (cz-1)*pow2(n)+1); + t = linspace (1, rz, (rz-1)*pow2(n)+1); + elseif (nargin == 3) + if (! isvector (x) || ! isvector (y)) + error ("bicubic: XI and YI must be vector"); + endif + s = y; + t = z; + z = x; + [rz, cz] = size (z); + elseif (nargin == 5 || nargin == 6) + [rz, cz] = size (z) ; + if (isvector (x) && isvector (y)) + if (rz != length (y) || cz != length (x)) + error ("bicubic: length of X and Y must match the size of Z"); + endif + elseif (size_equal (x, y) && size_equal (x, z)) + x = x(1,:); + y = y(:,1); + else + error ("bicubic: X, Y and Z must be equal size matrices of same size"); + endif + + ## Mark values outside the lookup table. + xfirst_ind = find (xi < x(1)); + xlast_ind = find (xi > x(cz)); + yfirst_ind = find (yi < y(1)); + ylast_ind = find (yi > y(rz)); + ## Set value outside the table preliminary to min max index. + xi(xfirst_ind) = x(1); + xi(xlast_ind) = x(cz); + yi(yfirst_ind) = y(1); + yi(ylast_ind) = y(rz); + + + x = reshape (x, 1, cz); + x(cz) *= 1 + sign (x(cz))*myeps; + if (x(cz) == 0) + x(cz) = myeps; + endif; + xi = reshape (xi, 1, length (xi)); + [m, i] = sort ([x, xi]); + o = cumsum (i <= cz); + xidx = o(find (i > cz)); + + y = reshape (y, rz, 1); + y(rz) *= 1 + sign (y(rz))*myeps; + if (y(rz) == 0) + y(rz) = myeps; + endif; + yi = reshape (yi, length (yi), 1); + [m, i] = sort ([y; yi]); + o = cumsum (i <= rz); + yidx = o([find(i > rz)]); + + ## Set s and t used follow codes. + s = xidx + ((xi .- x(xidx))./(x(xidx+1) .- x(xidx))); + t = yidx + ((yi - y(yidx))./(y(yidx+1) - y(yidx))); + else + print_usage (); + endif + + if (rz < 3 || cz < 3) + error ("bicubic: Z at least a 3 by 3 matrices"); + endif + + inds = floor (s); + d = find (s == cz); + s = s - floor (s); + inds(d) = cz-1; + s(d) = 1.0; + + d = []; + indt = floor (t); + d = find (t == rz); + t = t - floor (t); + indt(d) = rz-1; + t(d) = 1.0; + d = []; + + p = zeros (size (z) + 2); + p(2:rz+1,2:cz+1) = z; + p(1,:) = (6*(1-a))*p(2,:) - 3*p(3,:) + (6*a-2)*p(4,:); + p(rz+2,:) = (6*(1-a))*p(rz+1,:) - 3*p(rz,:) + (6*a-2)*p(rz-1,:); + p(:,1) = (6*(1-a))*p(:,2) - 3*p(:,3) + (6*a-2)*p(:,4); + p(:,cz+2) = (6*(1-a))*p(:,cz+1) - 3*p(:,cz) + (6*a-2)*p(:,cz-1); + + ## Calculte the C1(t) C2(t) C3(t) C4(t) and C1(s) C2(s) C3(s) C4(s). + t2 = t.*t; + t3 = t2.*t; + + ct0 = -a .* t3 + (2 * a) .* t2 - a .* t ; # -a G0 + ct1 = (2-a) .* t3 + (-3+a) .* t2 + 1 ; # F0 - a G1 + ct2 = (a-2) .* t3 + (-2 *a + 3) .* t2 + a .* t ; # F1 + a G0 + ct3 = a .* t3 - a .* t2; # a G1 + t = []; t2 = []; t3 = []; + + s2 = s.*s; + s3 = s2.*s; + + cs0 = -a .* s3 + (2 * a) .* s2 - a .*s ; # -a G0 + cs1 = (2-a) .* s3 + (-3 + a) .* s2 + 1 ; # F0 - a G1 + cs2 = (a-2) .* s3 + (-2 *a + 3) .* s2 + a .*s ; # F1 + a G0 + cs3 = a .* s3 - a .* s2; # a G1 + s = []; s2 = []; s3 = []; + + cs0 = cs0([1,1,1,1],:); + cs1 = cs1([1,1,1,1],:); + cs2 = cs2([1,1,1,1],:); + cs3 = cs3([1,1,1,1],:); + + lent = length (ct0); + lens = columns (cs0); + zi = zeros (lent, lens); + + for i = 1:lent + it = indt(i); + int = [it, it+1, it+2, it+3]; + zi(i,:) = ([ct0(i),ct1(i),ct2(i),ct3(i)] + * (p(int,inds) .* cs0 + p(int,inds+1) .* cs1 + + p(int,inds+2) .* cs2 + p(int,inds+3) .* cs3)); + endfor + + ## Set points outside the table to extrapval. + if (! (isempty (xfirst_ind) && isempty (xlast_ind))) + zi(:, [xfirst_ind, xlast_ind]) = extrapval; + endif + if (! (isempty (yfirst_ind) && isempty (ylast_ind))) + zi([yfirst_ind; ylast_ind], :) = extrapval; + endif + +endfunction + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,4]+10; y=[-10,-9,-8]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,bicubic(x,y,A,xi,yi)); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; diff --git a/octave_packages/m/general/bitcmp.m b/octave_packages/m/general/bitcmp.m new file mode 100644 index 0000000..151f82e --- /dev/null +++ b/octave_packages/m/general/bitcmp.m @@ -0,0 +1,123 @@ +## Copyright (C) 2004-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} bitcmp (@var{A}, @var{k}) +## Return the @var{k}-bit complement of integers in @var{A}. If +## @var{k} is omitted @code{k = log2 (bitmax) + 1} is assumed. +## +## @example +## @group +## bitcmp (7,4) +## @result{} 8 +## dec2bin (11) +## @result{} 1011 +## dec2bin (bitcmp (11, 6)) +## @result{} 110100 +## @end group +## @end example +## @seealso{bitand, bitor, bitxor, bitset, bitget, bitcmp, bitshift, bitmax} +## @end deftypefn + +## Liberally based on the version by Kai Habel from octave-forge + +function C = bitcmp (A, k) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 2 && (! isscalar (k) || (floor (k) != k))) + error ("bitcmp: K must be a scalar integer"); + endif + + if (isa (A, "double")) + bmax = bitmax; + amax = ceil (log2 (bmax)); + else + if (isa (A, "uint8")) + amax = 8; + elseif (isa (A, "uint16")) + amax = 16; + elseif (isa (A, "uint32")) + amax = 32; + elseif (isa (A, "uint64")) + amax = 64; + elseif (isa (A, "int8")) + amax = 8; + elseif (isa (A, "int16")) + amax = 16; + elseif (isa (A, "int32")) + amax = 32; + elseif (isa (A, "int64")) + amax = 64; + else + error ("bitcmp: invalid class %s", class (A)); + endif + bmax = intmax (class (A)); + endif + + if (nargin == 1 || k == amax) + C = bitxor (A, bmax); + else + m = double (k); + if (any (m < 1) || any (m > amax)) + error ("bitcmp: K must be in the range [1,%d]", amax); + endif + mask = bitshift (bmax, k - amax); + C = bitxor (bitand (A, mask), mask); + endif +endfunction + + +%!test +%! Amax=53; +%! Bmax = bitmax; +%! A = bitshift(Bmax,-2); +%! assert(bitcmp(A,Amax),bitor(bitshift(1,Amax-1),bitshift(1,Amax-2))); +%! assert(bitcmp(A,Amax-1),bitshift(1,Amax-2)); +%! assert(bitcmp(A,Amax-2),0); +%!test +%! Amax=8; +%! Bmax = intmax('uint8'); +%! A = bitshift(Bmax,-2); +%! assert(bitcmp(A,Amax),bitor(bitshift(uint8(1),Amax-1),bitshift(uint8(1),Amax-2))); +%! assert(bitcmp(A,Amax-1),bitshift(uint8(1),Amax-2)); +%! assert(bitcmp(A,Amax-2),uint8(0)); +%!test +%! Amax=16; +%! Bmax = intmax('uint16'); +%! A = bitshift(Bmax,-2); +%! assert(bitcmp(A,Amax),bitor(bitshift(uint16(1),Amax-1),bitshift(uint16(1),Amax-2))); +%! assert(bitcmp(A,Amax-1),bitshift(uint16(1),Amax-2)); +%! assert(bitcmp(A,Amax-2),uint16(0)); +%!test +%! Amax=32; +%! Bmax = intmax('uint32'); +%! A = bitshift(Bmax,-2); +%! assert(bitcmp(A,Amax),bitor(bitshift(uint32(1),Amax-1),bitshift(uint32(1),Amax-2))); +%! assert(bitcmp(A,Amax-1),bitshift(uint32(1),Amax-2)); +%! assert(bitcmp(A,Amax-2),uint32(0)); +%!test +%! Amax=64; +%! Bmax = intmax('uint64'); +%! A = bitshift(Bmax,-2); +%! assert(bitcmp(A,Amax),bitor(bitshift(uint64(1),Amax-1),bitshift(uint64(1),Amax-2))); +%! assert(bitcmp(A,Amax-1),bitshift(uint64(1),Amax-2)); +%! assert(bitcmp(A,Amax-2),uint64(0)); + diff --git a/octave_packages/m/general/bitget.m b/octave_packages/m/general/bitget.m new file mode 100644 index 0000000..9fa47c0 --- /dev/null +++ b/octave_packages/m/general/bitget.m @@ -0,0 +1,109 @@ +## Copyright (C) 2004-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{c} =} bitget (@var{A}, @var{n}) +## Return the status of bit(s) @var{n} of unsigned integers in @var{A} +## the lowest significant bit is @var{n} = 1. +## +## @example +## @group +## bitget (100, 8:-1:1) +## @result{} 0 1 1 0 0 1 0 0 +## @end group +## @end example +## @seealso{bitand, bitor, bitxor, bitset, bitcmp, bitshift, bitmax} +## @end deftypefn + +## Liberally based of the version by Kai Habel from octave-forge + +function C = bitget (A, n) + + if (nargin != 2) + print_usage (); + endif + + if (isa (A, "double")) + Amax = log2 (bitmax) + 1; + _conv = @double; + else + if (isa (A, "uint8")) + Amax = 8; + _conv = @uint8; + elseif (isa (A, "uint16")) + Amax = 16; + _conv = @uint16; + elseif (isa (A, "uint32")) + Amax = 32; + _conv = @uint32; + elseif (isa (A, "uint64")) + Amax = 64; + _conv = @uint64; + elseif (isa (A, "int8")) + Amax = 8; + _conv = @int8; + elseif (isa (A, "int16")) + Amax = 16; + _conv = @int16; + elseif (isa (A, "int32")) + Amax = 32; + _conv = @int32; + elseif (isa (A, "int64")) + Amax = 64; + _conv = @int64; + else + error ("bitget: invalid class %s", class (A)); + endif + endif + + m = double (n(:)); + if (any (m < 1) || any (m > Amax)) + error ("bitget: N must be in the range [1,%d]", Amax); + endif + + C = bitand (A, bitshift (_conv (1), uint8 (n) - uint8 (1))) != _conv (0); + +endfunction + +%!error bitget (1); +%!error bitget (1, 2, 3); + +%!test +%! assert (bitget ([4, 14], [3, 3]), logical ([1, 1])); +%! pfx = {"", "u"}; +%! for i = 1:2 +%! for prec = [8, 16, 32, 64] +%! fcn = str2func (sprintf ("%sint%d", pfx{i}, prec)); +%! assert (bitget (fcn ([4, 14]), [3, 3]), logical ([1, 1])); +%! endfor +%! endfor + +%!error bitget (0, 0); +%!error bitget (0, 55); + +%!error bitget (int8 (0), 9); +%!error bitget (uint8 (0), 9); + +%!error bitget (int16 (0), 17); +%!error bitget (uint16 (0), 17); + +%!error bitget (int32 (0), 33); +%!error bitget (uint32 (0), 33); + +%!error bitget (int64 (0), 65); +%!error bitget (uint64 (0), 65); diff --git a/octave_packages/m/general/bitset.m b/octave_packages/m/general/bitset.m new file mode 100644 index 0000000..7c69f6c --- /dev/null +++ b/octave_packages/m/general/bitset.m @@ -0,0 +1,122 @@ +## Copyright (C) 2004-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{C} =} bitset (@var{A}, @var{n}) +## @deftypefnx {Function File} {@var{C} =} bitset (@var{A}, @var{n}, @var{val}) +## Set or reset bit(s) @var{n} of unsigned integers in @var{A}. +## @var{val} = 0 resets and @var{val} = 1 sets the bits. +## The lowest significant bit is: @var{n} = 1 +## +## @example +## @group +## dec2bin (bitset (10, 1)) +## @result{} 1011 +## @end group +## @end example +## @seealso{bitand, bitor, bitxor, bitget, bitcmp, bitshift, bitmax} +## @end deftypefn + +## Liberally based on the version by Kai Habel from octave-forge + +function C = bitset (A, n, val) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (nargin == 2) + val = 1; + endif + + if (isa (A, "double")) + Bmax = bitmax; + Amax = log2 (Bmax) + 1; + _conv = @double; + else + if (isa (A, "uint8")) + Amax = 8; + _conv = @uint8; + elseif (isa (A, "uint16")) + Amax = 16; + _conv = @uint16; + elseif (isa (A, "uint32")) + Amax = 32; + _conv = @uint32; + elseif (isa (A, "uint64")) + Amax = 64; + _conv = @uint64; + elseif (isa (A, "int8")) + Amax = 8; + _conv = @int8; + elseif (isa (A, "int16")) + Amax = 16; + _conv = @int16; + elseif (isa (A, "int32")) + Amax = 32; + _conv = @int32; + elseif (isa (A, "int64")) + Amax = 64; + _conv = @int64; + else + error ("bitset: invalid class %s", class (A)); + endif + Bmax = intmax (class (A)); + endif + + m = double (n(:)); + if (any (m < 1) || any (m > Amax)) + error ("bitset: N must be in the range [1,%d]", Amax); + endif + + mask = bitshift (_conv (1), uint8 (n) - uint8 (1)); + C = bitxor (A, bitand (A, mask)); + + if (val) + C = bitor (A, mask); + endif + +endfunction + +%!error bitset (1); +%!error bitset (1, 2, 3, 4); + +%!test +%! assert (bitset ([0, 10], [3, 3]), [4, 14]); +%! pfx = {"", "u"}; +%! for i = 1:2 +%! for prec = [8, 16, 32, 64] +%! fcn = str2func (sprintf ("%sint%d", pfx{i}, prec)); +%! assert (bitset (fcn ([0, 10]), [3, 3]), fcn ([4, 14])); +%! endfor +%! endfor + +%!error bitset (0, 0); +%!error bitset (0, 55); + +%!error bitset (int8 (0), 9); +%!error bitset (uint8 (0), 9); + +%!error bitset (int16 (0), 17); +%!error bitset (uint16 (0), 17); + +%!error bitset (int32 (0), 33); +%!error bitset (uint32 (0), 33); + +%!error bitset (int64 (0), 65); +%!error bitset (uint64 (0), 65); diff --git a/octave_packages/m/general/blkdiag.m b/octave_packages/m/general/blkdiag.m new file mode 100644 index 0000000..ef14519 --- /dev/null +++ b/octave_packages/m/general/blkdiag.m @@ -0,0 +1,81 @@ +## Copyright (C) 2000-2012 Daniel Calvelo +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} blkdiag (@var{A}, @var{B}, @var{C}, @dots{}) +## Build a block diagonal matrix from @var{A}, @var{B}, @var{C}, @dots{} +## All the arguments must be numeric and are two-dimensional matrices or +## scalars. If any argument is of type sparse, the output will also be +## sparse. +## @seealso{diag, horzcat, vertcat, sparse} +## @end deftypefn + +## Author: Daniel Calvelo +## Modified by: William Poetra Yoga Hadisoeseno + +function retval = blkdiag (varargin) + + if (nargin < 1) + print_usage (); + endif + + if (! all (cellfun ("isnumeric", varargin))) + error ("blkdiag: all arguments must be numeric"); + endif + + ## Note: trailing singletons are automatically (correctly) ignored. + if (! all (cellfun ("ndims", varargin) == 2)) + error ("blkdiag: all arguments must be two-dimensional matrices"); + endif + + ## size is an option for cellfun, but it's a bit different from + ## calling size directly. + tmp = cell2mat (cellfun (@size, varargin', "uniformoutput", false)); + csz = cumsum ([0 0; tmp], 1); + + if (any (cellfun ("issparse", varargin))) + retval = sparse (csz(end,1), csz(end,2)); + else + retval = zeros (csz(end,:)); + endif + + for p = 1:nargin + vp = varargin{p}; + if (! isempty (vp)) + retval((csz(p,1)+1):csz(p+1,1),(csz(p,2)+1):csz(p+1,2)) = vp; + endif + endfor + +endfunction + +## regular tests +%!assert(blkdiag(1,ones(2),1),[1,0,0,0;0,1,1,0;0,1,1,0;0,0,0,1]) +%!assert(blkdiag([1,2],[3,4],[5,6]),[1,2,0,0,0,0;0,0,3,4,0,0;0,0,0,0,5,6]) +%!assert(blkdiag([1,2],[3;4],[5,6]),[1,2,0,0,0;0,0,3,0,0;0,0,4,0,0;0,0,0,5,6]) +%!assert(blkdiag([1,2;3,4],[5,6,7]),[1,2,0,0,0;3,4,0,0,0;0,0,5,6,7]) +## tests involving empty matrices +%!assert(blkdiag([],[],[]),[]) +%!assert(blkdiag([],[1,2;3,4],[],5,[]),[1,2,0;3,4,0;0,0,5]) +%!assert(blkdiag(zeros(1,0,1),[1,2,3],1,0,5,zeros(0,1,1)),[0,0,0,0,0,0,0;1,2,3,0,0,0,0;0,0,0,1,0,0,0;0,0,0,0,0,0,0;0,0,0,0,0,5,0]); +## tests involving sparse matrices +%!assert (blkdiag (sparse([1,2;3,4]),[5,6;7,8]), sparse([1,2,0,0;3,4,0,0;0,0,5,6;0,0,7,8])) +%!assert (blkdiag (sparse([1,2;3,4]),[5,6]), sparse([1,2,0,0;3,4,0,0;0,0,5,6])) +# sanity checks +%!test +%! A = rand (round (rand (1, 2) * 10)); +%! assert (blkdiag (A), A); diff --git a/octave_packages/m/general/cart2pol.m b/octave_packages/m/general/cart2pol.m new file mode 100644 index 0000000..961017a --- /dev/null +++ b/octave_packages/m/general/cart2pol.m @@ -0,0 +1,143 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{theta}, @var{r}] =} cart2pol (@var{x}, @var{y}) +## @deftypefnx {Function File} {[@var{theta}, @var{r}, @var{z}] =} cart2pol (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {[@var{theta}, @var{r}] =} cart2pol (@var{c}) +## @deftypefnx {Function File} {[@var{theta}, @var{r}, @var{z}] =} cart2pol (@var{c}) +## @deftypefnx {Function File} {@var{p} =} cart2pol (@dots{}) +## +## Transform Cartesian to polar or cylindrical coordinates. +## +## @var{theta} describes the angle relative to the positive x-axis. +## @var{r} is the distance to the z-axis @w{(0, 0, z)}. +## @var{x}, @var{y} (and @var{z}) must be the same shape, or scalar. +## If called with a single matrix argument then each row of @var{c} +## represents the Cartesian coordinate (@var{x}, @var{y} (, @var{z})). +## +## If only a single return argument is requested then return a matrix +## @var{p} where each row represents one polar/(cylindrical) coordinate +## (@var{theta}, @var{phi} (, @var{z})). +## @seealso{pol2cart, cart2sph, sph2cart} +## @end deftypefn + +## Author: Kai Habel +## Adapted-by: jwe + +function [theta, r, z] = cart2pol (x, y, z) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (nargin == 1) + if (ismatrix (x) && (columns (x) == 2 || columns (x) == 3)) + if (columns (x) == 3) + z = x(:,3); + else + z = []; + endif + y = x(:,2); + x = x(:,1); + else + error ("cart2pol: matrix input must have 2 or 3 columns [X, Y (, Z)]"); + endif + elseif (nargin == 2) + if (! ((ismatrix (x) && ismatrix (y)) + && (size_equal (x, y) || isscalar (x) || isscalar (y)))) + error ("cart2pol: arguments must be matrices of same size, or scalar"); + endif + elseif (nargin == 3) + if (! ((ismatrix (x) && ismatrix (y) && ismatrix (z)) + && (size_equal (x, y) || isscalar (x) || isscalar (y)) + && (size_equal (x, z) || isscalar (x) || isscalar (z)) + && (size_equal (y, z) || isscalar (y) || isscalar (z)))) + error ("cart2pol: arguments must be matrices of same size, or scalar"); + endif + endif + + theta = atan2 (y, x); + r = sqrt (x .^ 2 + y .^ 2); + + if (nargout <= 1) + theta = [theta, r, z]; + endif + +endfunction + +%!test +%! x = [0, 1, 2]; +%! y = 0; +%! [t, r] = cart2pol (x, y); +%! assert (t, [0, 0, 0]); +%! assert (r, x); + +%!test +%! x = [0, 1, 2]; +%! y = [0, 1, 2]; +%! [t, r] = cart2pol (x, y); +%! assert (t, [0, pi/4, pi/4], sqrt(eps)); +%! assert (r, sqrt(2)*[0, 1, 2], sqrt(eps)); + +%!test +%! x = [0, 1, 2]; +%! y = [0, 1, 2]; +%! z = [0, 1, 2]; +%! [t, r, z2] = cart2pol (x, y, z); +%! assert (t, [0, pi/4, pi/4], sqrt(eps)); +%! assert (r, sqrt(2)*[0, 1, 2], sqrt(eps)); +%! assert (z, z2); + +%!test +%! x = [0, 1, 2]; +%! y = 0; +%! z = 0; +%! [t, r, z2] = cart2pol (x, y, z); +%! assert (t, [0, 0, 0], eps); +%! assert (r, x, eps); +%! assert (z, z2); + +%!test +%! x = 0; +%! y = [0, 1, 2]; +%! z = 0; +%! [t, r, z2] = cart2pol (x, y, z); +%! assert (t, [0, 1, 1]*pi/2, eps); +%! assert (r, y, eps); +%! assert (z, z2); + +%!test +%! x = 0; +%! y = 0; +%! z = [0, 1, 2]; +%! [t, r, z2] = cart2pol (x, y, z); +%! assert (t, 0); +%! assert (r, 0); +%! assert (z, z2); + +%!test +%! C = [0, 0; 1, 1; 2, 2]; +%! P = [0, 0; pi/4, sqrt(2); pi/4, 2*sqrt(2)]; +%! assert (cart2pol (C), P, sqrt(eps)); + +%!test +%! C = [0, 0, 0; 1, 1, 1; 2, 2, 2]; +%! P = [0, 0, 0; pi/4, sqrt(2), 1; pi/4, 2*sqrt(2), 2]; +%! assert (cart2pol (C), P, sqrt(eps)); + diff --git a/octave_packages/m/general/cart2sph.m b/octave_packages/m/general/cart2sph.m new file mode 100644 index 0000000..a70ca80 --- /dev/null +++ b/octave_packages/m/general/cart2sph.m @@ -0,0 +1,113 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{theta}, @var{phi}, @var{r}] =} cart2sph (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {[@var{theta}, @var{phi}, @var{r}] =} cart2sph (@var{C}) +## @deftypefnx {Function File} {@var{S} =} cart2sph (@dots{}) +## Transform Cartesian to spherical coordinates. +## +## @var{theta} describes the angle relative to the positive x-axis. +## @var{phi} is the angle relative to the xy-plane. +## @var{r} is the distance to the origin @w{(0, 0, 0)}. +## @var{x}, @var{y}, and @var{z} must be the same shape, or scalar. +## If called with a single matrix argument then each row of @var{c} +## represents the Cartesian coordinate (@var{x}, @var{y}, @var{z}). +## +## If only a single return argument is requested then return a matrix +## @var{s} where each row represents one spherical coordinate +## (@var{theta}, @var{phi}, @var{r}). +## @seealso{sph2cart, cart2pol, pol2cart} +## @end deftypefn + +## Author: Kai Habel +## Adapted-by: jwe + +function [theta, phi, r] = cart2sph (x, y, z) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (nargin == 1) + if (ismatrix (x) && columns (x) == 3) + z = x(:,3); + y = x(:,2); + x = x(:,1); + else + error ("cart2sph: matrix input must have 3 columns [X, Y, Z]"); + endif + elseif (nargin == 3) + if (! ((ismatrix (x) && ismatrix (y) && ismatrix (z)) + && (size_equal (x, y) || isscalar (x) || isscalar (y)) + && (size_equal (x, z) || isscalar (x) || isscalar (z)) + && (size_equal (y, z) || isscalar (y) || isscalar (z)))) + error ("cart2sph: X, Y, Z must be matrices of the same size, or scalar"); + endif + endif + + theta = atan2 (y, x); + phi = atan2 (z, sqrt (x .^ 2 + y .^ 2)); + r = sqrt (x .^ 2 + y .^ 2 + z .^ 2); + + if (nargout <= 1) + theta = [theta, phi, r]; + endif + +endfunction + +%!test +%! x = [0, 1, 2]; +%! y = [0, 1, 2]; +%! z = [0, 1, 2]; +%! [t, p, r] = cart2sph (x, y, z); +%! assert (t, [0, pi/4, pi/4], eps); +%! assert (p, [0, 1, 1]*atan(sqrt(0.5)), eps); +%! assert (r, [0, 1, 2]*sqrt(3), eps); + +%!test +%! x = 0; +%! y = [0, 1, 2]; +%! z = [0, 1, 2]; +%! [t, p, r] = cart2sph (x, y, z); +%! assert (t, [0, 1, 1] * pi/2, eps); +%! assert (p, [0, 1, 1] * pi/4, eps); +%! assert (r, [0, 1, 2] * sqrt(2), eps); + +%!test +%! x = [0, 1, 2]; +%! y = 0; +%! z = [0, 1, 2]; +%! [t, p, r] = cart2sph (x, y, z); +%! assert (t, [0, 0, 0]); +%! assert (p, [0, 1, 1] * pi/4); +%! assert (r, [0, 1, 2] * sqrt(2)); + +%!test +%! x = [0, 1, 2]; +%! y = [0, 1, 2]; +%! z = 0; +%! [t, p, r] = cart2sph (x, y, z); +%! assert (t, [0, 1, 1] * pi/4); +%! assert (p, [0, 0, 0]); +%! assert (r, [0, 1, 2] * sqrt(2)); + +%!test +%! C = [0, 0, 0; 1, 0, 1; 2, 0, 2]; +%! S = [0, 0, 0; 0, pi/4, sqrt(2); 0, pi/4, 2*sqrt(2)]; +%! assert (cart2sph(C), S, eps); diff --git a/octave_packages/m/general/cell2mat.m b/octave_packages/m/general/cell2mat.m new file mode 100644 index 0000000..ad6cfd0 --- /dev/null +++ b/octave_packages/m/general/cell2mat.m @@ -0,0 +1,104 @@ +## Copyright (C) 2005-2012 Laurent Mazet +## Copyright (C) 2010 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{m} =} cell2mat (@var{c}) +## Convert the cell array @var{c} into a matrix by concatenating all +## elements of @var{c} into a hyperrectangle. Elements of @var{c} must +## be numeric, logical or char matrices, or cell arrays, and @code{cat} +## must be able to concatenate them together. +## @seealso{mat2cell, num2cell} +## @end deftypefn + +function m = cell2mat (c) + + if (nargin != 1) + print_usage (); + endif + + if (! iscell (c)) + error ("cell2mat: C is not a cell array"); + endif + + nb = numel (c); + + if (nb == 0) + m = []; + else + + ## We only want numeric, logical, and char matrices. + valid = cellfun ("isnumeric", c); + valid |= cellfun ("islogical", c); + valid |= cellfun ("isclass", c, "char"); + validc = cellfun ("isclass", c, "cell"); + valids = cellfun ("isclass", c, "struct"); + + if (! all (valid(:)) && ! all (validc(:)) && ! all (valids(:))) + error ("cell2mat: wrong type elements or mixed cells, structs and matrices"); + endif + + ## The goal is to minimize the total number of cat() calls. + ## The dimensions can be concatenated along in arbitrary order. + ## The numbers of concatenations are: + ## n / d1 + ## n / (d1 * d2) + ## n / (d1 * d2 * d3) + ## etc. + ## This is minimized if d1 >= d2 >= d3... + + sc = size (c); + nd = ndims (c); + [~, isc] = sort (sc); + for idim = isc + if (sc(idim) == 1) + continue; + endif + xdim = [1:idim-1, idim+1:nd]; + cc = num2cell (c, xdim); + c = cellfun ("cat", {idim}, cc{:}, "uniformoutput", false); + endfor + m = c{1}; + endif + +endfunction + +## Tests +%!shared C, D, E, F +%! C = {[1], [2 3 4]; [5; 9], [6 7 8; 10 11 12]}; +%! D = C; D(:,:,2) = C; +%! E = [1 2 3 4; 5 6 7 8; 9 10 11 12]; +%! F = E; F(:,:,2) = E; +%!assert (cell2mat (C), E); +%!assert (cell2mat (D), F); +%!test +%! m = rand (10) + i * rand (10); +%! c = mat2cell (m, [1 2 3 4], [4 3 2 1]); +%! assert (cell2mat (c), m) +%!test +%! m = int8 (256*rand (4, 5, 6, 7, 8)); +%! c = mat2cell (m, [1 2 1], [1 2 2], [3 1 1 1], [4 1 2], [3 1 4]); +%! assert (cell2mat (c), m) +%!test +%! m = {1, 2, 3}; +%! assert (cell2mat (mat2cell (m, 1, [1 1 1])), m); +%!assert (cell2mat ({}), []); +## Demos +%!demo +%! C = {[1], [2 3 4]; [5; 9], [6 7 8; 10 11 12]}; +%! cell2mat (C) diff --git a/octave_packages/m/general/celldisp.m b/octave_packages/m/general/celldisp.m new file mode 100644 index 0000000..d9a7592 --- /dev/null +++ b/octave_packages/m/general/celldisp.m @@ -0,0 +1,87 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} celldisp (@var{c}, @var{name}) +## Recursively display the contents of a cell array. By default the values +## are displayed with the name of the variable @var{c}. However, this name +## can be replaced with the variable @var{name}. For example: +## +## @example +## @group +## c = @{1, 2, @{31, 32@}@}; +## celldisp (c, "b") +## @result{} +## b@{1@} = +## 1 +## b@{2@} = +## 2 +## b@{3@}@{1@} = +## 31 +## b@{3@}@{2@} = +## 32 +## @end group +## @end example +## +## @seealso{disp} +## @end deftypefn + +## This is ugly, but seems to be what matlab does.. + +function celldisp (c, name) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (! iscell (c)) + error ("celldisp: argument must be a cell array"); + endif + + if (nargin == 1) + name = inputname (1); + endif + + for i = 1: numel (c) + if (iscell (c{i})) + celldisp (c{i}, sprintf ("%s{%s}", name, indices (size (c), i))); + else + disp (sprintf ("%s{%s} = \n", name, indices (size (c), i))); + disp (c{i}); + disp (""); + endif + endfor +endfunction + +function s = indices (dv, i) + if (sum (dv != 1) > 1) + c = cell (size (dv)); + [c{:}] = ind2sub (dv, i); + s = sprintf("%i,", c{:}); + s(end) = []; + else + s = sprintf("%i", i); + endif +endfunction + +%!demo +%! c = {1, 2, {31, 32}}; +%! celldisp(c, "b") + +%!error celldisp (); +%!error celldisp ({}, "name", 1); +%!error celldisp (1); diff --git a/octave_packages/m/general/chop.m b/octave_packages/m/general/chop.m new file mode 100644 index 0000000..5a5bbba --- /dev/null +++ b/octave_packages/m/general/chop.m @@ -0,0 +1,80 @@ +## Copyright (C) 2010-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} chop (@var{x}, @var{ndigits}, @var{base}) +## Truncate elements of @var{x} to a length of @var{ndigits} such that the +## resulting numbers are exactly divisible by @var{base}. If @var{base} is not +## specified it defaults to 10. +## +## @example +## @group +## chop (-pi, 5, 10) +## @result{} -3.14200000000000 +## chop (-pi, 5, 5) +## @result{} -3.14150000000000 +## @end group +## @end example +## @end deftypefn + +function retval = chop (x, ndigits, base = 10) + + if (nargin == 2 || nargin == 3) + tmp = abs (x); + + ## Avoid computing log (0). + tmp(x == 0) = 1; + + ## Digits to the left of the decimal. + tmp = floor (log10 (tmp) + 1); + + ## The expression + ## + ## round (x .* inflate) + ## + ## produces an integer that contains the digits we want to keep. + ## Multiplying by deflate puts the decimal back where it belngs. + ## + ## Further scaling and rounding with the base factor produces a + ## value with ndigits exactly divisible by base. We skip that step + ## unless base was explicitly provided. + + inflate = 10 .^ (ndigits - tmp); + deflate = 10 .^ (tmp - ndigits); + if (nargin == 2) + retval = deflate .* round (x .* inflate); + else + retval = base .* deflate .* round (round (x .* inflate) ./ base); + endif + else + print_usage (); + endif + +endfunction + + +%!assert (chop (e, 3), 2.72) +%!assert (chop (e, 4), 2.718) +%!assert (chop (e, 4, 5), 2.72) +%!assert (chop (e, 4, 7), 2.716) +%!assert (chop (-e, 3), -2.72) +%!assert (chop (-e, 4), -2.718) +%!assert (chop (-e, 4, 5), -2.72) +%!assert (chop (-e, 4, 7), -2.716) +%!assert (chop (hilb (3), 3), [1,.5,.333;.5,.333,.25;.333,.25,.2]) +%!assert (chop (hilb (3), 2, 7), [.7,.49,.35;.49,.35,.28;.35,.28,.21], 2*eps) diff --git a/octave_packages/m/general/circshift.m b/octave_packages/m/general/circshift.m new file mode 100644 index 0000000..3c93a33 --- /dev/null +++ b/octave_packages/m/general/circshift.m @@ -0,0 +1,104 @@ +## Copyright (C) 2004-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} circshift (@var{x}, @var{n}) +## Circularly shift the values of the array @var{x}. @var{n} must be +## a vector of integers no longer than the number of dimensions in +## @var{x}. The values of @var{n} can be either positive or negative, +## which determines the direction in which the values or @var{x} are +## shifted. If an element of @var{n} is zero, then the corresponding +## dimension of @var{x} will not be shifted. For example: +## +## @example +## @group +## x = [1, 2, 3; 4, 5, 6; 7, 8, 9]; +## circshift (x, 1) +## @result{} 7, 8, 9 +## 1, 2, 3 +## 4, 5, 6 +## circshift (x, -2) +## @result{} 7, 8, 9 +## 1, 2, 3 +## 4, 5, 6 +## circshift (x, [0,1]) +## @result{} 3, 1, 2 +## 6, 4, 5 +## 9, 7, 8 +## @end group +## @end example +## @seealso {permute, ipermute, shiftdim} +## @end deftypefn + +function y = circshift (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (isempty (x)) + y = x; + return; + endif + + nd = ndims (x); + sz = size (x); + + if (! isvector (n) || length (n) > nd) + error ("circshift: N must be a vector, no longer than the number of dimension in X"); + elseif (any (n != fix (n))) + error ("circshift: all values of N must be integers"); + endif + + idx = repmat ({':'}, 1, nd); + for i = 1:length (n); + b = n(i); + d = sz(i); + if (b > 0) + b = rem (b, d); + idx{i} = [d-b+1:d, 1:d-b]; + elseif (b < 0) + b = rem (abs (b), d); + idx{i} = [b+1:d, 1:b]; + endif + endfor + + y = x(idx{:}); + +endfunction + + +%!shared x +%! x = [1, 2, 3; 4, 5, 6; 7, 8, 9]; + +%!assert (circshift (x, 1), [7, 8, 9; 1, 2, 3; 4, 5, 6]) +%!assert (circshift (x, -2), [7, 8, 9; 1, 2, 3; 4, 5, 6]) +%!assert (circshift (x, [0, 1]), [3, 1, 2; 6, 4, 5; 9, 7, 8]) +%!assert (circshift ([], 1), []) + +%!assert (circshift (eye (3), 1), circshift (eye (3), 1)) +%!assert (circshift (eye (3), 1), [0,0,1;1,0,0;0,1,0]) + +%% Test input validation +%!error circshift () +%!error circshift (1) +%!error circshift (1,2,3) +%!error circshift (1, ones(2,2)) +%!error circshift (1, [1 2 3]) +%!error circshift (1, 1.5) + diff --git a/octave_packages/m/general/colon.m b/octave_packages/m/general/colon.m new file mode 100644 index 0000000..bc2ff8f --- /dev/null +++ b/octave_packages/m/general/colon.m @@ -0,0 +1,44 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{r} =} colon (@var{a}, @var{b}) +## @deftypefnx {Function File} {@var{r} =} colon (@var{a}, @var{b}, @var{c}) +## Method of a class to construct a range with the @code{:} operator. For +## example: +## +## @example +## @group +## a = myclass (@dots{}); +## b = myclass (@dots{}); +## c = a : b +## @end group +## @end example +## +## @seealso{class, subsref, subsasgn} +## @end deftypefn + +function r = colon (varargin) + if (nargin != 0) + error ("colon: not defined for class \"%s\"", class(varargin{1})); + endif +endfunction + +%!error colon (1) + +## FIXME -- what does colon () mean since it doesn't set a return value? diff --git a/octave_packages/m/general/common_size.m b/octave_packages/m/general/common_size.m new file mode 100644 index 0000000..4c068ea --- /dev/null +++ b/octave_packages/m/general/common_size.m @@ -0,0 +1,90 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## Copyright (C) 2009 VZLU Prague +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{err}, @var{y1}, @dots{}] =} common_size (@var{x1}, @dots{}) +## Determine if all input arguments are either scalar or of common +## size. If so, @var{err} is zero, and @var{yi} is a matrix of the +## common size with all entries equal to @var{xi} if this is a scalar or +## @var{xi} otherwise. If the inputs cannot be brought to a common size, +## @var{err} is 1, and @var{yi} is @var{xi}. For example: +## +## @example +## @group +## [errorcode, a, b] = common_size ([1 2; 3 4], 5) +## @result{} errorcode = 0 +## @result{} a = [ 1, 2; 3, 4 ] +## @result{} b = [ 5, 5; 5, 5 ] +## @end group +## @end example +## +## @noindent +## This is useful for implementing functions where arguments can either +## be scalars or of common size. +## @end deftypefn + +## Author: KH +## Created: 15 October 1994 +## Adapted-By: jwe +## Optimized-By: Jaroslav Hajek + +function [errorcode, varargout] = common_size (varargin) + + if (nargin < 2) + error ("common_size: only makes sense if nargin >= 2"); + endif + + ## Find scalar args. + nscal = cellfun ("numel", varargin) != 1; + + i = find (nscal, 1); + + if (isempty (i)) + errorcode = 0; + varargout = varargin; + else + match = cellfun ("size_equal", varargin, varargin(i)); + if (any (nscal &! match)) + errorcode = 1; + varargout = varargin; + else + errorcode = 0; + if (nargout > 1) + scal = !nscal; + varargout = varargin; + if (any (nscal)) + dims = size (varargin{find (nscal, 1)}); + subs = arrayfun (@ones, 1, dims, "uniformoutput", false); + varargout(scal) = cellindexmat (varargin(scal), subs{:}); + endif + endif + endif + endif +endfunction + +%!error common_size (); + +%!test +%! m = [1,2;3,4]; +%! [err, a, b, c] = common_size (m, 3, 5); +%! assert (err, 0); +%! assert (a, m); +%! assert (b, [3,3;3,3]); +%! assert (c, [5,5;5,5]); diff --git a/octave_packages/m/general/cplxpair.m b/octave_packages/m/general/cplxpair.m new file mode 100644 index 0000000..dff9aec --- /dev/null +++ b/octave_packages/m/general/cplxpair.m @@ -0,0 +1,164 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cplxpair (@var{z}) +## @deftypefnx {Function File} {} cplxpair (@var{z}, @var{tol}) +## @deftypefnx {Function File} {} cplxpair (@var{z}, @var{tol}, @var{dim}) +## Sort the numbers @var{z} into complex conjugate pairs ordered by +## increasing real part. Place the negative imaginary complex number +## first within each pair. Place all the real numbers (those with +## @code{abs (imag (@var{z}) / @var{z}) < @var{tol})}) after the +## complex pairs. +## +## If @var{tol} is unspecified the default value is 100*@code{eps}. +## +## By default the complex pairs are sorted along the first non-singleton +## dimension of @var{z}. If @var{dim} is specified, then the complex +## pairs are sorted along this dimension. +## +## Signal an error if some complex numbers could not be paired. Signal an +## error if all complex numbers are not exact conjugates (to within +## @var{tol}). Note that there is no defined order for pairs with identical +## real parts but differing imaginary parts. +## @c Set example in small font to prevent overfull line +## +## @smallexample +## cplxpair (exp(2i*pi*[0:4]'/5)) == exp(2i*pi*[3; 2; 4; 1; 0]/5) +## @end smallexample +## @end deftypefn + +## FIXME: subsort returned pairs by imaginary magnitude +## FIXME: Why doesn't exp(2i*pi*[0:4]'/5) produce exact conjugates. Does +## FIXME: it in Matlab? The reason is that complex pairs are supposed +## FIXME: to be exact conjugates, and not rely on a tolerance test. + +## 2006-05-12 David Bateman - Modified for NDArrays + +function y = cplxpair (z, tol, dim) + + if nargin < 1 || nargin > 3 + print_usage (); + endif + + if (length (z) == 0) + y = zeros (size (z)); + return; + endif + + if (nargin < 2 || isempty (tol)) + if (isa (z, "single")) + tol = 100 * eps("single"); + else + tol = 100*eps; + endif + endif + + nd = ndims (z); + orig_dims = size (z); + if (nargin < 3) + ## Find the first singleton dimension. + dim = 0; + while (dim < nd && orig_dims(dim+1) == 1) + dim++; + endwhile + dim++; + if (dim > nd) + dim = 1; + endif + else + dim = floor(dim); + if (dim < 1 || dim > nd) + error ("cplxpair: invalid dimension along which to sort"); + endif + endif + + ## Move dimension to treat first, and convert to a 2-D matrix. + perm = [dim:nd, 1:dim-1]; + z = permute (z, perm); + sz = size (z); + n = sz (1); + m = prod (sz) / n; + z = reshape (z, n, m); + + ## Sort the sequence in terms of increasing real values. + [q, idx] = sort (real (z), 1); + z = z(idx + n * ones (n, 1) * [0:m-1]); + + ## Put the purely real values at the end of the returned list. + cls = "double"; + if (isa (z, "single")) + cls = "single"; + endif + [idxi, idxj] = find (abs (imag (z)) ./ (abs (z) + realmin(cls)) < tol); + q = sparse (idxi, idxj, 1, n, m); + nr = sum (q, 1); + [q, idx] = sort (q, 1); + z = z(idx); + y = z; + + ## For each remaining z, place the value and its conjugate at the + ## start of the returned list, and remove them from further + ## consideration. + for j = 1:m + p = n - nr(j); + for i = 1:2:p + if (i+1 > p) + error ("cplxpair: could not pair all complex numbers"); + endif + [v, idx] = min (abs (z(i+1:p) - conj (z(i)))); + if (v > tol) + error ("cplxpair: could not pair all complex numbers"); + endif + if (imag (z(i)) < 0) + y([i, i+1]) = z([i, idx+i]); + else + y([i, i+1]) = z([idx+i, i]); + endif + z(idx+i) = z(i+1); + endfor + endfor + + ## Reshape the output matrix. + y = ipermute (reshape (y, sz), perm); + +endfunction + +%!demo +%! [ cplxpair(exp(2i*pi*[0:4]'/5)), exp(2i*pi*[3; 2; 4; 1; 0]/5) ] + +%!assert (isempty(cplxpair([]))); +%!assert (cplxpair(1), 1) +%!assert (cplxpair([1+1i, 1-1i]), [1-1i, 1+1i]) +%!assert (cplxpair([1+1i, 1+1i, 1, 1-1i, 1-1i, 2]), \ +%! [1-1i, 1+1i, 1-1i, 1+1i, 1, 2]) +%!assert (cplxpair([1+1i; 1+1i; 1; 1-1i; 1-1i; 2]), \ +%! [1-1i; 1+1i; 1-1i; 1+1i; 1; 2]) +%!assert (cplxpair([0, 1, 2]), [0, 1, 2]); + +%!shared z +%! z=exp(2i*pi*[4; 3; 5; 2; 6; 1; 0]/7); +%!assert (cplxpair(z(randperm(7))), z); +%!assert (cplxpair(z(randperm(7))), z); +%!assert (cplxpair(z(randperm(7))), z); +%!assert (cplxpair([z(randperm(7)),z(randperm(7))]),[z,z]) +%!assert (cplxpair([z(randperm(7)),z(randperm(7))],[],1),[z,z]) +%!assert (cplxpair([z(randperm(7)).';z(randperm(7)).'],[],2),[z.';z.']) + +%!## tolerance test +%!assert (cplxpair([1i, -1i, 1+(1i*eps)],2*eps), [-1i, 1i, 1+(1i*eps)]); diff --git a/octave_packages/m/general/cumtrapz.m b/octave_packages/m/general/cumtrapz.m new file mode 100644 index 0000000..bc51291 --- /dev/null +++ b/octave_packages/m/general/cumtrapz.m @@ -0,0 +1,134 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} cumtrapz (@var{y}) +## @deftypefnx {Function File} {@var{q} =} cumtrapz (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{q} =} cumtrapz (@dots{}, @var{dim}) +## +## Cumulative numerical integration of points @var{y} using the trapezoidal +## method. +## @w{@code{cumtrapz (@var{y})}} computes the cumulative integral of @var{y} +## along the first non-singleton dimension. Where @code{trapz} reports +## only the overall integral sum, @code{cumtrapz} reports the current partial +## sum value at each point of @var{y}. When the argument @var{x} is omitted +## an equally spaced @var{x} vector with unit spacing (1) is assumed. +## @code{cumtrapz (@var{x}, @var{y})} evaluates the integral with respect to +## the spacing in @var{x} and the values in @var{y}. This is useful if the +## points in @var{y} have been sampled unevenly. If the optional @var{dim} +## argument is given, operate along this dimension. +## +## If @var{x} is not specified then unit spacing will be used. To scale +## the integral to the correct value you must multiply by the actual spacing +## value (deltaX). +## @seealso{trapz, cumsum} +## @end deftypefn + +## Author: Kai Habel +## +## also: June 2000 Paul Kienzle (fixes,suggestions) +## 2006-05-12 David Bateman - Modified for NDArrays + +function z = cumtrapz (x, y, dim) + + if (nargin < 1) || (nargin > 3) + print_usage (); + endif + + have_xy = have_dim = false; + + if (nargin == 3) + have_xy = true; + have_dim = true; + elseif (nargin == 2) + if (! size_equal (x, y) && isscalar (y)) + dim = y; + have_dim = true; + else + have_xy = true; + endif + endif + + if (have_xy) + nd = ndims (y); + sz = size (y); + else + nd = ndims (x); + sz = size (x); + endif + + if (! have_dim) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("trapz: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + idx1 = idx2 = repmat ({':'}, [nd, 1]); + idx1{dim} = 2 : n; + idx2{dim} = 1 : (n - 1); + + if (! have_xy) + z = 0.5 * cumsum (x(idx1{:}) + x(idx2{:}), dim); + else + if (isvector (x) && !isvector (y)) + if (length (x) != sz(dim)) + error ("cumtrapz: length of X and length of Y along DIM must match"); + endif + ## Reshape vector to point along dimension DIM + shape = ones (nd, 1); + shape(dim) = sz(dim); + x = reshape (x, shape); + z = 0.5 * cumsum (bsxfun (@times, diff (x), y(idx1{:}) + y(idx2{:})), dim); + else + if (! size_equal (x, y)) + error ("cumtrapz: X and Y must have same shape"); + endif + z = 0.5 * cumsum (diff (x, 1, dim) .* (y(idx1{:}) + y(idx2{:})), dim); + endif + endif + + sz(dim) = 1; + z = cat (dim, zeros (sz), z); + +endfunction + + +%!shared x1,x2,y +%! x1 = [0,0,0;2,2,2]; +%! x2 = [0,2,4;0,2,4]; +%! y = [1,2,3;4,5,6]; +%!assert (cumtrapz(y), [0,0,0;2.5,3.5,4.5]) +%!assert (cumtrapz(x1,y), [0,0,0;5,7,9]) +%!assert (cumtrapz(y,1), [0,0,0;2.5,3.5,4.5]) +%!assert (cumtrapz(x1,y,1), [0,0,0;5,7,9]) +%!assert (cumtrapz(y,2), [0,1.5,4;0,4.5,10]) +%!assert (cumtrapz(x2,y,2), [0,3,8;0,9,20]) +%% Test ND-array implementation +%!shared x1,x2,y +%! x1 = 1:3; +%! x2 = reshape ([0,2,4;0,2,4], [1 2 3]); +%! y = reshape ([1,2,3;4,5,6], [1 2 3]); +%!assert (cumtrapz(y,3), reshape([0,1.5,4;0,4.5,10],[1 2 3])) +%!assert (cumtrapz(x1,y,3), reshape([0,1.5,4;0,4.5,10],[1 2 3])) +%!assert (cumtrapz(x2,y,3), reshape([0,3,8;0,9,20],[1 2 3])) + diff --git a/octave_packages/m/general/curl.m b/octave_packages/m/general/curl.m new file mode 100644 index 0000000..0065974 --- /dev/null +++ b/octave_packages/m/general/curl.m @@ -0,0 +1,142 @@ +## Copyright (C) 2009-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{cx}, @var{cy}, @var{cz}, @var{v}] =} curl (@var{x}, @var{y}, @var{z}, @var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {[@var{cz}, @var{v}] =} curl (@var{x}, @var{y}, @var{fx}, @var{fy}) +## @deftypefnx {Function File} {[@dots{}] =} curl (@var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {[@dots{}] =} curl (@var{fx}, @var{fy}) +## @deftypefnx {Function File} {@var{v} =} curl (@dots{}) +## Calculate curl of vector field given by the arrays @var{fx}, @var{fy}, and +## @var{fz} or @var{fx}, @var{fy} respectively. +## @tex +## $$ curl F(x,y,z) = \left( {\partial{d} \over \partial{y}} F_z - {\partial{d} \over \partial{z}} F_y, {\partial{d} \over \partial{z}} F_x - {\partial{d} \over \partial{x}} F_z, {\partial{d} \over \partial{x}} F_y - {\partial{d} \over \partial{y}} F_x \right)$$ +## @end tex +## @ifnottex +## +## @example +## @group +## / d d d d d d \ +## curl F(x,y,z) = | -- Fz - -- Fy, -- Fx - -- Fz, -- Fy - -- Fx | +## \ dy dz dz dx dx dy / +## @end group +## @end example +## +## @end ifnottex +## The coordinates of the vector field can be given by the arguments @var{x}, +## @var{y}, @var{z} or @var{x}, @var{y} respectively. @var{v} calculates the +## scalar component of the angular velocity vector in direction of the z-axis +## for two-dimensional input. For three-dimensional input the scalar +## rotation is calculated at each grid point in direction of the vector field +## at that point. +## @seealso{divergence, gradient, del2, cross} +## @end deftypefn + +## Author: Kai Habel + +function varargout = curl (varargin) + + fidx = 1; + if (nargin == 2) + sz = size (varargin{fidx}); + dx = (1:sz(2))(:); + dy = (1:sz(1))(:); + elseif (nargin == 3) + sz = size (varargin{fidx}); + dx = (1:sz(2))(:); + dy = (1:sz(1))(:); + dz = (1:sz(3))(:); + elseif (nargin == 4) + fidx = 3; + dx = varargin{1}(1,:); + dy = varargin{2}(:,1); + elseif (nargin == 6) + fidx = 4; + dx = varargin{1}(1,:,1)(:); + dy = varargin{2}(:,1,1)(:); + dz = varargin{3}(1,1,:)(:); + else + print_usage(); + endif + + if ((nargin == 4) || (nargin == 2)) + if (!size_equal (varargin{fidx}, varargin{fidx + 1})) + error ("curl: size of X and Y must match"); + elseif (ndims (varargin{fidx}) != 2) + error ("curl: expected two-dimensional matrices X and Y"); + elseif ((length (dx) != columns (varargin{fidx})) + || (length (dy) != rows (varargin{fidx}))) + error ("curl: size of dx and dy must match the respective dimension of X and Y"); + endif + + dFx_dy = gradient (varargin{fidx}.', dy, dx).'; + dFy_dx = gradient (varargin{fidx + 1}, dx, dy); + rot_z = dFy_dx - dFx_dy; + av = rot_z / 2; + if (nargout == 0 || nargout == 1) + varargout{1} = av; + else + varargout{1} = rot_z; + varargout{2} = av; + endif + + elseif ((nargin == 6) || (nargin == 3)) + if (!size_equal (varargin{fidx}, varargin{fidx + 1}, varargin{fidx + 2})) + error ("curl: size of X, Y, and Z must match"); + elseif (ndims (varargin{fidx}) != 3) + error ("curl: expected two-dimensional matrices X, Y, and Z"); + elseif ((length (dx) != size (varargin{fidx}, 2)) + || (length (dy) != size (varargin{fidx}, 1)) + || (length (dz) != size (varargin{fidx}, 3))) + error ("curl: size of dx, dy, and dz must match the respective dimesion of X, Y, and Z"); + endif + + [~, dFx_dy, dFx_dz] = gradient (varargin{fidx}, dx, dy, dz); + [dFy_dx, ~, dFy_dz] = gradient (varargin{fidx + 1}, dx, dy, dz); + [dFz_dx, dFz_dy] = gradient (varargin{fidx + 2}, dx, dy, dz); + rot_x = dFz_dy - dFy_dz; + rot_y = dFx_dz - dFz_dx; + rot_z = dFy_dx - dFx_dy; + l = sqrt(varargin{fidx}.^2 + varargin{fidx + 1}.^2 + varargin{fidx + 2}.^2); + av = (rot_x .* varargin{fidx} + + rot_y .* varargin{fidx + 1} + + rot_z .* varargin{fidx + 2}) ./ (2 * l); + + if (nargout == 0 || nargout == 1) + varargout{1} = av; + else + varargout{1} = rot_x; + varargout{2} = rot_y; + varargout{3} = rot_z; + varargout{4} = av; + endif + endif + +endfunction + +%!test +%! [X,Y]=meshgrid(-20:20,-22:22); +%! av = curl(2*(X-Y),Y); +%! assert(all(av(:)==1)); +%! [cz,av] = curl(2*(X-Y),Y); +%! assert(all(cz(:)==2)); +%! assert(all(av(:)==1)); +%! [cz,av] = curl(X/2,Y/2,2*(X-Y),Y); +%! assert(all(cz(:)==4)); +%! assert(all(av(:)==2)); +%! assert(size_equal(X,Y,cz,av)); diff --git a/octave_packages/m/general/dblquad.m b/octave_packages/m/general/dblquad.m new file mode 100644 index 0000000..3647e88 --- /dev/null +++ b/octave_packages/m/general/dblquad.m @@ -0,0 +1,82 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}) +## @deftypefnx {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{tol}) +## @deftypefnx {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{tol}, @var{quadf}) +## @deftypefnx {Function File} {} dblquad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{tol}, @var{quadf}, @dots{}) +## Numerically evaluate the double integral of @var{f}. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. The function @var{f} must +## have the form @math{z = f(x,y)} where @var{x} is a vector and @var{y} is a +## scalar. It should return a vector of the same length and orientation as +## @var{x}. +## +## @var{xa}, @var{ya} and @var{xb}, @var{yb} are the lower and upper limits of +## integration for x and y respectively. The underlying integrator determines +## whether infinite bounds are accepted. +## +## The optional argument @var{tol} defines the absolute tolerance used to +## integrate each sub-integral. The default value is @math{1e^{-6}}. +## +## The optional argument @var{quadf} specifies which underlying integrator +## function to use. Any choice but @code{quad} is available and the default +## is @code{quadcc}. +## +## Additional arguments, are passed directly to @var{f}. To use the default +## value for @var{tol} or @var{quadf} one may pass ':' or an empty matrix ([]). +## @seealso{triplequad, quad, quadv, quadl, quadgk, quadcc, trapz} +## @end deftypefn + +function q = dblquad (f, xa, xb, ya, yb, tol = 1e-6, quadf = @quadcc, varargin) + + if (nargin < 5) + print_usage (); + endif + if (isempty (tol)) + tol = 1e-6; + endif + if (isempty (quadf)) + quadf = @quadcc; + endif + + inner = @__dblquad_inner__; + if (ischar (f)) + f = @(x,y) feval (f, x, y, varargin{:}); + varargin = {}; + endif + + q = feval (quadf, @(y) inner (y, f, xa, xb, tol, quadf, + varargin{:}), ya, yb, tol); +endfunction + +function q = __dblquad_inner__ (y, f, xa, xb, tol, quadf, varargin) + q = zeros (size(y)); + for i = 1 : length (y) + q(i) = feval (quadf, @(x) f(x, y(i), varargin{:}), xa, xb, tol); + endfor +endfunction + +%% Nasty integrand to show quadcc off +%!assert (dblquad (@(x,y) 1 ./ (x+y), 0, 1, 0, 1), 2*log(2), 1e-6) + +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadgk), pi * erf(1).^2, 1e-6) +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadl), pi * erf(1).^2, 1e-6) +%!assert (dblquad (@(x,y) exp(-x.^2 - y.^2) , -1, 1, -1, 1, 1e-6, @quadv), pi * erf(1).^2, 1e-6) + diff --git a/octave_packages/m/general/deal.m b/octave_packages/m/general/deal.m new file mode 100644 index 0000000..935bb30 --- /dev/null +++ b/octave_packages/m/general/deal.m @@ -0,0 +1,83 @@ +## Copyright (C) 1998-2012 Ariel Tankus +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{r1}, @var{r2}, @dots{}, @var{rn}] =} deal (@var{a}) +## @deftypefnx {Function File} {[@var{r1}, @var{r2}, @dots{}, @var{rn}] =} deal (@var{a1}, @var{a2}, @dots{}, @var{an}) +## +## Copy the input parameters into the corresponding output parameters. +## If only one input parameter is supplied, its value is copied to each +## of the outputs. +## +## For example, +## +## @example +## [a, b, c] = deal (x, y, z); +## @end example +## +## @noindent +## is equivalent to +## +## @example +## @group +## a = x; +## b = y; +## c = z; +## @end group +## @end example +## +## @noindent +## and +## +## @example +## [a, b, c] = deal (x); +## @end example +## +## @noindent +## is equivalent to +## +## @example +## a = b = c = x; +## @end example +## @end deftypefn + +## Author: Ariel Tankus +## Author: Paul Kienzle and Etienne Grossman +## Created: 13.11.98 +## Adapted-by: jwe + +function [varargout] = deal (varargin) + + if (nargin == 0) + print_usage (); + elseif (nargin == 1 || nargin == nargout) + varargout(1:nargout) = varargin; + else + error ("deal: nargin > 1 and nargin != nargout"); + endif + +endfunction + +%!test +%! [a,b]=deal(1,2); +%! assert(a,1); +%! assert(b,2); +%!test +%! [a,b]=deal(1); +%! assert(a,1); +%! assert(b,1); diff --git a/octave_packages/m/general/del2.m b/octave_packages/m/general/del2.m new file mode 100644 index 0000000..f3972e2 --- /dev/null +++ b/octave_packages/m/general/del2.m @@ -0,0 +1,159 @@ +## Copyright (C) 2000-2012 Kai Habel +## Copyright (C) 2007 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{d} =} del2 (@var{M}) +## @deftypefnx {Function File} {@var{d} =} del2 (@var{M}, @var{h}) +## @deftypefnx {Function File} {@var{d} =} del2 (@var{M}, @var{dx}, @var{dy}, @dots{}) +## +## Calculate the discrete Laplace +## @tex +## operator $( \nabla^2 )$. +## @end tex +## @ifnottex +## operator. +## @end ifnottex +## For a 2-dimensional matrix @var{M} this is defined as +## @tex +## $$d = {1 \over 4} \left( {d^2 \over dx^2} M(x,y) + {d^2 \over dy^2} M(x,y) \right)$$ +## @end tex +## @ifnottex +## +## @example +## @group +## 1 / d^2 d^2 \ +## D = --- * | --- M(x,y) + --- M(x,y) | +## 4 \ dx^2 dy^2 / +## @end group +## @end example +## +## @end ifnottex +## For N-dimensional arrays the sum in parentheses is expanded to include second +## derivatives over the additional higher dimensions. +## +## The spacing between evaluation points may be defined by @var{h}, which is a +## scalar defining the equidistant spacing in all dimensions. Alternatively, +## the spacing in each dimension may be defined separately by @var{dx}, +## @var{dy}, etc. A scalar spacing argument defines equidistant spacing, +## whereas a vector argument can be used to specify variable spacing. The +## length of the spacing vectors must match the respective dimension of +## @var{M}. The default spacing value is 1. +## +## At least 3 data points are needed for each dimension. Boundary points are +## calculated from the linear extrapolation of interior points. +## +## @seealso{gradient, diff} +## @end deftypefn + +## Author: Kai Habel + +function D = del2 (M, varargin) + + if (nargin < 1) + print_usage (); + endif + + nd = ndims (M); + sz = size (M); + dx = cell (1, nd); + if (nargin == 2 || nargin == 1) + if (nargin == 1) + h = 1; + else + h = varargin{1}; + endif + for i = 1 : nd + if (isscalar (h)) + dx{i} = h * ones (sz (i), 1); + else + if (length (h) == sz (i)) + dx{i} = diff (h)(:); + else + error ("del2: dimensionality mismatch in %d-th spacing vector", i); + endif + endif + endfor + elseif (nargin - 1 == nd) + ## Reverse dx{1} and dx{2} as the X-dim is the 2nd dim of the ND array + tmp = varargin{1}; + varargin{1} = varargin{2}; + varargin{2} = tmp; + + for i = 1 : nd + if (isscalar (varargin{i})) + dx{i} = varargin{i} * ones (sz (i), 1); + else + if (length (varargin{i}) == sz (i)) + dx{i} = diff (varargin{i})(:); + else + error ("del2: dimensionality mismatch in %d-th spacing vector", i); + endif + endif + endfor + else + print_usage (); + endif + + idx = cell (1, nd); + for i = 1: nd + idx{i} = ":"; + endfor + + D = zeros (sz); + for i = 1: nd + if (sz(i) >= 3) + DD = zeros (sz); + idx1 = idx2 = idx3 = idx; + + ## interior points + idx1{i} = 1 : sz(i) - 2; + idx2{i} = 2 : sz(i) - 1; + idx3{i} = 3 : sz(i); + szi = sz; + szi (i) = 1; + + h1 = repmat (shiftdim (dx{i}(1 : sz(i) - 2), 1 - i), szi); + h2 = repmat (shiftdim (dx{i}(2 : sz(i) - 1), 1 - i), szi); + DD(idx2{:}) = ((M(idx1{:}) - M(idx2{:})) ./ h1 + ... + (M(idx3{:}) - M(idx2{:})) ./ h2) ./ (h1 + h2); + + ## left and right boundary + if (sz(i) == 3) + DD(idx1{:}) = DD(idx3{:}) = DD(idx2{:}); + else + idx1{i} = 1; + idx2{i} = 2; + idx3{i} = 3; + DD(idx1{:}) = (dx{i}(1) + dx{i}(2)) / dx{i}(2) * DD (idx2{:}) - ... + dx{i}(1) / dx{i}(2) * DD (idx3{:}); + + idx1{i} = sz(i); + idx2{i} = sz(i) - 1; + idx3{i} = sz(i) - 2; + DD(idx1{:}) = (dx{i}(sz(i) - 1) + dx{i}(sz(i) - 2)) / ... + dx{i}(sz(i) - 2) * DD (idx2{:}) - ... + dx{i}(sz(i) - 1) / dx{i}(sz(i) - 2) * DD (idx3{:}); + endif + + D += DD; + endif + endfor + + D = D ./ nd; +endfunction diff --git a/octave_packages/m/general/display.m b/octave_packages/m/general/display.m new file mode 100644 index 0000000..6ace56f --- /dev/null +++ b/octave_packages/m/general/display.m @@ -0,0 +1,50 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} display (@var{a}) +## Display the contents of an object. If @var{a} is an object of the +## class "myclass", then @code{display} is called in a case like +## +## @example +## myclass (@dots{}) +## @end example +## +## @noindent +## where Octave is required to display the contents of a variable of the +## type "myclass". +## +## @seealso{class, subsref, subsasgn} +## @end deftypefn + +function idx = display (a) + + if (nargin != 1) + print_usage (); + endif + + ## Only reason we got here is that there was no overloaded display() + ## function for object a. This may mean it is a built-in. + str = disp (a); + if (isempty (strfind (str, ". + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{div} =} divergence (@var{x}, @var{y}, @var{z}, @var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {@var{div} =} divergence (@var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {@var{div} =} divergence (@var{x}, @var{y}, @var{fx}, @var{fy}) +## @deftypefnx {Function File} {@var{div} =} divergence (@var{fx}, @var{fy}) +## Calculate divergence of a vector field given by the arrays @var{fx}, +## @var{fy}, and @var{fz} or @var{fx}, @var{fy} respectively. +## @tex +## $$ +## div F(x,y,z) = \partial_x{F} + \partial_y{F} + \partial_z{F} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## d d d +## div F(x,y,z) = -- F(x,y,z) + -- F(x,y,z) + -- F(x,y,z) +## dx dy dz +## @end group +## @end example +## +## @end ifnottex +## The coordinates of the vector field can be given by the arguments @var{x}, +## @var{y}, @var{z} or @var{x}, @var{y} respectively. +## +## @seealso{curl, gradient, del2, dot} +## @end deftypefn + +## Author: Kai Habel + +function retval = divergence (varargin) + + fidx = 1; + if (nargin == 2) + sz = size (varargin{fidx}); + dx = (1:sz(2))(:); + dy = (1:sz(1))(:); + elseif (nargin == 3) + sz = size (varargin{fidx}); + dx = 1:sz(2); + dy = 1:sz(1); + dz = 1:sz(3); + elseif (nargin == 4) + fidx = 3; + dx = varargin{1}(1,:); + dy = varargin{2}(:,1); + elseif (nargin == 6) + fidx = 4; + dx = varargin{1}(1,:,1)(:); + dy = varargin{2}(:,1,1)(:); + dz = varargin{3}(1,1,:)(:); + else + print_usage(); + endif + + if ((nargin == 4) || (nargin == 2)) + if (!size_equal (varargin{fidx},varargin{fidx + 1})) + error ("divergence: size of X and Y must match"); + elseif (ndims (varargin{fidx}) != 2) + error ("divergence: expected two-dimensional matrices X and Y"); + elseif ((length (dx) != columns (varargin{fidx})) || (length (dy) != rows (varargin{fidx}))) + error ("divergence: size of dx and dy must match the respective dimension of X and Y"); + endif + + retval = gradient(varargin{fidx}, dx, dy); + retval += gradient(varargin{fidx + 1}.', dy, dx).'; + + elseif ((nargin == 6) || (nargin == 3)) + if (!size_equal (varargin{fidx},varargin{fidx + 1},varargin{fidx + 2})) + error ("divergence: size of X, Y, and Z must match"); + elseif (ndims (varargin{fidx}) != 3) + error ("divergence: expected two-dimensional matrices X, Y, and Z"); + elseif ((length (dx) != size (varargin{fidx}, 2)) + || (length (dy) != size (varargin{fidx}, 1)) + || (length (dz) != size (varargin{fidx}, 3))) + error ("divergence: size of dx, dy, and dz must match the respective dimesion of X, Y, and Z"); + endif + + ## x-direction + retval = gradient (varargin{fidx}, dx, dy, dz); + ## y-direction + retval += shiftdim (gradient (shiftdim (varargin{fidx + 1}, 2), dy), 1); + ## z-direction + retval += shiftdim (gradient (shiftdim (varargin{fidx + 2}, 1), dz), 2); + endif + +endfunction + +%!test +%! [X,Y]=meshgrid(-20:20,-22:22); +%! div = divergence(X-Y,Y); +%! assert(all(div(:)==2)); +%! assert(size_equal(X,Y,div)); diff --git a/octave_packages/m/general/flipdim.m b/octave_packages/m/general/flipdim.m new file mode 100644 index 0000000..cb63321 --- /dev/null +++ b/octave_packages/m/general/flipdim.m @@ -0,0 +1,67 @@ +## Copyright (C) 2004-2012 David Bateman +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} flipdim (@var{x}) +## @deftypefnx {Function File} {} flipdim (@var{x}, @var{dim}) +## Return a copy of @var{x} flipped about the dimension @var{dim}. +## @var{dim} defaults to the first non-singleton dimension. +## For example: +## +## @example +## @group +## flipdim ([1, 2; 3, 4], 2) +## @result{} 2 1 +## 4 3 +## @end group +## @end example +## @seealso{fliplr, flipud, rot90, rotdim} +## @end deftypefn + +## Author: David Bateman, Jaroslav Hajek + +function y = flipdim (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + nd = ndims (x); + sz = size (x); + if (nargin == 1) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + elseif (! (isscalar (dim) && isindex (dim))) + error ("flipdim: DIM must be a positive integer"); + endif + + idx(1:max(nd, dim)) = {':'}; + idx{dim} = size (x, dim):-1:1; + y = x(idx{:}); + +endfunction + +%!error flipdim (); +%!error flipdim (1, 2, 3); + +%!assert (flipdim ([1,2;3,4]), flipdim ([1,2 ; 3,4], 1)); +%!assert (flipdim ([1,2;3,4], 2), [2,1;4,3]); +%!assert (flipdim ([1,2;3,4], 3), [1,2;3,4]); + +## FIXME -- we need tests for multidimensional arrays. diff --git a/octave_packages/m/general/fliplr.m b/octave_packages/m/general/fliplr.m new file mode 100644 index 0000000..580c64d --- /dev/null +++ b/octave_packages/m/general/fliplr.m @@ -0,0 +1,62 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fliplr (@var{x}) +## Return a copy of @var{x} with the order of the columns reversed. In +## other words, @var{x} is flipped left-to-right about a vertical axis. For +## example: +## +## @example +## @group +## fliplr ([1, 2; 3, 4]) +## @result{} 2 1 +## 4 3 +## @end group +## @end example +## +## Note that @code{fliplr} only works with 2-D arrays. To flip N-D arrays +## use @code{flipdim} instead. +## @seealso{flipud, flipdim, rot90, rotdim} +## @end deftypefn + +## Author: jwe + +function y = fliplr (x) + + if (nargin != 1) + print_usage (); + endif + + if (ndims (x) > 2) + error ("fliplr: Only works with 2-D arrays"); + endif + + nc = columns (x); + y = x (:, nc:-1:1); + +endfunction + +%!assert((fliplr ([1, 2; 3, 4]) == [2, 1; 4, 3] +%! && fliplr ([1, 2; 3, 4; 5, 6]) == [2, 1; 4, 3; 6, 5] +%! && fliplr ([1, 2, 3; 4, 5, 6]) == [3, 2, 1; 6, 5, 4])); + +%!error fliplr(); + +%!error fliplr (1, 2); + diff --git a/octave_packages/m/general/flipud.m b/octave_packages/m/general/flipud.m new file mode 100644 index 0000000..0b4158f --- /dev/null +++ b/octave_packages/m/general/flipud.m @@ -0,0 +1,62 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} flipud (@var{x}) +## Return a copy of @var{x} with the order of the rows reversed. In +## other words, @var{x} is flipped upside-down about a horizontal axis. For +## example: +## +## @example +## @group +## flipud ([1, 2; 3, 4]) +## @result{} 3 4 +## 1 2 +## @end group +## @end example +## +## Note that @code{flipud} only works with 2-D arrays. To flip N-D arrays +## use @code{flipdim} instead. +## @seealso{fliplr, flipdim, rot90, rotdim} +## @end deftypefn + +## Author: jwe + +function y = flipud (x) + + if (nargin != 1) + print_usage (); + endif + + if (ndims (x) > 2) + error ("flipud: Only works with 2-d arrays"); + endif + + nr = rows (x); + y = x (nr:-1:1, :); + +endfunction + +%!assert((flipud ([1, 2; 3, 4]) == [3, 4; 1, 2] +%! && flipud ([1, 2; 3, 4; 5, 6]) == [5, 6; 3, 4; 1, 2] +%! && flipud ([1, 2, 3; 4, 5, 6]) == [4, 5, 6; 1, 2, 3])); + +%!error flipud (); + +%!error flipud (1, 2); + diff --git a/octave_packages/m/general/genvarname.m b/octave_packages/m/general/genvarname.m new file mode 100644 index 0000000..f308765 --- /dev/null +++ b/octave_packages/m/general/genvarname.m @@ -0,0 +1,208 @@ +## Copyright (C) 2008-2012 Bill Denney, Robert Platt +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{varname} =} genvarname (@var{str}) +## @deftypefnx {Function File} {@var{varname} =} genvarname (@var{str}, @var{exclusions}) +## Create unique variable(s) from @var{str}. If @var{exclusions} is +## given, then the variable(s) will be unique to each other and to +## @var{exclusions} (@var{exclusions} may be either a string or a cellstr). +## +## If @var{str} is a cellstr, then a unique variable is created for each +## cell in @var{str}. +## +## @example +## @group +## x = 3.141; +## genvarname ("x", who ()) +## @result{} x1 +## @end group +## @end example +## +## If @var{wanted} is a cell array, genvarname will make sure the returned +## strings are distinct: +## +## @example +## @group +## genvarname (@{"foo", "foo"@}) +## @result{} +## @{ +## [1,1] = foo +## [1,2] = foo1 +## @} +## @end group +## @end example +## +## Note that the result is a char array/cell array of strings, not the +## variables themselves. To define a variable, @code{eval()} can be +## used. The following trivial example sets @code{x} to @code{42}. +## +## @example +## @group +## name = genvarname ("x"); +## eval ([name " = 42"]); +## @result{} x = 42 +## @end group +## @end example +## +## Also, this can be useful for creating unique struct field names. +## +## @example +## @group +## x = struct (); +## for i = 1:3 +## x.(genvarname ("a", fieldnames (x))) = i; +## endfor +## @result{} x = +## @{ +## a = 1 +## a1 = 2 +## a2 = 3 +## @} +## @end group +## @end example +## +## Since variable names may only contain letters, digits and underscores, +## genvarname replaces any sequence of disallowed characters with +## an underscore. Also, variables may not begin with a digit; in this +## case an underscore is added before the variable name. +## +## Variable names beginning and ending with two underscores "__" are valid but +## they are used internally by octave and should generally be avoided, therefore +## genvarname will not generate such names. +## +## genvarname will also make sure that returned names do not clash with +## keywords such as "for" and "if". A number will be appended if necessary. +## Note, however, that this does @strong{not} include function names, +## such as "sin". Such names should be included in @var{avoid} if necessary. +## @seealso{isvarname, exist, tmpnam, eval} +## @end deftypefn + +## Authors: Rob Platt +## Bill Denney + +function varname = genvarname (str, exclusions) + + strinput = ischar (str); + ## Process the inputs + if (nargin < 2) + exclusions = {}; + elseif (ischar (exclusions)) + if (rows (exclusions) != 1) + error ("genvarname: if more than one exclusion is given, it must be a cellstr"); + endif + exclusions = {exclusions}; + elseif (! iscellstr (exclusions)) + error ("genvarname: EXCLUSIONS must be a string or a cellstr"); + endif + if (ischar (str)) + if (rows (str) != 1) + error ("genvarname: if more than one STR is given, it must be a cellstr"); + endif + str = {str}; + elseif (! iscellstr (str)) + error ("genvarname: STR must be a string or a cellstr"); + endif + + validchars = cstrcat ("A":"Z", "a":"z", "0":"9", "_"); + + varname = cell (size (str)); + for i = 1:numel (str) + ## Perform any modifications to the varname to make sure that it is + ## a valid variable name. + + ## remove invalid characters + str{i}(! ismember (str{i}, validchars)) = "_"; + ## do not use keywords + if (iskeyword (str{i})) + str{i} = cstrcat ("_", str{i}); + endif + ## double underscores at the beginning and end are reserved variables + underscores = (str{i} == "_"); + if (any (underscores)) + firstnon = find (!underscores, 1); + lastnon = find (!underscores, 1, "last"); + str{i}([1:firstnon-2, lastnon+2:end]) = []; + endif + ## The variable cannot be empty + if (isempty (str{i})) + str{i} = "x"; + endif + ## it cannot start with a number + if (ismember (str{i}(1), "0":"9")) + str{i} = cstrcat ("_", str{i}); + endif + + ## make sure that the variable is unique relative to other variables + ## and the exclusions list + excluded = any (strcmp (str{i}, exclusions)); + if (excluded && ismember (str{i}(end), "0":"9")) + ## if it is not unique and ends with a digit, add an underscore to + ## make the variable name more readable ("x1_1" instead of "x11") + str{i}(end+1) = "_"; + endif + varname(i) = str(i); + idx = 0; + while excluded + idx++; + varname{i} = sprintf("%s%d", str{i}, idx); + excluded = any (strcmp (varname{i}, exclusions)); + endwhile + exclusions(end+1) = varname(i); + endfor + + if strinput + varname = varname{1}; + endif + +endfunction + +## Tests +## a single argument +%!assert(genvarname("a"), "a") +## a single argument with a non-conflicting exception +%!assert(genvarname("a", "b"), "a") +## a single argument with a conflicting exception +%!assert(genvarname("a", "a"), "a1") +## a single argument as a cell +%!assert(genvarname({"a"}), {"a"}) +%!assert(genvarname({"a"}, "b"), {"a"}) +%!assert(genvarname({"a"}, {"b"}), {"a"}) +%!assert(genvarname({"a"}, "a"), {"a1"}) +%!assert(genvarname({"a"}, {"a"}), {"a1"}) +## Test different arguments +## orientation +%!assert(genvarname({"a" "b"}), {"a" "b"}) +%!assert(genvarname({"a";"b"}), {"a";"b"}) +%!assert(genvarname({"a" "a"}), {"a" "a1"}) +%!assert(genvarname({"a" "b";"c" "d"}), {"a" "b";"c" "d"}) +%!assert(genvarname({"a" "a" "a";"a" "a" "a"}), {"a" "a2" "a4";"a1" "a3" "a5"}) +## more than one repetition +%!assert(genvarname({"a" "a" "a"}), {"a" "a1" "a2"}) +%!assert(genvarname({"a" "a" "a"}, {"a" "a1" "a2"}), {"a3" "a4" "a5"}) +## more than one repetition not in order +%!assert(genvarname({"a" "b" "a" "b" "a"}), {"a" "b" "a1" "b1" "a2"}) +## Variable name munging +%!assert (genvarname ("__x__"), "_x_") +%!assert (genvarname ("123456789"), "_123456789") +%!assert (genvarname ("_$1__"), "_1_") +%!assert (genvarname ("__foo__", "_foo_"), "_foo_1") +%!assert (genvarname ("1million_and1", "_1million_and1"), "_1million_and1_1") +%!assert (genvarname ({"", "", ""}), {"x", "x1", "x2"}) +%!assert (genvarname ("if"), "_if") +%!assert (genvarname ({"if", "if", "if"}), {"_if", "_if1", "_if2"}) diff --git a/octave_packages/m/general/gradient.m b/octave_packages/m/general/gradient.m new file mode 100644 index 0000000..9e66267 --- /dev/null +++ b/octave_packages/m/general/gradient.m @@ -0,0 +1,304 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dx} =} gradient (@var{m}) +## @deftypefnx {Function File} {[@var{dx}, @var{dy}, @var{dz}, @dots{}] =} gradient (@var{m}) +## @deftypefnx {Function File} {[@dots{}] =} gradient (@var{m}, @var{s}) +## @deftypefnx {Function File} {[@dots{}] =} gradient (@var{m}, @var{x}, @var{y}, @var{z}, @dots{}) +## @deftypefnx {Function File} {[@dots{}] =} gradient (@var{f}, @var{x0}) +## @deftypefnx {Function File} {[@dots{}] =} gradient (@var{f}, @var{x0}, @var{s}) +## @deftypefnx {Function File} {[@dots{}] =} gradient (@var{f}, @var{x0}, @var{x}, @var{y}, @dots{}) +## +## Calculate the gradient of sampled data or a function. If @var{m} +## is a vector, calculate the one-dimensional gradient of @var{m}. If +## @var{m} is a matrix the gradient is calculated for each dimension. +## +## @code{[@var{dx}, @var{dy}] = gradient (@var{m})} calculates the one +## dimensional gradient for @var{x} and @var{y} direction if @var{m} is a +## matrix. Additional return arguments can be use for multi-dimensional +## matrices. +## +## A constant spacing between two points can be provided by the +## @var{s} parameter. If @var{s} is a scalar, it is assumed to be the spacing +## for all dimensions. +## Otherwise, separate values of the spacing can be supplied by +## the @var{x}, @dots{} arguments. Scalar values specify an equidistant +## spacing. +## Vector values for the @var{x}, @dots{} arguments specify the coordinate for +## that +## dimension. The length must match their respective dimension of @var{m}. +## +## At boundary points a linear extrapolation is applied. Interior points +## are calculated with the first approximation of the numerical gradient +## +## @example +## y'(i) = 1/(x(i+1)-x(i-1)) * (y(i-1)-y(i+1)). +## @end example +## +## If the first argument @var{f} is a function handle, the gradient of the +## function at the points in @var{x0} is approximated using central +## difference. For example, @code{gradient (@@cos, 0)} approximates the +## gradient of the cosine function in the point @math{x0 = 0}. As with +## sampled data, the spacing values between the points from which the +## gradient is estimated can be set via the @var{s} or @var{dx}, +## @var{dy}, @dots{} arguments. By default a spacing of 1 is used. +## @seealso{diff, del2} +## @end deftypefn + +## Author: Kai Habel +## Modified: David Bateman Added NDArray support + +function varargout = gradient (m, varargin) + + if (nargin < 1) + print_usage (); + endif + + nargout_with_ans = max(1,nargout); + if (ismatrix (m)) + [varargout{1:nargout_with_ans}] = matrix_gradient (m, varargin{:}); + elseif (isa (m, "function_handle")) + [varargout{1:nargout_with_ans}] = handle_gradient (m, varargin{:}); + elseif (ischar(m)) + [varargout{1:nargout_with_ans}] = handle_gradient (str2func (m), varargin{:}); + else + error ("gradient: first input must be an array or a function"); + endif + +endfunction + +function varargout = matrix_gradient (m, varargin) + transposed = false; + if (isvector (m)) + ## make a row vector. + transposed = (size (m, 2) == 1); + m = m(:).'; + endif + + nd = ndims (m); + sz = size (m); + if (length(sz) > 1) + tmp = sz(1); sz(1) = sz(2); sz(2) = tmp; + endif + + if (nargin > 2 && nargin != nd + 1) + print_usage (); + endif + + ## cell d stores a spacing vector for each dimension + d = cell (1, nd); + if (nargin == 1) + ## no spacing given - assume 1.0 for all dimensions + for i = 1:nd + d{i} = ones (sz(i) - 1, 1); + endfor + elseif (nargin == 2) + if (isscalar (varargin{1})) + ## single scalar value for all dimensions + for i = 1:nd + d{i} = varargin{1} * ones (sz(i) - 1, 1); + endfor + else + ## vector for one-dimensional derivative + d{1} = diff (varargin{1}(:)); + endif + else + ## have spacing value for each dimension + if (length(varargin) != nd) + error ("gradient: dimensions and number of spacing values do not match"); + endif + for i = 1:nd + if (isscalar (varargin{i})) + d{i} = varargin{i} * ones (sz(i) - 1, 1); + else + d{i} = diff (varargin{i}(:)); + endif + endfor + endif + + m = shiftdim (m, 1); + for i = 1:min (nd, nargout) + mr = rows (m); + mc = numel (m) / mr; + Y = zeros (size (m), class (m)); + + if (mr > 1) + ## Top and bottom boundary. + Y(1,:) = diff (m(1:2, :)) / d{i}(1); + Y(mr,:) = diff (m(mr-1:mr, :) / d{i}(mr - 1)); + endif + + if (mr > 2) + ## Interior points. + Y(2:mr-1,:) = ((m(3:mr,:) - m(1:mr-2,:)) + ./ kron (d{i}(1:mr-2) + d{i}(2:mr-1), ones (1, mc))); + endif + + ## turn multi-dimensional matrix in a way, that gradient + ## along x-direction is calculated first then y, z, ... + + if (i == 1) + varargout{i} = shiftdim (Y, nd - 1); + m = shiftdim (m, nd - 1); + elseif (i == 2) + varargout{i} = Y; + m = shiftdim (m, 2); + else + varargout{i} = shiftdim (Y, nd - i + 1); + m = shiftdim (m, 1); + endif + endfor + + if (transposed) + varargout{1} = varargout{1}.'; + endif +endfunction + +function varargout = handle_gradient (f, p0, varargin) + ## Input checking + p0_size = size (p0); + + if (numel (p0_size) != 2) + error ("gradient: the second input argument should either be a vector or a matrix"); + endif + + if (any (p0_size == 1)) + p0 = p0 (:); + dim = 1; + num_points = numel (p0); + else + num_points = p0_size (1); + dim = p0_size (2); + endif + + if (length (varargin) == 0) + delta = 1; + elseif (length (varargin) == 1 || length (varargin) == dim) + try + delta = [varargin{:}]; + catch + error ("gradient: spacing parameters must be scalars or a vector"); + end_try_catch + else + error ("gradient: incorrect number of spacing parameters"); + endif + + if (isscalar (delta)) + delta = repmat (delta, 1, dim); + elseif (!isvector (delta)) + error ("gradient: spacing values must be scalars or a vector"); + endif + + ## Calculate the gradient + p0 = mat2cell (p0, num_points, ones (1, dim)); + varargout = cell (1, dim); + for d = 1:dim + s = delta (d); + df_dx = (f (p0{1:d-1}, p0{d}+s, p0{d+1:end}) + - f (p0{1:d-1}, p0{d}-s, p0{d+1:end})) ./ (2*s); + if (dim == 1) + varargout{d} = reshape (df_dx, p0_size); + else + varargout{d} = df_dx; + endif + endfor +endfunction + +%!test +%! data = [1, 2, 4, 2]; +%! dx = gradient (data); +%! dx2 = gradient (data, 0.25); +%! dx3 = gradient (data, [0.25, 0.5, 1, 3]); +%! assert (dx, [1, 3/2, 0, -2]); +%! assert (dx2, [4, 6, 0, -8]); +%! assert (dx3, [4, 4, 0, -1]); +%! assert (size_equal(data, dx)); + +%!test +%! [Y,X,Z,U] = ndgrid (2:2:8,1:5,4:4:12,3:5:30); +%! [dX,dY,dZ,dU] = gradient (X); +%! assert (all(dX(:)==1)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (Y); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==2)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (Z); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==4)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (U); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==5)); +%! assert (size_equal(dX, dY, dZ, dU, X, Y, Z, U)); +%! [dX,dY,dZ,dU] = gradient (U, 5.0); +%! assert (all(dU(:)==1)); +%! [dX,dY,dZ,dU] = gradient (U, 1.0, 2.0, 3.0, 2.5); +%! assert (all(dU(:)==2)); + +%!test +%! [Y,X,Z,U] = ndgrid (2:2:8,1:5,4:4:12,3:5:30); +%! [dX,dY,dZ,dU] = gradient (X+j*X); +%! assert (all(dX(:)==1+1j)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (Y-j*Y); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==2-j*2)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (Z+j*1); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==4)); +%! assert (all(dU(:)==0)); +%! [dX,dY,dZ,dU] = gradient (U-j*1); +%! assert (all(dX(:)==0)); +%! assert (all(dY(:)==0)); +%! assert (all(dZ(:)==0)); +%! assert (all(dU(:)==5)); +%! assert (size_equal(dX, dY, dZ, dU, X, Y, Z, U)); +%! [dX,dY,dZ,dU] = gradient (U, 5.0); +%! assert (all(dU(:)==1)); +%! [dX,dY,dZ,dU] = gradient (U, 1.0, 2.0, 3.0, 2.5); +%! assert (all(dU(:)==2)); + +%!test +%! x = 0:10; +%! f = @cos; +%! df_dx = @(x) -sin (x); +%! assert (gradient (f, x), df_dx (x), 0.2); +%! assert (gradient (f, x, 0.5), df_dx (x), 0.1); + +%!test +%! xy = reshape (1:10, 5, 2); +%! f = @(x,y) sin (x) .* cos (y); +%! df_dx = @(x, y) cos (x) .* cos (y); +%! df_dy = @(x, y) -sin (x) .* sin (y); +%! [dx, dy] = gradient (f, xy); +%! assert (dx, df_dx (xy (:, 1), xy (:, 2)), 0.1) +%! assert (dy, df_dy (xy (:, 1), xy (:, 2)), 0.1) + diff --git a/octave_packages/m/general/idivide.m b/octave_packages/m/general/idivide.m new file mode 100644 index 0000000..2428a30 --- /dev/null +++ b/octave_packages/m/general/idivide.m @@ -0,0 +1,124 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} idivide (@var{x}, @var{y}, @var{op}) +## Integer division with different rounding rules. +## +## The standard behavior of integer division such as @code{@var{a} ./ @var{b}} +## is to round the result to the nearest integer. This is not always the +## desired behavior and @code{idivide} permits integer element-by-element +## division to be performed with different treatment for the fractional +## part of the division as determined by the @var{op} flag. @var{op} is +## a string with one of the values: +## +## @table @asis +## @item "fix" +## Calculate @code{@var{a} ./ @var{b}} with the fractional part rounded +## towards zero. +## +## @item "round" +## Calculate @code{@var{a} ./ @var{b}} with the fractional part rounded +## towards the nearest integer. +## +## @item "floor" +## Calculate @code{@var{a} ./ @var{b}} with the fractional part rounded +## towards negative infinity. +## +## @item "ceil" +## Calculate @code{@var{a} ./ @var{b}} with the fractional part rounded +## towards positive infinity. +## @end table +## +## @noindent +## If @var{op} is not given it defaults to @code{"fix"}. +## An example demonstrating these rounding rules is +## +## @example +## @group +## idivide (int8 ([-3, 3]), int8 (4), "fix") +## @result{} int8 ([0, 0]) +## idivide (int8 ([-3, 3]), int8 (4), "round") +## @result{} int8 ([-1, 1]) +## idivide (int8 ([-3, 3]), int8 (4), "floor") +## @result{} int8 ([-1, 0]) +## idivide (int8 ([-3, 3]), int8 (4), "ceil") +## @result{} int8 ([0, 1]) +## @end group +## @end example +## +## @seealso{ldivide, rdivide} +## @end deftypefn + +function z = idivide (x, y, op) + if (nargin < 2 || nargin > 3) + print_usage (); + elseif (nargin == 2) + op = "fix"; + else + op = tolower (op); + endif + + if (strcmp (op, "round")) + z = x ./ y; + else + if (isfloat (x)) + typ = class (y); + elseif (isfloat (y)) + typ = class (x); + else + typ = class (x); + if (!strcmp (class (x), class (y))) + error ("idivide: incompatible types"); + endif + endif + + if (strcmp (op, "fix")) + z = cast (fix (double (x) ./ double (y)), typ); + elseif (strcmp (op, "floor")) + z = cast (floor (double (x) ./ double (y)), typ); + elseif (strcmp (op, "ceil")) + z = cast (ceil (double (x) ./ double (y)), typ); + else + error ("idivide: unrecognized rounding type"); + endif + endif +endfunction + +%!shared a, af, b, bf +%! a = int8(3); +%! af = 3; +%! b = int8([-4, 4]); +%! bf = [-4, 4]; + +%!assert (idivide (a, b), int8 ([0, 0])) +%!assert (idivide (a, b, "floor"), int8([-1, 0])) +%!assert (idivide (a, b, "ceil"), int8 ([0, 1])) +%!assert (idivide (a, b, "round"), int8 ([-1, 1])) + +%!assert (idivide (af, b), int8 ([0, 0])) +%!assert (idivide (af, b, "floor"), int8([-1, 0])) +%!assert (idivide (af, b, "ceil"), int8 ([0, 1])) +%!assert (idivide (af, b, "round"), int8 ([-1, 1])) + +%!assert (idivide (a, bf), int8 ([0, 0])) +%!assert (idivide (a, bf, "floor"), int8([-1, 0])) +%!assert (idivide (a, bf, "ceil"), int8 ([0, 1])) +%!assert (idivide (a, bf, "round"), int8 ([-1, 1])) + +%!error (idivide (uint8(1), int8(1))) diff --git a/octave_packages/m/general/int2str.m b/octave_packages/m/general/int2str.m new file mode 100644 index 0000000..b80fae7 --- /dev/null +++ b/octave_packages/m/general/int2str.m @@ -0,0 +1,122 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} int2str (@var{n}) +## Convert an integer (or array of integers) to a string (or a character +## array). +## +## @example +## @group +## int2str (123) +## @result{} "123" +## +## s = int2str ([1, 2, 3; 4, 5, 6]) +## @result{} s = +## 1 2 3 +## 4 5 6 +## +## whos s +## @result{} s = +## Attr Name Size Bytes Class +## ==== ==== ==== ===== ===== +## s 2x7 14 char +## @end group +## @end example +## +## This function is not very flexible. For better control over the +## results, use @code{sprintf} (@pxref{Formatted Output}). +## @seealso{sprintf, num2str, mat2str} +## @end deftypefn + +## Author: jwe + +function retval = int2str (n) + + if (nargin != 1) + print_usage (); + endif + + if (isempty (n)) + retval = ''; + return; + endif + + n = round (real(n)); + sz = size(n); + nd = ndims (n); + nc = columns (n); + if (nc > 1) + idx = repmat ({':'}, nd, 1); + idx(2) = 1; + ifmt = get_fmt (n(idx{:}), 0); + idx(2) = 2:sz(2); + rfmt = get_fmt (n(idx{:}), 2); + fmt = cstrcat (ifmt, repmat (rfmt, 1, nc-1), "\n"); + else + fmt = cstrcat (get_fmt (n, 0), "\n"); + endif + tmp = sprintf (fmt, permute (n, [2, 1, 3 : nd])); + tmp(end) = ""; + retval = char (strsplit (tmp, "\n")); + +endfunction + +function fmt = get_fmt (x, sep) + + t = x(:); + t = t(t != 0); + if (isempty (t)) + ## All zeros. + fmt = sprintf ("%%%dd", 1 + sep); + else + ## Maybe have some zeros. + nan_inf = isinf (t) | isnan (t); + if (any (nan_inf)) + if (any (t(nan_inf) < 0)) + min_fw = 4 + sep; + else + min_fw = 3 + sep; + endif + else + min_fw = 1 + sep; + endif + t = t(! nan_inf); + if (isempty (t)) + ## Only zeros, Inf, and NaN. + fmt = sprintf ("%%%dd", min_fw); + else + ## Could have anything. + tfw = floor (log10 (double (abs (t)))) + 1 + sep; + fw = max (tfw); + if (any (t(tfw == fw) < 0)) + fw++; + endif + fmt = sprintf ("%%%dd", max (fw, min_fw)); + endif + endif + +endfunction + +%!assert (strcmp (int2str (-123), "-123") && strcmp (int2str (1.2), "1")); +%!assert (all (int2str ([1, 2, 3; 4, 5, 6]) == ["1 2 3";"4 5 6"])); +%!assert (int2str([]), ""); + +%!error int2str (); +%!error int2str (1, 2); + diff --git a/octave_packages/m/general/interp1.m b/octave_packages/m/general/interp1.m new file mode 100644 index 0000000..56cce53 --- /dev/null +++ b/octave_packages/m/general/interp1.m @@ -0,0 +1,566 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{yi} =} interp1 (@var{x}, @var{y}, @var{xi}) +## @deftypefnx {Function File} {@var{yi} =} interp1 (@var{y}, @var{xi}) +## @deftypefnx {Function File} {@var{yi} =} interp1 (@dots{}, @var{method}) +## @deftypefnx {Function File} {@var{yi} =} interp1 (@dots{}, @var{extrap}) +## @deftypefnx {Function File} {@var{pp} =} interp1 (@dots{}, 'pp') +## +## One-dimensional interpolation. Interpolate @var{y}, defined at the +## points @var{x}, at the points @var{xi}. The sample points @var{x} +## must be monotonic. If not specified, @var{x} is taken to be the +## indices of @var{y}. If @var{y} is an array, treat the columns +## of @var{y} separately. +## +## Method is one of: +## +## @table @asis +## @item 'nearest' +## Return the nearest neighbor. +## +## @item 'linear' +## Linear interpolation from nearest neighbors +## +## @item 'pchip' +## Piecewise cubic Hermite interpolating polynomial +## +## @item 'cubic' +## Cubic interpolation (same as @code{pchip}) +## +## @item 'spline' +## Cubic spline interpolation---smooth first and second derivatives +## throughout the curve +## @end table +## +## Appending '*' to the start of the above method forces @code{interp1} +## to assume that @var{x} is uniformly spaced, and only @code{@var{x} +## (1)} and @code{@var{x} (2)} are referenced. This is usually faster, +## and is never slower. The default method is 'linear'. +## +## If @var{extrap} is the string 'extrap', then extrapolate values beyond +## the endpoints. If @var{extrap} is a number, replace values beyond the +## endpoints with that number. If @var{extrap} is missing, assume NA. +## +## If the string argument 'pp' is specified, then @var{xi} should not be +## supplied and @code{interp1} returns the piecewise polynomial that +## can later be used with @code{ppval} to evaluate the interpolation. +## There is an equivalence, such that @code{ppval (interp1 (@var{x}, +## @var{y}, @var{method}, 'pp'), @var{xi}) == interp1 (@var{x}, @var{y}, +## @var{xi}, @var{method}, 'extrap')}. +## +## Duplicate points in @var{x} specify a discontinuous interpolant. There +## should be at most 2 consecutive points with the same value. +## The discontinuous interpolant is right-continuous if @var{x} is increasing, +## left-continuous if it is decreasing. +## Discontinuities are (currently) only allowed for "nearest" and "linear" +## methods; in all other cases, @var{x} must be strictly monotonic. +## +## An example of the use of @code{interp1} is +## +## @example +## @group +## xf = [0:0.05:10]; +## yf = sin (2*pi*xf/5); +## xp = [0:10]; +## yp = sin (2*pi*xp/5); +## lin = interp1 (xp, yp, xf); +## spl = interp1 (xp, yp, xf, "spline"); +## cub = interp1 (xp, yp, xf, "cubic"); +## near = interp1 (xp, yp, xf, "nearest"); +## plot (xf, yf, "r", xf, lin, "g", xf, spl, "b", +## xf, cub, "c", xf, near, "m", xp, yp, "r*"); +## legend ("original", "linear", "spline", "cubic", "nearest"); +## @end group +## @end example +## +## @seealso{interpft} +## @end deftypefn + +## Author: Paul Kienzle +## Date: 2000-03-25 +## added 'nearest' as suggested by Kai Habel +## 2000-07-17 Paul Kienzle +## added '*' methods and matrix y +## check for proper table lengths +## 2002-01-23 Paul Kienzle +## fixed extrapolation + +function yi = interp1 (x, y, varargin) + + if (nargin < 2 || nargin > 6) + print_usage (); + endif + + method = "linear"; + extrap = NA; + xi = []; + ispp = false; + firstnumeric = true; + + if (nargin > 2) + for i = 1:length (varargin) + arg = varargin{i}; + if (ischar (arg)) + arg = tolower (arg); + if (strcmp ("extrap", arg)) + extrap = "extrap"; + elseif (strcmp ("pp", arg)) + ispp = true; + else + method = arg; + endif + else + if (firstnumeric) + xi = arg; + firstnumeric = false; + else + extrap = arg; + endif + endif + endfor + endif + + if (isempty (xi) && firstnumeric && ! ispp) + xi = y; + y = x; + x = 1:numel(y); + endif + + ## reshape matrices for convenience + x = x(:); + nx = rows (x); + szx = size (xi); + if (isvector (y)) + y = y(:); + endif + + szy = size (y); + y = y(:,:); + [ny, nc] = size (y); + xi = xi(:); + + ## determine sizes + if (nx < 2 || ny < 2) + error ("interp1: table too short"); + endif + + ## check whether x is sorted; sort if not. + if (! issorted (x, "either")) + [x, p] = sort (x); + y = y(p,:); + endif + + starmethod = method(1) == "*"; + + if (starmethod) + dx = x(2) - x(1); + else + jumps = x(1:nx-1) == x(2:nx); + have_jumps = any (jumps); + if (have_jumps) + if (any (strcmp (method, {"nearest", "linear"}))) + if (any (jumps(1:nx-2) & jumps(2:nx-1))) + warning ("interp1: extra points in discontinuities"); + endif + else + error ("interp1: discontinuities not supported for method %s", method); + endif + endif + endif + + ## Proceed with interpolating by all methods. + + switch (method) + case "nearest" + pp = mkpp ([x(1); (x(1:nx-1)+x(2:nx))/2; x(nx)], shiftdim (y, 1), szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; + else + yi = ppval (pp, reshape (xi, szx)); + endif + case "*nearest" + pp = mkpp ([x(1), x(1)+[0.5:(nx-1)]*dx, x(nx)], shiftdim (y, 1), szy(2:end)); + pp.orient = "first"; + if (ispp) + yi = pp; + else + yi = ppval(pp, reshape (xi, szx)); + endif + case "linear" + dy = diff (y); + dx = diff (x); + dx = repmat (dx, [1 size(dy)(2:end)]); + coefs = [(dy./dx).'(:), y(1:nx-1, :).'(:)]; + xx = x; + + if (have_jumps) + ## Omit zero-size intervals. + coefs(jumps, :) = []; + xx(jumps) = []; + endif + + pp = mkpp (xx, coefs, szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; + else + yi = ppval(pp, reshape (xi, szx)); + endif + + case "*linear" + dy = diff (y); + coefs = [(dy/dx).'(:), y(1:nx-1, :).'(:)]; + pp = mkpp (x, coefs, szy(2:end)); + pp.orient = "first"; + + if (ispp) + yi = pp; + else + yi = ppval(pp, reshape (xi, szx)); + endif + + case {"pchip", "*pchip", "cubic", "*cubic"} + if (nx == 2 || starmethod) + x = linspace (x(1), x(nx), ny); + endif + + if (ispp) + y = shiftdim (reshape (y, szy), 1); + yi = pchip (x, y); + else + y = shiftdim (y, 1); + yi = pchip (x, y, reshape (xi, szx)); + endif + case {"spline", "*spline"} + if (nx == 2 || starmethod) + x = linspace(x(1), x(nx), ny); + endif + + if (ispp) + y = shiftdim (reshape (y, szy), 1); + yi = spline (x, y); + else + y = shiftdim (y, 1); + yi = spline (x, y, reshape (xi, szx)); + endif + otherwise + error ("interp1: invalid method '%s'", method); + endswitch + + if (! ispp) + if (! ischar (extrap)) + ## determine which values are out of range and set them to extrap, + ## unless extrap == "extrap". + minx = min (x(1), x(nx)); + maxx = max (x(1), x(nx)); + + outliers = xi < minx | ! (xi <= maxx); # this catches even NaNs + if (size_equal (outliers, yi)) + yi(outliers) = extrap; + yi = reshape (yi, szx); + elseif (!isvector (yi)) + if (strcmp (method, "pchip") || strcmp (method, "*pchip") + ||strcmp (method, "cubic") || strcmp (method, "*cubic") + ||strcmp (method, "spline") || strcmp (method, "*spline")) + yi(:, outliers) = extrap; + yi = shiftdim(yi, 1); + else + yi(outliers, :) = extrap; + endif + else + yi(outliers.') = extrap; + endif + endif + else + yi.orient = "first"; + endif + +endfunction + +%!demo +%! xf=0:0.05:10; yf = sin(2*pi*xf/5); +%! xp=0:10; yp = sin(2*pi*xp/5); +%! lin=interp1(xp,yp,xf,"linear"); +%! spl=interp1(xp,yp,xf,"spline"); +%! cub=interp1(xp,yp,xf,"pchip"); +%! near=interp1(xp,yp,xf,"nearest"); +%! plot(xf,yf,"r",xf,near,"g",xf,lin,"b",xf,cub,"c",xf,spl,"m",xp,yp,"r*"); +%! legend ("original","nearest","linear","pchip","spline") +%! %-------------------------------------------------------- +%! % confirm that interpolated function matches the original + +%!demo +%! xf=0:0.05:10; yf = sin(2*pi*xf/5); +%! xp=0:10; yp = sin(2*pi*xp/5); +%! lin=interp1(xp,yp,xf,"*linear"); +%! spl=interp1(xp,yp,xf,"*spline"); +%! cub=interp1(xp,yp,xf,"*cubic"); +%! near=interp1(xp,yp,xf,"*nearest"); +%! plot(xf,yf,"r",xf,near,"g",xf,lin,"b",xf,cub,"c",xf,spl,"m",xp,yp,"r*"); +%! legend ("*original","*nearest","*linear","*cubic","*spline") +%! %-------------------------------------------------------- +%! % confirm that interpolated function matches the original + +%!demo +%! t = 0 : 0.3 : pi; dt = t(2)-t(1); +%! n = length (t); k = 100; dti = dt*n/k; +%! ti = t(1) + [0 : k-1]*dti; +%! y = sin (4*t + 0.3) .* cos (3*t - 0.1); +%! ddyc = diff(diff(interp1(t,y,ti,'cubic'))./dti)./dti; +%! ddys = diff(diff(interp1(t,y,ti,'spline'))./dti)./dti; +%! ddyp = diff(diff(interp1(t,y,ti,'pchip'))./dti)./dti; +%! plot (ti(2:end-1), ddyc,'g+',ti(2:end-1),ddys,'b*', ... +%! ti(2:end-1),ddyp,'c^'); +%! legend('cubic','spline','pchip'); +%! title("Second derivative of interpolated 'sin (4*t + 0.3) .* cos (3*t - 0.1)'"); + +%!demo +%! xf=0:0.05:10; yf = sin(2*pi*xf/5) - (xf >= 5); +%! xp=[0:.5:4.5,4.99,5:.5:10]; yp = sin(2*pi*xp/5) - (xp >= 5); +%! lin=interp1(xp,yp,xf,"linear"); +%! near=interp1(xp,yp,xf,"nearest"); +%! plot(xf,yf,"r",xf,near,"g",xf,lin,"b",xp,yp,"r*"); +%! legend ("original","nearest","linear") +%! %-------------------------------------------------------- +%! % confirm that interpolated function matches the original + +##FIXME: add test for n-d arguments here + +## For each type of interpolated test, confirm that the interpolated +## value at the knots match the values at the knots. Points away +## from the knots are requested, but only 'nearest' and 'linear' +## confirm they are the correct values. + +%!shared xp, yp, xi, style +%! xp=0:2:10; yp = sin(2*pi*xp/5); +%! xi = [-1, 0, 2.2, 4, 6.6, 10, 11]; + + +## The following BLOCK/ENDBLOCK section is repeated for each style +## nearest, linear, cubic, spline, pchip +## The test for ppval of cubic has looser tolerance, but otherwise +## the tests are identical. +## Note that the block checks style and *style; if you add more tests +## before to add them to both sections of each block. One test, +## style vs. *style, occurs only in the first section. +## There is an ENDBLOCKTEST after the final block +%!test style = "nearest"; +## BLOCK +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),10*eps); +%!error interp1(1,1,1, style); +%!assert (interp1(xp,[yp',yp'],xi,style), +%! interp1(xp,[yp',yp'],xi,["*",style]),100*eps); +%!test style=['*',style]; +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),10*eps); +%!error interp1(1,1,1, style); +## ENDBLOCK +%!test style='linear'; +## BLOCK +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),10*eps); +%!error interp1(1,1,1, style); +%!assert (interp1(xp,[yp',yp'],xi,style), +%! interp1(xp,[yp',yp'],xi,["*",style]),100*eps); +%!test style=['*',style]; +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),10*eps); +%!error interp1(1,1,1, style); +## ENDBLOCK +%!test style='cubic'; +## BLOCK +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),100*eps); +%!error interp1(1,1,1, style); +%!assert (interp1(xp,[yp',yp'],xi,style), +%! interp1(xp,[yp',yp'],xi,["*",style]),100*eps); +%!test style=['*',style]; +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),100*eps); +%!error interp1(1,1,1, style); +## ENDBLOCK +%!test style='pchip'; +## BLOCK +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),10*eps); +%!error interp1(1,1,1, style); +%!assert (interp1(xp,[yp',yp'],xi,style), +%! interp1(xp,[yp',yp'],xi,["*",style]),100*eps); +%!test style=['*',style]; +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),10*eps); +%!error interp1(1,1,1, style); +## ENDBLOCK +%!test style='spline'; +## BLOCK +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),10*eps); +%!error interp1(1,1,1, style); +%!assert (interp1(xp,[yp',yp'],xi,style), +%! interp1(xp,[yp',yp'],xi,["*",style]),100*eps); +%!test style=['*',style]; +%!assert (interp1(xp, yp, [min(xp)-1, max(xp)+1],style), [NA, NA]); +%!assert (interp1(xp,yp,xp,style), yp, 100*eps); +%!assert (interp1(xp,yp,xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp',style), yp', 100*eps); +%!assert (interp1(xp',yp',xp,style), yp, 100*eps); +%!assert (isempty(interp1(xp',yp',[],style))); +%!assert (isempty(interp1(xp,yp,[],style))); +%!assert (interp1(xp,[yp',yp'],xi(:),style),... +%! [interp1(xp,yp,xi(:),style),interp1(xp,yp,xi(:),style)]); +%!assert (interp1(xp,yp,xi,style),... +%! interp1(fliplr(xp),fliplr(yp),xi,style),100*eps); +%!assert (ppval(interp1(xp,yp,style,"pp"),xi), +%! interp1(xp,yp,xi,style,"extrap"),10*eps); +%!error interp1(1,1,1, style); +## ENDBLOCK +## ENDBLOCKTEST + +%!# test linear extrapolation +%!assert (interp1([1:5],[3:2:11],[0,6],"linear","extrap"), [1, 13], eps); +%!assert (interp1(xp, yp, [-1, max(xp)+1],"linear",5), [5, 5]); + +%!error interp1 +%!error interp1(1:2,1:2,1,"bogus") + +%!assert (interp1(1:2,1:2,1.4,"nearest"),1); +%!error interp1(1,1,1, "linear"); +%!assert (interp1(1:2,1:2,1.4,"linear"),1.4); +%!assert (interp1(1:4,1:4,1.4,"cubic"),1.4); +%!assert (interp1(1:2,1:2,1.1, "spline"), 1.1); +%!assert (interp1(1:3,1:3,1.4,"spline"),1.4); + +%!error interp1(1,1,1, "*nearest"); +%!assert (interp1(1:2:4,1:2:4,1.4,"*nearest"),1); +%!error interp1(1,1,1, "*linear"); +%!assert (interp1(1:2:4,1:2:4,[0,1,1.4,3,4],"*linear"),[NA,1,1.4,3,NA]); +%!assert (interp1(1:2:8,1:2:8,1.4,"*cubic"),1.4); +%!assert (interp1(1:2,1:2,1.3, "*spline"), 1.3); +%!assert (interp1(1:2:6,1:2:6,1.4,"*spline"),1.4); + +%!assert (interp1([3,2,1],[3,2,2],2.5),2.5) + +%!assert (interp1 ([1,2,2,3,4],[0,1,4,2,1],[-1,1.5,2,2.5,3.5], "linear", "extrap"), [-2,0.5,4,3,1.5]) +%!assert (interp1 ([4,4,3,2,0],[0,1,4,2,1],[1.5,4,4.5], "linear"), [1.75,1,NA]) +%!assert (interp1 (0:4, 2.5), 1.5) diff --git a/octave_packages/m/general/interp1q.m b/octave_packages/m/general/interp1q.m new file mode 100644 index 0000000..9af4184 --- /dev/null +++ b/octave_packages/m/general/interp1q.m @@ -0,0 +1,70 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{yi} =} interp1q (@var{x}, @var{y}, @var{xi}) +## One-dimensional linear interpolation without error checking. +## Interpolates @var{y}, defined at the points @var{x}, at the points +## @var{xi}. The sample points @var{x} must be a strictly monotonically +## increasing column vector. If @var{y} is an array, treat the columns +## of @var{y} separately. If @var{y} is a vector, it must be a column +## vector of the same length as @var{x}. +## +## Values of @var{xi} beyond the endpoints of the interpolation result +## in NA being returned. +## +## Note that the error checking is only a significant portion of the +## execution time of this @code{interp1} if the size of the input arguments +## is relatively small. Therefore, the benefit of using @code{interp1q} +## is relatively small. +## @seealso{interp1} +## @end deftypefn + +function yi = interp1q (x, y, xi) + x = x(:); + nx = size (x, 1); + szy = size (y); + y = y(:,:); + [ny, nc] = size (y); + szx = size (xi); + xi = xi (:); + dy = diff (y); + dx = diff (x); + idx = lookup (x, xi, "lr"); + s = (xi - x (idx)) ./ dx (idx); + yi = bsxfun (@times, s, dy(idx,:)) + y(idx,:); + range = xi < x(1) | !(xi <= x(nx)); + yi(range,:) = NA; + if (length (szx) == 2 && any (szx == 1)) + yi = reshape (yi, [max(szx), szy(2:end)]); + else + yi = reshape (yi, [szx, szy(2:end)]); + endif +endfunction + +%!shared xp, yp, xi, yi +%! xp=[0:2:10].'; yp = sin(2*pi*xp/5); +%! xi = [-1; 0; 2.2; 4; 6.6; 10; 11]; +%! yi = interp1 (xp,yp,xi); +%!assert (interp1q(xp, yp, [min(xp)-1; max(xp)+1]), [NA; NA]); +%!assert (interp1q(xp,yp,xp), yp, 100*eps); +%!assert (isempty(interp1q(xp,yp,[]))); +%!assert (interp1q(xp,yp,xi), yi); +%!assert (interp1q(xp,[yp,yp],xi), [yi, yi]); +%!assert (interp1q(xp,yp,[xi,xi]), [yi, yi]); +%!assert (interp1q(xp,[yp,yp],[xi,xi]), cat (3, [yi, yi], [yi, yi])); diff --git a/octave_packages/m/general/interp2.m b/octave_packages/m/general/interp2.m new file mode 100644 index 0000000..d774482 --- /dev/null +++ b/octave_packages/m/general/interp2.m @@ -0,0 +1,610 @@ +## Copyright (C) 2000-2012 Kai Habel +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{zi} =} interp2 (@var{x}, @var{y}, @var{z}, @var{xi}, @var{yi}) +## @deftypefnx {Function File} {@var{zi} =} interp2 (@var{Z}, @var{xi}, @var{yi}) +## @deftypefnx {Function File} {@var{zi} =} interp2 (@var{Z}, @var{n}) +## @deftypefnx {Function File} {@var{zi} =} interp2 (@dots{}, @var{method}) +## @deftypefnx {Function File} {@var{zi} =} interp2 (@dots{}, @var{method}, @var{extrapval}) +## +## Two-dimensional interpolation. @var{x}, @var{y} and @var{z} describe a +## surface function. If @var{x} and @var{y} are vectors their length +## must correspondent to the size of @var{z}. @var{x} and @var{y} must be +## monotonic. If they are matrices they must have the @code{meshgrid} +## format. +## +## @table @code +## @item interp2 (@var{x}, @var{y}, @var{Z}, @var{xi}, @var{yi}, @dots{}) +## Returns a matrix corresponding to the points described by the +## matrices @var{xi}, @var{yi}. +## +## If the last argument is a string, the interpolation method can +## be specified. The method can be 'linear', 'nearest' or 'cubic'. +## If it is omitted 'linear' interpolation is assumed. +## +## @item interp2 (@var{z}, @var{xi}, @var{yi}) +## Assumes @code{@var{x} = 1:rows (@var{z})} and @code{@var{y} = +## 1:columns (@var{z})} +## +## @item interp2 (@var{z}, @var{n}) +## Interleaves the matrix @var{z} n-times. If @var{n} is omitted a value +## of @code{@var{n} = 1} is assumed. +## @end table +## +## The variable @var{method} defines the method to use for the +## interpolation. It can take one of the following values +## +## @table @asis +## @item 'nearest' +## Return the nearest neighbor. +## +## @item 'linear' +## Linear interpolation from nearest neighbors. +## +## @item 'pchip' +## Piecewise cubic Hermite interpolating polynomial. +## +## @item 'cubic' +## Cubic interpolation from four nearest neighbors. +## +## @item 'spline' +## Cubic spline interpolation---smooth first and second derivatives +## throughout the curve. +## @end table +## +## If a scalar value @var{extrapval} is defined as the final value, then +## values outside the mesh as set to this value. Note that in this case +## @var{method} must be defined as well. If @var{extrapval} is not +## defined then NA is assumed. +## +## @seealso{interp1} +## @end deftypefn + +## Author: Kai Habel +## 2005-03-02 Thomas Weber +## * Add test cases +## 2005-03-02 Paul Kienzle +## * Simplify +## 2005-04-23 Dmitri A. Sergatskov +## * Modified demo and test for new gnuplot interface +## 2005-09-07 Hoxide +## * Add bicubic interpolation method +## * Fix the eat line bug when the last element of XI or YI is +## negative or zero. +## 2005-11-26 Pierre Baldensperger +## * Rather big modification (XI,YI no longer need to be +## "meshgridded") to be consistent with the help message +## above and for compatibility. + +function ZI = interp2 (varargin) + Z = X = Y = XI = YI = n = []; + method = "linear"; + extrapval = NA; + + switch (nargin) + case 1 + Z = varargin{1}; + n = 1; + case 2 + if (ischar (varargin{2})) + [Z, method] = deal (varargin{:}); + n = 1; + else + [Z, n] = deal (varargin{:}); + endif + case 3 + if (ischar (varargin{3})) + [Z, n, method] = deal (varargin{:}); + else + [Z, XI, YI] = deal (varargin{:}); + endif + case 4 + if (ischar (varargin{4})) + [Z, XI, YI, method] = deal (varargin{:}); + else + [Z, n, method, extrapval] = deal (varargin{:}); + endif + case 5 + if (ischar (varargin{4})) + [Z, XI, YI, method, extrapval] = deal (varargin{:}); + else + [X, Y, Z, XI, YI] = deal (varargin{:}); + endif + case 6 + [X, Y, Z, XI, YI, method] = deal (varargin{:}); + case 7 + [X, Y, Z, XI, YI, method, extrapval] = deal (varargin{:}); + otherwise + print_usage (); + endswitch + + ## Type checking. + if (!ismatrix (Z)) + error ("interp2: Z must be a matrix"); + endif + if (!isempty (n) && !isscalar (n)) + error ("interp2: N must be a scalar"); + endif + if (!ischar (method)) + error ("interp2: METHOD must be a string"); + endif + if (ischar (extrapval) || strcmp (extrapval, "extrap")) + extrapval = []; + elseif (!isscalar (extrapval)) + error ("interp2: EXTRAPVAL must be a scalar"); + endif + + ## Define X, Y, XI, YI if needed + [zr, zc] = size (Z); + if (isempty (X)) + X = 1:zc; + Y = 1:zr; + endif + if (! isnumeric (X) || ! isnumeric (Y)) + error ("interp2: X, Y must be numeric matrices"); + endif + if (! isempty (n)) + ## Calculate the interleaved input vectors. + p = 2^n; + XI = (p:p*zc)/p; + YI = (p:p*zr)'/p; + endif + if (! isnumeric (XI) || ! isnumeric (YI)) + error ("interp2: XI, YI must be numeric"); + endif + + + if (strcmp (method, "linear") || strcmp (method, "nearest") ... + || strcmp (method, "pchip")) + + ## If X and Y vectors produce a grid from them + if (isvector (X) && isvector (Y)) + X = X(:); Y = Y(:); + elseif (size_equal (X, Y)) + X = X(1,:)'; Y = Y(:,1); + else + error ("interp2: X and Y must be matrices of same size"); + endif + if (columns (Z) != length (X) || rows (Z) != length (Y)) + error ("interp2: X and Y size must match the dimensions of Z"); + endif + + ## If Xi and Yi are vectors of different orientation build a grid + if ((rows (XI) == 1 && columns (YI) == 1) + || (columns (XI) == 1 && rows (YI) == 1)) + [XI, YI] = meshgrid (XI, YI); + elseif (! size_equal (XI, YI)) + error ("interp2: XI and YI must be matrices of equal size"); + endif + + ## if XI, YI are vectors, X and Y should share their orientation. + if (rows (XI) == 1) + if (rows (X) != 1) + X = X.'; + endif + if (rows (Y) != 1) + Y = Y.'; + endif + elseif (columns (XI) == 1) + if (columns (X) != 1) + X = X.'; + endif + if (columns (Y) != 1) + Y = Y.'; + endif + endif + + xidx = lookup (X, XI, "lr"); + yidx = lookup (Y, YI, "lr"); + + if (strcmp (method, "linear")) + ## each quad satisfies the equation z(x,y)=a+b*x+c*y+d*xy + ## + ## a-b + ## | | + ## c-d + a = Z(1:(zr - 1), 1:(zc - 1)); + b = Z(1:(zr - 1), 2:zc) - a; + c = Z(2:zr, 1:(zc - 1)) - a; + d = Z(2:zr, 2:zc) - a - b - c; + + ## scale XI, YI values to a 1-spaced grid + Xsc = (XI - X(xidx)) ./ (diff (X)(xidx)); + Ysc = (YI - Y(yidx)) ./ (diff (Y)(yidx)); + + ## Get 2D index. + idx = sub2ind (size (a), yidx, xidx); + ## We can dispose of the 1D indices at this point to save memory. + clear xidx yidx; + + ## apply plane equation + ZI = a(idx) + b(idx).*Xsc + c(idx).*Ysc + d(idx).*Xsc.*Ysc; + + elseif (strcmp (method, "nearest")) + ii = (XI - X(xidx) >= X(xidx + 1) - XI); + jj = (YI - Y(yidx) >= Y(yidx + 1) - YI); + idx = sub2ind (size (Z), yidx+jj, xidx+ii); + ZI = Z(idx); + + elseif (strcmp (method, "pchip")) + + if (length (X) < 2 || length (Y) < 2) + error ("interp2: pchip2 requires at least 2 points in each dimension"); + endif + + ## first order derivatives + DX = __pchip_deriv__ (X, Z, 2); + DY = __pchip_deriv__ (Y, Z, 1); + ## Compute mixed derivatives row-wise and column-wise, use the average. + DXY = (__pchip_deriv__ (X, DY, 2) + __pchip_deriv__ (Y, DX, 1))/2; + + ## do the bicubic interpolation + hx = diff (X); hx = hx(xidx); + hy = diff (Y); hy = hy(yidx); + + tx = (XI - X(xidx)) ./ hx; + ty = (YI - Y(yidx)) ./ hy; + + ## construct the cubic hermite base functions in x, y + + ## formulas: + ## b{1,1} = ( 2*t.^3 - 3*t.^2 + 1); + ## b{2,1} = h.*( t.^3 - 2*t.^2 + t ); + ## b{1,2} = (-2*t.^3 + 3*t.^2 ); + ## b{2,2} = h.*( t.^3 - t.^2 ); + + ## optimized equivalents of the above: + t1 = tx.^2; + t2 = tx.*t1 - t1; + xb{2,2} = hx.*t2; + t1 = t2 - t1; + xb{2,1} = hx.*(t1 + tx); + t2 += t1; + xb{1,2} = -t2; + xb{1,1} = t2 + 1; + + t1 = ty.^2; + t2 = ty.*t1 - t1; + yb{2,2} = hy.*t2; + t1 = t2 - t1; + yb{2,1} = hy.*(t1 + ty); + t2 += t1; + yb{1,2} = -t2; + yb{1,1} = t2 + 1; + + ZI = zeros (size (XI)); + for i = 1:2 + for j = 1:2 + zidx = sub2ind (size (Z), yidx+(j-1), xidx+(i-1)); + ZI += xb{1,i} .* yb{1,j} .* Z(zidx); + ZI += xb{2,i} .* yb{1,j} .* DX(zidx); + ZI += xb{1,i} .* yb{2,j} .* DY(zidx); + ZI += xb{2,i} .* yb{2,j} .* DXY(zidx); + endfor + endfor + + endif + + if (! isempty (extrapval)) + ## set points outside the table to 'extrapval' + if (X (1) < X (end)) + if (Y (1) < Y (end)) + ZI (XI < X(1,1) | XI > X(end) | YI < Y(1,1) | YI > Y(end)) = ... + extrapval; + else + ZI (XI < X(1) | XI > X(end) | YI < Y(end) | YI > Y(1)) = ... + extrapval; + endif + else + if (Y (1) < Y (end)) + ZI (XI < X(end) | XI > X(1) | YI < Y(1) | YI > Y(end)) = ... + extrapval; + else + ZI (XI < X(1,end) | XI > X(1) | YI < Y(end) | YI > Y(1)) = ... + extrapval; + endif + endif + endif + + else + + ## Check dimensions of X and Y + if (isvector (X) && isvector (Y)) + X = X(:).'; + Y = Y(:); + if (!isequal ([length(Y), length(X)], size(Z))) + error ("interp2: X and Y size must match the dimensions of Z"); + endif + elseif (!size_equal (X, Y)) + error ("interp2: X and Y must be matrices of equal size"); + if (! size_equal (X, Z)) + error ("interp2: X and Y size must match the dimensions of Z"); + endif + endif + + ## Check dimensions of XI and YI + if (isvector (XI) && isvector (YI) && ! size_equal (XI, YI)) + XI = XI(:).'; + YI = YI(:); + [XI, YI] = meshgrid (XI, YI); + elseif (! size_equal (XI, YI)) + error ("interp2: XI and YI must be matrices of equal size"); + endif + + if (strcmp (method, "cubic")) + if (isgriddata (XI) && isgriddata (YI')) + ZI = bicubic (X, Y, Z, XI (1, :), YI (:, 1), extrapval); + elseif (isgriddata (X) && isgriddata (Y')) + ## Allocate output + ZI = zeros (size (X)); + + ## Find inliers + inside = !(XI < X (1) | XI > X (end) | YI < Y (1) | YI > Y (end)); + + ## Scale XI and YI to match indices of Z + XI = (columns (Z) - 1) * (XI - X (1)) / (X (end) - X (1)) + 1; + YI = (rows (Z) - 1) * (YI - Y (1)) / (Y (end) - Y (1)) + 1; + + ## Start the real work + K = floor (XI); + L = floor (YI); + + ## Coefficients + AY1 = bc ((YI - L + 1)); + AX1 = bc ((XI - K + 1)); + AY0 = bc ((YI - L + 0)); + AX0 = bc ((XI - K + 0)); + AY_1 = bc ((YI - L - 1)); + AX_1 = bc ((XI - K - 1)); + AY_2 = bc ((YI - L - 2)); + AX_2 = bc ((XI - K - 2)); + + ## Perform interpolation + sz = size(Z); + ZI = AY_2 .* AX_2 .* Z (sym_sub2ind (sz, L+2, K+2)) ... + + AY_2 .* AX_1 .* Z (sym_sub2ind (sz, L+2, K+1)) ... + + AY_2 .* AX0 .* Z (sym_sub2ind (sz, L+2, K)) ... + + AY_2 .* AX1 .* Z (sym_sub2ind (sz, L+2, K-1)) ... + + AY_1 .* AX_2 .* Z (sym_sub2ind (sz, L+1, K+2)) ... + + AY_1 .* AX_1 .* Z (sym_sub2ind (sz, L+1, K+1)) ... + + AY_1 .* AX0 .* Z (sym_sub2ind (sz, L+1, K)) ... + + AY_1 .* AX1 .* Z (sym_sub2ind (sz, L+1, K-1)) ... + + AY0 .* AX_2 .* Z (sym_sub2ind (sz, L, K+2)) ... + + AY0 .* AX_1 .* Z (sym_sub2ind (sz, L, K+1)) ... + + AY0 .* AX0 .* Z (sym_sub2ind (sz, L, K)) ... + + AY0 .* AX1 .* Z (sym_sub2ind (sz, L, K-1)) ... + + AY1 .* AX_2 .* Z (sym_sub2ind (sz, L-1, K+2)) ... + + AY1 .* AX_1 .* Z (sym_sub2ind (sz, L-1, K+1)) ... + + AY1 .* AX0 .* Z (sym_sub2ind (sz, L-1, K)) ... + + AY1 .* AX1 .* Z (sym_sub2ind (sz, L-1, K-1)); + ZI (!inside) = extrapval; + + else + error ("interp2: input data must have `meshgrid' format"); + endif + + elseif (strcmp (method, "spline")) + if (isgriddata (XI) && isgriddata (YI')) + ZI = __splinen__ ({Y(:,1).', X(1,:)}, Z, {YI(:,1), XI(1,:)}, extrapval, + "spline"); + else + error ("interp2: input data must have `meshgrid' format"); + endif + else + error ("interp2: interpolation METHOD not recognized"); + endif + + endif +endfunction + +function b = isgriddata (X) + d1 = diff (X, 1, 1); + b = all (d1 (:) == 0); +endfunction + +## Compute the bicubic interpolation coefficients +function o = bc(x) + x = abs(x); + o = zeros(size(x)); + idx1 = (x < 1); + idx2 = !idx1 & (x < 2); + o(idx1) = 1 - 2.*x(idx1).^2 + x(idx1).^3; + o(idx2) = 4 - 8.*x(idx2) + 5.*x(idx2).^2 - x(idx2).^3; +endfunction + +## This version of sub2ind behaves as if the data was symmetrically padded +function ind = sym_sub2ind(sz, Y, X) + Y (Y < 1) = 1 - Y (Y < 1); + while (any (Y (:) > 2 * sz (1))) + Y (Y > 2 * sz (1)) = round (Y (Y > 2 * sz (1)) / 2); + endwhile + Y (Y > sz (1)) = 1 + 2 * sz (1) - Y (Y > sz (1)); + X (X < 1) = 1 - X (X < 1); + while (any (X (:) > 2 * sz (2))) + X (X > 2 * sz (2)) = round (X (X > 2 * sz (2)) / 2); + endwhile + X (X > sz (2)) = 1 + 2 * sz (2) - X (X > sz (2)); + ind = sub2ind(sz, Y, X); +endfunction + + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,4]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'linear')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! [x,y,A] = peaks(10); +%! x = x(1,:)'; y = y(:,1); +%! xi=linspace(min(x),max(x),41); +%! yi=linspace(min(y),max(y),41)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'linear')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,4]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'nearest')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! [x,y,A] = peaks(10); +%! x = x(1,:)'; y = y(:,1); +%! xi=linspace(min(x),max(x),41); +%! yi=linspace(min(y),max(y),41)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'nearest')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,2]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'pchip')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! [x,y,A] = peaks(10); +%! x = x(1,:)'; y = y(:,1); +%! xi=linspace(min(x),max(x),41); +%! yi=linspace(min(y),max(y),41)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'pchip')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,2]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'cubic')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! [x,y,A] = peaks(10); +%! x = x(1,:)'; y = y(:,1); +%! xi=linspace(min(x),max(x),41); +%! yi=linspace(min(y),max(y),41)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'cubic')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,2]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'spline')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! [x,y,A] = peaks(10); +%! x = x(1,:)'; y = y(:,1); +%! xi=linspace(min(x),max(x),41); +%! yi=linspace(min(y),max(y),41)'; +%! mesh(xi,yi,interp2(x,y,A,xi,yi,'spline')); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!test % simple test +%! x = [1,2,3]; +%! y = [4,5,6,7]; +%! [X, Y] = meshgrid(x,y); +%! Orig = X.^2 + Y.^3; +%! xi = [1.2,2, 1.5]; +%! yi = [6.2, 4.0, 5.0]'; +%! +%! Expected = ... +%! [243, 245.4, 243.9; +%! 65.6, 68, 66.5; +%! 126.6, 129, 127.5]; +%! Result = interp2(x,y,Orig, xi, yi); +%! +%! assert(Result, Expected, 1000*eps); + +%!test % 2^n form +%! x = [1,2,3]; +%! y = [4,5,6,7]; +%! [X, Y] = meshgrid(x,y); +%! Orig = X.^2 + Y.^3; +%! xi = [1:0.25:3]; yi = [4:0.25:7]'; +%! Expected = interp2(x,y,Orig, xi, yi); +%! Result = interp2(Orig,2); +%! +%! assert(Result, Expected, 10*eps); + +%!test % matrix slice +%! A = eye(4); +%! assert(interp2(A,[1:4],[1:4]),[1,1,1,1]); + +%!test % non-gridded XI,YI +%! A = eye(4); +%! assert(interp2(A,[1,2;3,4],[1,3;2,4]),[1,0;0,1]); + +%!test % for values outside of boundaries +%! x = [1,2,3]; +%! y = [4,5,6,7]; +%! [X, Y] = meshgrid(x,y); +%! Orig = X.^2 + Y.^3; +%! xi = [0,4]; +%! yi = [3,8]'; +%! assert(interp2(x,y,Orig, xi, yi),[NA,NA;NA,NA]); +%! assert(interp2(x,y,Orig, xi, yi,'linear', 0),[0,0;0,0]); + +%!test % for values at boundaries +%! A=[1,2;3,4]; +%! x=[0,1]; +%! y=[2,3]'; +%! assert(interp2(x,y,A,x,y,'linear'), A); +%! assert(interp2(x,y,A,x,y,'nearest'), A); + +%!test % for Matlab-compatible rounding for 'nearest' +%! X = meshgrid (1:4); +%! assert (interp2 (X, 2.5, 2.5, 'nearest'), 3); + +%!shared z, zout, tol +%! z = [1 3 5; 3 5 7; 5 7 9]; +%! zout = [1 2 3 4 5; 2 3 4 5 6; 3 4 5 6 7; 4 5 6 7 8; 5 6 7 8 9]; +%! tol = 2 * eps; +%!assert (interp2 (z), zout, tol); +%!assert (interp2 (z, "linear"), zout, tol); +%!assert (interp2 (z, "pchip"), zout, tol); +%!assert (interp2 (z, "cubic"), zout, 10 * tol); +%!assert (interp2 (z, "spline"), zout, tol); +%!assert (interp2 (z, [2 3 1], [2 2 2]', "linear"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "pchip"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "cubic"), repmat ([5, 7, 3], [3, 1]), 10 * tol) +%!assert (interp2 (z, [2 3 1], [2 2 2]', "spline"), repmat ([5, 7, 3], [3, 1]), tol) +%!assert (interp2 (z, [2 3 1], [2 2 2], "linear"), [5 7 3], tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "pchip"), [5 7 3], tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "cubic"), [5 7 3], 10 * tol); +%!assert (interp2 (z, [2 3 1], [2 2 2], "spline"), [5 7 3], tol); diff --git a/octave_packages/m/general/interp3.m b/octave_packages/m/general/interp3.m new file mode 100644 index 0000000..988c62a --- /dev/null +++ b/octave_packages/m/general/interp3.m @@ -0,0 +1,166 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{vi} =} interp3 (@var{x}, @var{y}, @var{z}, @var{v}, @var{xi}, @var{yi}, @var{zi}) +## @deftypefnx {Function File} {@var{vi} =} interp3 (@var{v}, @var{xi}, @var{yi}, @var{zi}) +## @deftypefnx {Function File} {@var{vi} =} interp3 (@var{v}, @var{m}) +## @deftypefnx {Function File} {@var{vi} =} interp3 (@var{v}) +## @deftypefnx {Function File} {@var{vi} =} interp3 (@dots{}, @var{method}) +## @deftypefnx {Function File} {@var{vi} =} interp3 (@dots{}, @var{method}, @var{extrapval}) +## +## Perform 3-dimensional interpolation. Each element of the 3-dimensional +## array @var{v} represents a value at a location given by the parameters +## @var{x}, @var{y}, and @var{z}. The parameters @var{x}, @var{x}, and +## @var{z} are either 3-dimensional arrays of the same size as the array +## @var{v} in the 'meshgrid' format or vectors. The parameters @var{xi}, etc. +## respect a similar format to @var{x}, etc., and they represent the points +## at which the array @var{vi} is interpolated. +## +## If @var{x}, @var{y}, @var{z} are omitted, they are assumed to be +## @code{x = 1 : size (@var{v}, 2)}, @code{y = 1 : size (@var{v}, 1)} and +## @code{z = 1 : size (@var{v}, 3)}. If @var{m} is specified, then +## the interpolation adds a point half way between each of the interpolation +## points. This process is performed @var{m} times. If only @var{v} is +## specified, then @var{m} is assumed to be @code{1}. +## +## Method is one of: +## +## @table @asis +## @item 'nearest' +## Return the nearest neighbor. +## +## @item 'linear' +## Linear interpolation from nearest neighbors. +## +## @item 'cubic' +## Cubic interpolation from four nearest neighbors (not implemented yet). +## +## @item 'spline' +## Cubic spline interpolation---smooth first and second derivatives +## throughout the curve. +## @end table +## +## The default method is 'linear'. +## +## If @var{extrap} is the string 'extrap', then extrapolate values beyond +## the endpoints. If @var{extrap} is a number, replace values beyond the +## endpoints with that number. If @var{extrap} is missing, assume NA. +## @seealso{interp1, interp2, spline, meshgrid} +## @end deftypefn + +function vi = interp3 (varargin) + method = "linear"; + extrapval = NA; + nargs = nargin; + + if (nargin < 1 || ! isnumeric (varargin{1})) + print_usage (); + endif + + if (ischar (varargin{end})) + method = varargin{end}; + nargs = nargs - 1; + elseif (nargs > 1 && ischar (varargin{end - 1})) + if (! isnumeric (varargin{end}) || ! isscalar (varargin{end})) + error ("interp3: extrapal is expected to be a numeric scalar"); + endif + extrapval = varargin{end}; + method = varargin{end-1}; + nargs = nargs - 2; + endif + + if (nargs < 3 || (nargs == 4 && ! isvector (varargin{1}) + && nargs == (ndims (varargin{1}) + 1))) + v = varargin{1}; + if (ndims (v) != 3) + error ("interp3: expect 3-dimensional array of values"); + endif + x = varargin (2:end); + if (any (! cellfun (@isvector, x))) + for i = 2 : 3 + if (! size_equal (x{1}, x{i})) + error ("interp3: dimensional mismatch"); + endif + x{i} = permute (x{i}, [2, 1, 3]); + endfor + x{1} = permute (x{1}, [2, 1, 3]); + endif + v = permute (v, [2, 1, 3]); + vi = ipermute (interpn (v, x{:}, method, extrapval), [2, 1, 3]); + elseif (nargs == 7 && nargs == (2 * ndims (varargin{ceil (nargs / 2)})) + 1) + v = varargin{4}; + if (ndims (v) != 3) + error ("interp3: expect 3-dimensional array of values"); + endif + x = varargin (1:3); + if (any (! cellfun (@isvector, x))) + for i = 2 : 3 + if (! size_equal (x{1}, x{i}) || ! size_equal (x{i}, v)) + error ("interp3: dimensional mismatch"); + endif + x{i} = permute (x{i}, [2, 1, 3]); + endfor + x{1} = permute (x{1}, [2, 1, 3]); + endif + y = varargin (5:7); + if (any (! cellfun (@isvector, y))) + for i = 2 : 3 + if (! size_equal (y{1}, y{i})) + error ("interp3: dimensional mismatch"); + endif + y{i} = permute (y{i}, [2, 1, 3]); + endfor + y{1} = permute (y{1}, [2, 1, 3]); + endif + v = permute (v, [2, 1, 3]); + vi = ipermute (interpn (x{:}, v, y{:}, method, extrapval), [2, 1, 3]); + else + error ("interp3: wrong number or incorrectly formatted input arguments"); + endif +endfunction + +%!test +%! x = y = z = -1:1; +%! f = @(x,y,z) x.^2 - y - z.^2; +%! [xx, yy, zz] = meshgrid (x, y, z); +%! v = f (xx,yy,zz); +%! xi = yi = zi = -1:0.5:1; +%! [xxi, yyi, zzi] = meshgrid (xi, yi, zi); +%! vi = interp3(x, y, z, v, xxi, yyi, zzi); +%! [xxi, yyi, zzi] = ndgrid (xi, yi, zi); +%! vi2 = interpn(x, y, z, v, xxi, yyi, zzi); +%! assert (vi, vi2); + +%!shared z, zout, tol +%! z = zeros (3, 3, 3); +%! zout = zeros (5, 5, 5); +%! z(:,:,1) = [1 3 5; 3 5 7; 5 7 9]; +%! z(:,:,2) = z(:,:,1) + 2; +%! z(:,:,3) = z(:,:,2) + 2; +%! for n = 1:5 +%! zout(:,:,n) = [1 2 3 4 5; +%! 2 3 4 5 6; +%! 3 4 5 6 7; +%! 4 5 6 7 8; +%! 5 6 7 8 9] + (n-1); +%! end +%! tol = 10 * eps; +%!assert (interp3 (z), zout, tol) +%!assert (interp3 (z, "linear"), zout, tol) +%!assert (interp3 (z, "spline"), zout, tol) diff --git a/octave_packages/m/general/interpft.m b/octave_packages/m/general/interpft.m new file mode 100644 index 0000000..5beb7ad --- /dev/null +++ b/octave_packages/m/general/interpft.m @@ -0,0 +1,116 @@ +## Copyright (C) 2001-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} interpft (@var{x}, @var{n}) +## @deftypefnx {Function File} {} interpft (@var{x}, @var{n}, @var{dim}) +## +## Fourier interpolation. If @var{x} is a vector, then @var{x} is +## resampled with @var{n} points. The data in @var{x} is assumed to be +## equispaced. If @var{x} is an array, then operate along each column of +## the array separately. If @var{dim} is specified, then interpolate +## along the dimension @var{dim}. +## +## @code{interpft} assumes that the interpolated function is periodic, +## and so assumptions are made about the endpoints of the interpolation. +## +## @seealso{interp1} +## @end deftypefn + +## Author: Paul Kienzle +## 2001-02-11 +## * initial version +## 2002-03-17 aadler +## * added code to work on matrices as well +## 2006-05-25 dbateman +## * Make it matlab compatiable, cutting out the 2-D interpolation + +function z = interpft (x, n, dim) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (! (isscalar (n) && n == fix (n))) + error ("interpft: N must be a scalar integer"); + endif + + if (nargin == 2) + if (isrow (x)) + dim = 2; + else + dim = 1; + endif + endif + + nd = ndims (x); + + if (dim < 1 || dim > nd) + error ("interpft: invalid dimension DIM"); + endif + + perm = [dim:nd, 1:(dim-1)]; + x = permute (x, perm); + m = rows (x); + + inc = max (1, fix (m/n)); + y = fft (x) / m; + k = floor (m / 2); + sz = size (x); + sz(1) = n * inc - m; + + idx = repmat ({':'}, nd, 1); + idx{1} = 1:k; + z = cat (1, y(idx{:}), zeros (sz)); + idx{1} = k+1:m; + z = cat (1, z, y(idx{:})); + z = n * ifft (z); + + if (inc != 1) + sz(1) = n; + z = inc * reshape (z(1:inc:end), sz); + endif + + z = ipermute (z, perm); + +endfunction + + +%!demo +%! t = 0 : 0.3 : pi; dt = t(2)-t(1); +%! n = length (t); k = 100; +%! ti = t(1) + [0 : k-1]*dt*n/k; +%! y = sin (4*t + 0.3) .* cos (3*t - 0.1); +%! yp = sin (4*ti + 0.3) .* cos (3*ti - 0.1); +%! plot (ti, yp, 'g', ti, interp1(t, y, ti, 'spline'), 'b', ... +%! ti, interpft (y, k), 'c', t, y, 'r+'); +%! legend ('sin(4t+0.3)cos(3t-0.1','spline','interpft','data'); + +%!shared n,y +%! x = [0:10]'; y = sin(x); n = length (x); +%!assert (interpft(y, n), y, 20*eps); +%!assert (interpft(y', n), y', 20*eps); +%!assert (interpft([y,y],n), [y,y], 20*eps); + +%% Test input validation +%!error interpft () +%!error interpft (1) +%!error interpft (1,2,3) +%!error (interpft(1,[n,n])) +%!error (interpft(1,2,0)) +%!error (interpft(1,2,3)) diff --git a/octave_packages/m/general/interpn.m b/octave_packages/m/general/interpn.m new file mode 100644 index 0000000..91afe95 --- /dev/null +++ b/octave_packages/m/general/interpn.m @@ -0,0 +1,314 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{vi} =} interpn (@var{x1}, @var{x2}, @dots{}, @var{v}, @var{y1}, @var{y2}, @dots{}) +## @deftypefnx {Function File} {@var{vi} =} interpn (@var{v}, @var{y1}, @var{y2}, @dots{}) +## @deftypefnx {Function File} {@var{vi} =} interpn (@var{v}, @var{m}) +## @deftypefnx {Function File} {@var{vi} =} interpn (@var{v}) +## @deftypefnx {Function File} {@var{vi} =} interpn (@dots{}, @var{method}) +## @deftypefnx {Function File} {@var{vi} =} interpn (@dots{}, @var{method}, @var{extrapval}) +## +## Perform @var{n}-dimensional interpolation, where @var{n} is at least two. +## Each element of the @var{n}-dimensional array @var{v} represents a value +## at a location given by the parameters @var{x1}, @var{x2}, @dots{}, @var{xn}. +## The parameters @var{x1}, @var{x2}, @dots{}, @var{xn} are either +## @var{n}-dimensional arrays of the same size as the array @var{v} in +## the 'ndgrid' format or vectors. The parameters @var{y1}, etc. respect a +## similar format to @var{x1}, etc., and they represent the points at which +## the array @var{vi} is interpolated. +## +## If @var{x1}, @dots{}, @var{xn} are omitted, they are assumed to be +## @code{x1 = 1 : size (@var{v}, 1)}, etc. If @var{m} is specified, then +## the interpolation adds a point half way between each of the interpolation +## points. This process is performed @var{m} times. If only @var{v} is +## specified, then @var{m} is assumed to be @code{1}. +## +## Method is one of: +## +## @table @asis +## @item 'nearest' +## Return the nearest neighbor. +## +## @item 'linear' +## Linear interpolation from nearest neighbors. +## +## @item 'cubic' +## Cubic interpolation from four nearest neighbors (not implemented yet). +## +## @item 'spline' +## Cubic spline interpolation---smooth first and second derivatives +## throughout the curve. +## @end table +## +## The default method is 'linear'. +## +## If @var{extrapval} is the scalar value, use it to replace the values +## beyond the endpoints with that number. If @var{extrapval} is missing, +## assume NA. +## @seealso{interp1, interp2, spline, ndgrid} +## @end deftypefn + +function vi = interpn (varargin) + + method = "linear"; + extrapval = NA; + nargs = nargin; + + if (nargin < 1 || ! isnumeric (varargin{1})) + print_usage (); + endif + + if (ischar (varargin{end})) + method = varargin{end}; + nargs = nargs - 1; + elseif (nargs > 1 && ischar (varargin{end - 1})) + if (! isnumeric (varargin{end}) || ! isscalar (varargin{end})) + error ("interpn: extrapal is expected to be a numeric scalar"); + endif + method = varargin{end - 1}; + extrapval = varargin{end}; + nargs = nargs - 2; + endif + + if (nargs < 3) + v = varargin{1}; + m = 1; + if (nargs == 2) + if (ischar (varargin{2})) + method = varargin{2}; + elseif (isnumeric (m) && isscalar (m) && fix (m) == m) + m = varargin{2}; + else + print_usage (); + endif + endif + sz = size (v); + nd = ndims (v); + x = cell (1, nd); + y = cell (1, nd); + for i = 1 : nd; + x{i} = 1 : sz(i); + y{i} = 1 : (1 / (2 ^ m)) : sz(i); + endfor + y{1} = y{1}.'; + [y{:}] = ndgrid (y{:}); + elseif (! isvector (varargin{1}) && nargs == (ndims (varargin{1}) + 1)) + v = varargin{1}; + sz = size (v); + nd = ndims (v); + x = cell (1, nd); + y = varargin (2 : nargs); + for i = 1 : nd; + x{i} = 1 : sz(i); + endfor + elseif (rem (nargs, 2) == 1 && nargs == + (2 * ndims (varargin{ceil (nargs / 2)})) + 1) + nv = ceil (nargs / 2); + v = varargin{nv}; + sz = size (v); + nd = ndims (v); + x = varargin (1 : (nv - 1)); + y = varargin ((nv + 1) : nargs); + else + error ("interpn: wrong number or incorrectly formatted input arguments"); + endif + + if (any (! cellfun ("isvector", x))) + for i = 2 : nd + if (! size_equal (x{1}, x{i}) || ! size_equal (x{i}, v)) + error ("interpn: dimensional mismatch"); + endif + idx (1 : nd) = {1}; + idx (i) = ":"; + x{i} = x{i}(idx{:})(:); + endfor + idx (1 : nd) = {1}; + idx (1) = ":"; + x{1} = x{1}(idx{:})(:); + endif + + method = tolower (method); + + all_vectors = all (cellfun ("isvector", y)); + different_lengths = numel (unique (cellfun ("numel", y))) > 1; + if (all_vectors && different_lengths) + [foobar(1:numel(y)).y] = ndgrid (y{:}); + y = {foobar.y}; + endif + + if (strcmp (method, "linear")) + vi = __lin_interpn__ (x{:}, v, y{:}); + vi (isna (vi)) = extrapval; + elseif (strcmp (method, "nearest")) + yshape = size (y{1}); + yidx = cell (1, nd); + for i = 1 : nd + y{i} = y{i}(:); + yidx{i} = lookup (x{i}, y{i}, "lr"); + endfor + idx = cell (1,nd); + for i = 1 : nd + idx{i} = yidx{i} + (y{i} - x{i}(yidx{i})(:) >= x{i}(yidx{i} + 1)(:) - y{i}); + endfor + vi = v (sub2ind (sz, idx{:})); + idx = zeros (prod (yshape), 1); + for i = 1 : nd + idx |= y{i} < min (x{i}(:)) | y{i} > max (x{i}(:)); + endfor + vi(idx) = extrapval; + vi = reshape (vi, yshape); + elseif (strcmp (method, "spline")) + if (any (! cellfun ("isvector", y))) + for i = 2 : nd + if (! size_equal (y{1}, y{i})) + error ("interpn: dimensional mismatch"); + endif + idx (1 : nd) = {1}; + idx (i) = ":"; + y{i} = y{i}(idx{:}); + endfor + idx (1 : nd) = {1}; + idx (1) = ":"; + y{1} = y{1}(idx{:}); + endif + + vi = __splinen__ (x, v, y, extrapval, "interpn"); + + if (size_equal (y{:})) + ly = length (y{1}); + idx = cell (1, ly); + q = cell (1, nd); + for i = 1 : ly + q(:) = i; + idx {i} = q; + endfor + vi = vi (cellfun (@(x) sub2ind (size(vi), x{:}), idx)); + vi = reshape (vi, size(y{1})); + endif + elseif (strcmp (method, "cubic")) + error ("interpn: cubic interpolation not yet implemented"); + else + error ("interpn: unrecognized interpolation METHOD"); + endif + +endfunction + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,4]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interpn(x,y,A.',xi,yi,"linear").'); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,4]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interpn(x,y,A.',xi,yi,"nearest").'); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!#demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,2]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interpn(x,y,A.',xi,yi,"cubic").'); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + +%!demo +%! A=[13,-1,12;5,4,3;1,6,2]; +%! x=[0,1,2]; y=[10,11,12]; +%! xi=linspace(min(x),max(x),17); +%! yi=linspace(min(y),max(y),26)'; +%! mesh(xi,yi,interpn(x,y,A.',xi,yi,"spline").'); +%! [x,y] = meshgrid(x,y); +%! hold on; plot3(x(:),y(:),A(:),"b*"); hold off; + + +%!demo +%! x = y = z = -1:1; +%! f = @(x,y,z) x.^2 - y - z.^2; +%! [xx, yy, zz] = meshgrid (x, y, z); +%! v = f (xx,yy,zz); +%! xi = yi = zi = -1:0.1:1; +%! [xxi, yyi, zzi] = ndgrid (xi, yi, zi); +%! vi = interpn(x, y, z, v, xxi, yyi, zzi, 'spline'); +%! mesh (yi, zi, squeeze (vi(1,:,:))); + + +%!test +%! [x,y,z] = ndgrid(0:2); +%! f = x+y+z; +%! assert (interpn(x,y,z,f,[.5 1.5],[.5 1.5],[.5 1.5]), [1.5, 4.5]) +%! assert (interpn(x,y,z,f,[.51 1.51],[.51 1.51],[.51 1.51],'nearest'), [3, 6]) +%! assert (interpn(x,y,z,f,[.5 1.5],[.5 1.5],[.5 1.5],'spline'), [1.5, 4.5]) +%! assert (interpn(x,y,z,f,x,y,z), f) +%! assert (interpn(x,y,z,f,x,y,z,'nearest'), f) +%! assert (interpn(x,y,z,f,x,y,z,'spline'), f) + +%!test +%! [x, y, z] = ndgrid (0:2, 1:4, 2:6); +%! f = x + y + z; +%! xi = [0.5 1.0 1.5]; +%! yi = [1.5 2.0 2.5 3.5]; +%! zi = [2.5 3.5 4.0 5.0 5.5]; +%! fi = interpn (x, y, z, f, xi, yi, zi); +%! [xi, yi, zi] = ndgrid (xi, yi, zi); +%! assert (fi, xi + yi + zi) + +%!test +%! xi = 0:2; +%! yi = 1:4; +%! zi = 2:6; +%! [x, y, z] = ndgrid (xi, yi, zi); +%! f = x + y + z; +%! fi = interpn (x, y, z, f, xi, yi, zi, "nearest"); +%! assert (fi, x + y + z) + +%!test +%! [x,y,z] = ndgrid(0:2); +%! f = x.^2+y.^2+z.^2; +%! assert (interpn(x,y,-z,f,1.5,1.5,-1.5), 7.5) + +%!test % for Matlab-compatible rounding for 'nearest' +%! X = meshgrid (1:4); +%! assert (interpn (X, 2.5, 2.5, 'nearest'), 3); + +%!shared z, zout, tol +%! z = zeros (3, 3, 3); +%! zout = zeros (5, 5, 5); +%! z(:,:,1) = [1 3 5; 3 5 7; 5 7 9]; +%! z(:,:,2) = z(:,:,1) + 2; +%! z(:,:,3) = z(:,:,2) + 2; +%! for n = 1:5 +%! zout(:,:,n) = [1 2 3 4 5; +%! 2 3 4 5 6; +%! 3 4 5 6 7; +%! 4 5 6 7 8; +%! 5 6 7 8 9] + (n-1); +%! end +%! tol = 10 * eps; +%!assert (interpn (z), zout, tol) +%!assert (interpn (z, "linear"), zout, tol) +%!assert (interpn (z, "spline"), zout, tol) diff --git a/octave_packages/m/general/isa.m b/octave_packages/m/general/isa.m new file mode 100644 index 0000000..da831f0 --- /dev/null +++ b/octave_packages/m/general/isa.m @@ -0,0 +1,96 @@ +## Copyright (C) 2004-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isa (@var{obj}, @var{class}) +## Return true if @var{obj} is an object from the class @var{class}. +## @seealso{class, typeinfo} +## @end deftypefn + +## Author: Paul Kienzle +## Adapted-by: jwe + +function retval = isa (obj, cname) + + if (nargin != 2) + print_usage (); + endif + + persistent float_classes = {"double", "single"}; + + persistent fnum_classes = {"double", "single", ... + "uint8", "uint16", "uint32", "uint64", ... + "int8", "int16", "int32", "int64"}; + + if (strcmp (cname, "float")) + retval = any (strcmp (class (obj), float_classes)); + elseif (strcmp (cname, "numeric")) + retval = any (strcmp (class (obj), fnum_classes)); + else + class_of_x = class (obj); + retval = strcmp (class_of_x, cname); + if (! retval && isobject (obj)) + retval = __isa_parent__ (obj, cname); + endif + endif + +endfunction + +%!assert (isa ("char", "float"), false) +%!assert (isa (logical (1), "float"), false) +%!assert (isa (double (13), "float"), true) +%!assert (isa (single (13), "float"), true) +%!assert (isa (int8 (13), "float"), false) +%!assert (isa (int16 (13), "float"), false) +%!assert (isa (int32 (13), "float"), false) +%!assert (isa (int64 (13), "float"), false) +%!assert (isa (uint8 (13), "float"), false) +%!assert (isa (uint16 (13), "float"), false) +%!assert (isa (uint32 (13), "float"), false) +%!assert (isa (uint64 (13), "float"), false) +%!assert (isa ("char", "numeric"), false) +%!assert (isa (logical (1), "numeric"), false) +%!assert (isa (double (13), "numeric"), true) +%!assert (isa (single (13), "numeric"), true) +%!assert (isa (int8 (13), "numeric"), true) +%!assert (isa (int16 (13), "numeric"), true) +%!assert (isa (int32 (13), "numeric"), true) +%!assert (isa (int64 (13), "numeric"), true) +%!assert (isa (uint8 (13), "numeric"), true) +%!assert (isa (uint16 (13), "numeric"), true) +%!assert (isa (uint32 (13), "numeric"), true) +%!assert (isa (uint64 (13), "numeric"), true) + +%!assert (isa (double (13), "double")); +%!assert (isa (single (13), "single")); +%!assert (isa (int8 (13), "int8")); +%!assert (isa (int16 (13), "int16")); +%!assert (isa (int32 (13), "int32")); +%!assert (isa (int64 (13), "int64")); +%!assert (isa (uint8 (13), "uint8")); +%!assert (isa (uint16 (13), "uint16")); +%!assert (isa (uint32 (13), "uint32")); +%!assert (isa (uint64 (13), "uint64")); +%!assert (isa ("string", "char")); +%!assert (isa (true, "logical")); +%!assert (isa (false, "logical")); +%!assert (isa ({1, 2}, "cell")); +%!test +%! a.b = 1; +%! assert (isa (a, "struct")); + diff --git a/octave_packages/m/general/iscolumn.m b/octave_packages/m/general/iscolumn.m new file mode 100644 index 0000000..b384bd3 --- /dev/null +++ b/octave_packages/m/general/iscolumn.m @@ -0,0 +1,56 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} iscolumn (@var{x}) +## Return true if @var{x} is a column vector. +## @seealso{isrow, isscalar, isvector, ismatrix} +## @end deftypefn + +## Author: Rik Wehbring + +function retval = iscolumn (x) + + if (nargin != 1) + print_usage (); + endif + + sz = size (x); + retval = (ndims (x) == 2 && (sz(2) == 1)); + +endfunction + + +%!assert (iscolumn ([1, 2, 3]), false) +%!assert (iscolumn ([1; 2; 3])) +%!assert (iscolumn (1)) +%!assert (iscolumn ([]), false) +%!assert (iscolumn ([1, 2; 3, 4]), false) + +%!assert (iscolumn ("t")) +%!assert (iscolumn ("test"), false) +%!assert (iscolumn (["test"; "ing"]), false) + +%!test +%! s.a = 1; +%! assert (iscolumn (s)); + +%% Test input validation +%!error iscolumn () +%!error iscolumn ([1, 2], 2) + diff --git a/octave_packages/m/general/isdir.m b/octave_packages/m/general/isdir.m new file mode 100644 index 0000000..e21eaa5 --- /dev/null +++ b/octave_packages/m/general/isdir.m @@ -0,0 +1,39 @@ +## Copyright (C) 2004-2012 Alois Schloegl +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isdir (@var{f}) +## Return true if @var{f} is a directory. +## @seealso{is_absolute_filename, is_rooted_relative_filename} +## @end deftypefn + +function retval = isdir (f) + if (nargin != 1) + print_usage ("isdir"); + endif + + ## Exist returns an integer but isdir should return a logical. + retval = (exist (f, "dir") == 7); + +endfunction + +%!error isdir (); +%!error isdir (1, 2); + +%!assert (isdir (pwd ())); +%!assert (! isdir ("this is highly unlikely to be a directory name")); diff --git a/octave_packages/m/general/isequal.m b/octave_packages/m/general/isequal.m new file mode 100644 index 0000000..f6412fc --- /dev/null +++ b/octave_packages/m/general/isequal.m @@ -0,0 +1,74 @@ +## Copyright (C) 2005-2012 William Poetra Yoga Hadisoeseno +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isequal (@var{x1}, @var{x2}, @dots{}) +## Return true if all of @var{x1}, @var{x2}, @dots{} are equal. +## @seealso{isequalwithequalnans} +## @end deftypefn + +function retval = isequal (x1, varargin) + + if (nargin < 2) + print_usage (); + endif + + retval = __isequal__ (false, x1, varargin{:}); + +endfunction + +## test size and shape +%!assert(isequal([1,2,3,4],[1,2,3,4]), true) +%!assert(isequal([1;2;3;4],[1;2;3;4]), true) +%!assert(isequal([1,2,3,4],[1;2;3;4]), false) +%!assert(isequal([1,2,3,4],[1,2;3,4]), false) +%!assert(isequal([1,2,3,4],[1,3;2,4]), false) + +%!test +%! A = 1:8; +%! B = reshape (A, 2, 2, 2); +%! assert (isequal (A, B), false); + +%!test +%! A = reshape (1:8, 2, 2, 2); +%! B = A; +%! assert (isequal (A, B), true); + +%!test +%! A = reshape (1:8, 2, 4); +%! B = reshape (A, 2, 2, 2); +%! assert (isequal (A, B), false); + +## test for equality +%!assert(isequal([1,2,3,4],[1,2,3,4]), true) +%!assert(isequal(['a','b','c','d'],['a','b','c','d']), true) +## Test multi-line strings +%!assert(isequal(["test";"strings"],["test";"strings"],["test";"strings"]), true) +## test for inequality +%!assert(isequal([1,2,3,4],[1;2;3;4]),false) +%!assert(isequal({1,2,3,4},[1,2,3,4]),false) +%!assert(isequal([1,2,3,4],{1,2,3,4}),false) +%!assert(isequal([1,2,NaN,4],[1,2,NaN,4]),false) +%!assert(isequal(['a','b','c','d'],['a';'b';'c';'d']),false) +%!assert(isequal({'a','b','c','d'},{'a';'b';'c';'d'}),false) +## test for equality (struct) +%!assert(isequal(struct('a',1,'b',2),struct('a',1,'b',2)),true) +%!assert(isequal(struct('a',1,'b',2),struct('a',1,'b',2),struct('a',1,'b',2)),true) +%!assert(isequal(struct('a','abc','b',2),struct('a','abc','b',2)),true) +## test for inequality (struct) +%!assert(isequal(struct('a',NaN,'b',2),struct('a',NaN,'b',2),struct('a',NaN,'b',2)),false) diff --git a/octave_packages/m/general/isequalwithequalnans.m b/octave_packages/m/general/isequalwithequalnans.m new file mode 100644 index 0000000..66710fe --- /dev/null +++ b/octave_packages/m/general/isequalwithequalnans.m @@ -0,0 +1,44 @@ +## Copyright (C) 2005-2012 William Poetra Yoga Hadisoeseno +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isequalwithequalnans (@var{x1}, @var{x2}, @dots{}) +## Assuming NaN == NaN, return true if all of @var{x1}, @var{x2}, @dots{} +## are equal. +## @seealso{isequal} +## @end deftypefn + +function retval = isequalwithequalnans (x1, varargin) + + if (nargin < 2) + print_usage (); + endif + + retval = __isequal__ (true, x1, varargin{:}); + +endfunction + +## test for equality +%!assert(isequalwithequalnans({1,2,NaN,4},{1,2,NaN,4}), true) +%!assert(isequalwithequalnans([1,2,NaN,4],[1,2,NaN,4]), true) +## test for inequality +%!assert(isequalwithequalnans([1,2,NaN,4],[1,NaN,3,4]),false) +%!assert(isequalwithequalnans([1,2,NaN,4],[1,2,3,4]),false) +## test for equality (struct) +%!assert(isequalwithequalnans(struct('a',NaN,'b',2),struct('a',NaN,'b',2),struct('a',NaN,'b',2)),true) +%!assert(isequalwithequalnans(1,2,1), false) diff --git a/octave_packages/m/general/isrow.m b/octave_packages/m/general/isrow.m new file mode 100644 index 0000000..522c75a --- /dev/null +++ b/octave_packages/m/general/isrow.m @@ -0,0 +1,56 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isrow (@var{x}) +## Return true if @var{x} is a row vector. +## @seealso{iscolumn, isscalar, isvector, ismatrix} +## @end deftypefn + +## Author: Rik Wehbring + +function retval = isrow (x) + + if (nargin != 1) + print_usage (); + endif + + sz = size (x); + retval = (ndims (x) == 2 && (sz(1) == 1)); + +endfunction + + +%!assert (isrow ([1, 2, 3])) +%!assert (isrow ([1; 2; 3]), false) +%!assert (isrow (1)) +%!assert (isrow ([]), false) +%!assert (isrow ([1, 2; 3, 4]), false) + +%!assert (isrow ("t")) +%!assert (isrow ("test")) +%!assert (isrow (["test"; "ing"]), false) + +%!test +%! s.a = 1; +%! assert (isrow (s)); + +%% Test input validation +%!error isrow () +%!error isrow ([1, 2], 2) + diff --git a/octave_packages/m/general/isscalar.m b/octave_packages/m/general/isscalar.m new file mode 100644 index 0000000..252587c --- /dev/null +++ b/octave_packages/m/general/isscalar.m @@ -0,0 +1,54 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isscalar (@var{x}) +## Return true if @var{x} is a scalar. +## @seealso{isvector, ismatrix} +## @end deftypefn + +## Author: jwe + +function retval = isscalar (x) + + if (nargin != 1) + print_usage (); + endif + + retval = numel (x) == 1; + +endfunction + + +%!assert (isscalar (1)) +%!assert (isscalar ([1, 2]), false) +%!assert (isscalar ([]), false) +%!assert (isscalar ([1, 2; 3, 4]), false) + +%!assert (isscalar ("t")) +%!assert (isscalar ("test"), false) +%!assert (isscalar (["test"; "ing"]), false) + +%!test +%! s.a = 1; +%! assert (isscalar (s)); + +%% Test input validation +%!error isscalar () +%!error isscalar (1, 2) + diff --git a/octave_packages/m/general/issquare.m b/octave_packages/m/general/issquare.m new file mode 100644 index 0000000..efb6110 --- /dev/null +++ b/octave_packages/m/general/issquare.m @@ -0,0 +1,62 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} issquare (@var{x}) +## Return true if @var{x} is a square matrix. +## @seealso{isscalar, isvector, ismatrix, size} +## @end deftypefn + +## Author: A. S. Hodel +## Created: August 1993 +## Adapted-By: jwe + +function retval = issquare (x) + + if (nargin != 1) + print_usage (); + endif + + if (ndims (x) == 2) + [r, c] = size (x); + retval = r == c; + else + retval = false; + endif + +endfunction + +%!assert(issquare ([])); +%!assert(issquare (1)); +%!assert(!(issquare ([1, 2]))); +%!assert(issquare ([1, 2; 3, 4])); +%!assert(!(issquare ([1, 2; 3, 4; 5, 6]))); +%!assert(!(issquare (ones (3,3,3)))); +%!assert(issquare ("t")); +%!assert(!(issquare ("test"))); +%!assert(issquare (["test"; "ing"; "1"; "2"])); +%!test +%! s.a = 1; +%! assert(issquare (s)); +%!assert(issquare ({1, 2; 3, 4})); +%!assert(sparse (([1, 2; 3, 4]))); + +%% Test input validation +%!error issquare (); +%!error issquare ([1, 2; 3, 4], 2); + diff --git a/octave_packages/m/general/isvector.m b/octave_packages/m/general/isvector.m new file mode 100644 index 0000000..9401b1a --- /dev/null +++ b/octave_packages/m/general/isvector.m @@ -0,0 +1,57 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isvector (@var{x}) +## Return true if @var{x} is a vector. A vector is a 2-D array +## where one of the dimensions is equal to 1. As a consequence a +## 1x1 array, or scalar, is also a vector. +## @seealso{isscalar, ismatrix, size, rows, columns, length} +## @end deftypefn + +## Author: jwe + +function retval = isvector (x) + + if (nargin != 1) + print_usage (); + endif + + sz = size (x); + retval = (ndims (x) == 2 && (sz(1) == 1 || sz(2) == 1)); + +endfunction + + +%!assert (isvector (1)) +%!assert (isvector ([1; 2; 3])) +%!assert (isvector ([]), false) +%!assert (isvector ([1, 2; 3, 4]), false) + +%!assert (isvector ("t")) +%!assert (isvector ("test")) +%!assert (isvector (["test"; "ing"]), false) + +%!test +%! s.a = 1; +%! assert (isvector (s)); + +%% Test input validation +%!error isvector () +%!error isvector ([1, 2], 2) + diff --git a/octave_packages/m/general/loadobj.m b/octave_packages/m/general/loadobj.m new file mode 100644 index 0000000..cfb04e2 --- /dev/null +++ b/octave_packages/m/general/loadobj.m @@ -0,0 +1,41 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{b} =} loadobj (@var{a}) +## Method of a class to manipulate an object after loading it from a file. +## The function @code{loadobj} is called when the object @var{a} is loaded +## using the @code{load} function. An example of the use of @code{saveobj} +## might be to add fields to an object that don't make sense to be saved. +## For example: +## +## @example +## @group +## function b = loadobj (a) +## b = a; +## b.addmissingfield = addfield (b); +## endfunction +## @end group +## @end example +## +## @seealso{saveobj, class} +## @end deftypefn + +function b = loadobj (a) + error ("loadobj: not defined for class \"%s\"", class(a)); +endfunction diff --git a/octave_packages/m/general/logspace.m b/octave_packages/m/general/logspace.m new file mode 100644 index 0000000..6462c93 --- /dev/null +++ b/octave_packages/m/general/logspace.m @@ -0,0 +1,99 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} logspace (@var{a}, @var{b}) +## @deftypefnx {Function File} {} logspace (@var{a}, @var{b}, @var{n}) +## @deftypefnx {Function File} {} logspace (@var{a}, pi, @var{n}) +## Return a row vector with @var{n} elements logarithmically spaced from +## @tex +## $10^{a}$ to $10^{b}$. +## @end tex +## @ifnottex +## 10^@var{a} to 10^@var{b}. +## @end ifnottex +## If @var{n} is unspecified it defaults to 50. +## +## If @var{b} is equal to +## @tex +## $\pi$, +## @end tex +## @ifnottex +## pi, +## @end ifnottex +## the points are between +## @tex +## $10^{a}$ and $\pi$, +## @end tex +## @ifnottex +## 10^@var{a} and pi, +## @end ifnottex +## @emph{not} +## @tex +## $10^{a}$ and $10^{\pi}$, +## @end tex +## @ifnottex +## 10^@var{a} and 10^pi, +## @end ifnottex +## in order to be compatible with the corresponding @sc{matlab} function. +## +## Also for compatibility with @sc{matlab}, return the second argument @var{b} +## if fewer than two values are requested. +## @seealso{linspace} +## @end deftypefn + +## Author: jwe + +function retval = logspace (base, limit, n = 50) + + if (nargin != 2 && nargin != 3) + print_usage (); + endif + + if (! (isscalar (base) && isscalar (limit) && isscalar (n))) + error ("logspace: arguments BASE, LIMIT, and N must be scalars"); + endif + + npoints = fix (n); + + if (limit == pi) + limit = log10 (pi); + endif + + retval = 10 .^ (linspace (base, limit, npoints)); + +endfunction + + +%!test +%! x1 = logspace (1, 2); +%! x2 = logspace (1, 2, 10.1); +%! x3 = logspace (1, -2, 10); +%! x4 = logspace (1, pi, 10); +%! assert (size (x1) == [1, 50] && x1(1) == 10 && x1(50) == 100); +%! assert (size (x2) == [1, 10] && x2(1) == 10 && x2(10) == 100); +%! assert (size (x3) == [1, 10] && x3(1) == 10 && x3(10) == 0.01); +%! assert (size (x4) == [1, 10] && x4(1) == 10 && abs (x4(10) - pi) < sqrt (eps)); + +%% Test input validation +%!error logspace (); +%!error logspace (1, 2, 3, 4); +%!error logspace ([1, 2; 3, 4], 5, 6); +%!error logspace (1, [1, 2; 3, 4], 6); +%!error logspace (1, 2, [1, 2; 3, 4]); + diff --git a/octave_packages/m/general/nargchk.m b/octave_packages/m/general/nargchk.m new file mode 100644 index 0000000..70709d3 --- /dev/null +++ b/octave_packages/m/general/nargchk.m @@ -0,0 +1,80 @@ +## Copyright (C) 2008-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{msgstr} =} nargchk (@var{minargs}, @var{maxargs}, @var{nargs}) +## @deftypefnx {Function File} {@var{msgstr} =} nargchk (@var{minargs}, @var{maxargs}, @var{nargs}, "string") +## @deftypefnx {Function File} {@var{msgstruct} =} nargchk (@var{minargs}, @var{maxargs}, @var{nargs}, "struct") +## Return an appropriate error message string (or structure) if the +## number of inputs requested is invalid. +## +## This is useful for checking to see that the number of input arguments +## supplied to a function is within an acceptable range. +## @seealso{nargoutchk, narginchk, error, nargin, nargout} +## @end deftypefn + +## Author: Bill Denney + +function msg = nargchk (minargs, maxargs, nargs, outtype = "string") + + if (nargin < 3 || nargin > 4) + print_usage (); + elseif (minargs > maxargs) + error ("nargchk: MINARGS must be <= MAXARGS"); + elseif (! any (strcmpi (outtype, {"string", "struct"}))) + error ('nargchk: output type must be either "string" or "struct"'); + elseif (! (isscalar (minargs) && isscalar (maxargs) && isscalar (nargs))) + error ("nargchk: MINARGS, MAXARGS, and NARGS must be scalars"); + endif + + msg = struct ("message", "", "identifier", ""); + if (nargs < minargs) + msg.message = "not enough input arguments"; + msg.identifier = "Octave:nargchk:not-enough-inputs"; + elseif (nargs > maxargs) + msg.message = "too many input arguments"; + msg.identifier = "Octave:nargchk:too-many-inputs"; + endif + + if (strcmpi (outtype, "string")) + msg = msg.message; + elseif (isempty (msg.message)) + ## Compatability: Matlab returns a 0x1 empty struct when nargchk passes + msg = resize (msg, 0, 1); + endif + +endfunction + + +## Tests +%!shared stnul, stmin, stmax +%! stnul = resize (struct ("message", "", "identifier", ""), 0, 1); +%! stmin = struct ("message", "not enough input arguments", +%! "identifier", "Octave:nargchk:not-enough-inputs"); +%! stmax = struct ("message", "too many input arguments", +%! "identifier", "Octave:nargchk:too-many-inputs"); +%!assert (nargchk (0, 1, 0), "") +%!assert (nargchk (0, 1, 1), "") +%!assert (nargchk (1, 1, 0), "not enough input arguments") +%!assert (nargchk (0, 1, 2), "too many input arguments") +%!assert (nargchk (0, 1, 2, "string"), "too many input arguments") +## Struct outputs +%!assert (isequal (nargchk (0, 1, 0, "struct"), stnul)) +%!assert (isequal (nargchk (0, 1, 1, "struct"), stnul)) +%!assert (nargchk (1, 1, 0, "struct"), stmin) +%!assert (nargchk (0, 1, 2, "struct"), stmax) diff --git a/octave_packages/m/general/narginchk.m b/octave_packages/m/general/narginchk.m new file mode 100644 index 0000000..0300389 --- /dev/null +++ b/octave_packages/m/general/narginchk.m @@ -0,0 +1,69 @@ +## Copyright (C) 2012 Carnë Draug +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} narginchk (@var{minargs}, @var{maxargs}) +## Check for correct number of arguments or generate an error message if +## the number of arguments in the calling function is outside the range +## @var{minargs} and @var{maxargs}. Otherwise, do nothing. +## +## Both @var{minargs} and @var{maxargs} need to be scalar numeric +## values. Zero, Inf and negative values are all allowed, and +## @var{minargs} and @var{maxargs} may be equal. +## +## Note that this function evaluates @code{nargin} on the caller. +## +## @seealso{nargchk, nargoutchk, error, nargout, nargin} +## @end deftypefn + +## Author: Carnë Draug + +function narginchk (minargs, maxargs) + + if (nargin != 2) + print_usage; + elseif (!isnumeric (minargs) || !isscalar (minargs)) + error ("minargs must be a numeric scalar"); + elseif (!isnumeric (maxargs) || !isscalar (maxargs)) + error ("maxargs must be a numeric scalar"); + elseif (minargs > maxargs) + error ("minargs cannot be larger than maxargs") + endif + + args = evalin ("caller", "nargin;"); + + if (args < minargs) + error ("not enough input arguments"); + elseif (args > maxargs) + error ("too many input arguments"); + endif + +endfunction + +%!function f (nargs, varargin) +%! narginchk (nargs(1), nargs(2)); +%!endfunction + +%!error f([0,0]) +%!error f([3, 3], 1) + +%!test +%! f([1,1]) + +%!test +%! f([1,5], 2, 3, 4, 5) diff --git a/octave_packages/m/general/nargoutchk.m b/octave_packages/m/general/nargoutchk.m new file mode 100644 index 0000000..7a62e39 --- /dev/null +++ b/octave_packages/m/general/nargoutchk.m @@ -0,0 +1,124 @@ +## Copyright (C) 2008-2012 Bill Denney +## Copyright (C) 2012 Carnë Draug +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nargoutchk (@var{minargs}, @var{maxargs}) +## @deftypefnx {Function File} {@var{msgstr} =} nargoutchk (@var{minargs}, @var{maxargs}, @var{nargs}) +## @deftypefnx {Function File} {@var{msgstr} =} nargoutchk (@var{minargs}, @var{maxargs}, @var{nargs}, "string") +## @deftypefnx {Function File} {@var{msgstruct} =} nargoutchk (@var{minargs}, @var{maxargs}, @var{nargs}, "struct") +## Check for correct number of output arguments. +## +## On the first form, returns an error unless the number of arguments in its +## caller is between the values of @var{minargs} and @var{maxargs}. It does +## nothing otherwise. Note that this function evaluates the value of +## @code{nargout} on the caller so its value must have not been tampered with. +## +## Both @var{minargs} and @var{maxargs} need to be a numeric scalar. Zero, Inf +## and negative are all valid, and they can have the same value. +## +## For backward compatibility reasons, the other forms return an appropriate +## error message string (or structure) if the number of outputs requested is +## invalid. +## +## This is useful for checking to see that the number of output +## arguments supplied to a function is within an acceptable range. +## @seealso{nargchk, narginchk, error, nargout, nargin} +## @end deftypefn + +## Author: Bill Denney +## Author: Carnë Draug + +function msg = nargoutchk (minargs, maxargs, nargs, outtype) + + ## before matlab's 2011b, nargoutchk would return an error message (just the + ## message in a string). With 2011b, it no longer returns anything, it simply + ## gives an error if the args number is incorrect. + ## To try to keep compatibility with both versions, check nargout and nargin + ## to guess if the caller is expecting a value (old syntax) or none (new syntax) + + if (nargout == 1 && (nargin == 3 || nargin == 4)) + + if (minargs > maxargs) + error ("nargoutchk: MINARGS must be <= MAXARGS"); + elseif (nargin == 3) + outtype = "string"; + elseif (! any (strcmpi (outtype, {"string" "struct"}))) + error ("nargoutchk: output type must be either string or struct"); + elseif (! (isscalar (minargs) && isscalar (maxargs) && isscalar (nargs))) + error ("nargoutchk: MINARGS, MAXARGS, and NARGS must be scalars"); + endif + + msg = struct ("message", "", "identifier", ""); + if (nargs < minargs) + msg.message = "not enough output arguments"; + msg.identifier = "Octave:nargoutchk:not-enough-outputs"; + elseif (nargs > maxargs) + msg.message = "too many output arguments"; + msg.identifier = "Octave:nargoutchk:too-many-outputs"; + endif + + if (strcmpi (outtype, "string")) + msg = msg.message; + elseif (isempty (msg.message)) + ## Compatability: Matlab returns a 0x1 empty struct when nargchk passes + msg = resize (msg, 0, 1); + endif + + elseif (nargout == 0 && nargin == 2) + + if (!isnumeric (minargs) || !isscalar (minargs)) + error ("minargs must be a numeric scalar"); + elseif (!isnumeric (maxargs) || !isscalar (maxargs)) + error ("maxargs must be a numeric scalar"); + elseif (minargs > maxargs) + error ("minargs cannot be larger than maxargs") + endif + + args = evalin ("caller", "nargout;"); + + if (args < minargs) + error ("Not enough output arguments."); + elseif (args > maxargs) + error ("Too many output arguments."); + endif + + else + print_usage; + endif + +endfunction + +## Tests +%!shared stnul, stmin, stmax +%! stnul = resize (struct ("message", "", "identifier", ""), 0, 1); +%! stmin = struct ("message", "not enough output arguments", +%! "identifier", "Octave:nargoutchk:not-enough-outputs"); +%! stmax = struct ("message", "too many output arguments", +%! "identifier", "Octave:nargoutchk:too-many-outputs"); +%!assert (nargoutchk (0, 1, 0), "") +%!assert (nargoutchk (0, 1, 1), "") +%!assert (nargoutchk (1, 1, 0), "not enough output arguments") +%!assert (nargoutchk (0, 1, 2), "too many output arguments") +%!assert (nargoutchk (0, 1, 2, "string"), "too many output arguments") +## Struct outputs +%!assert (isequal (nargoutchk (0, 1, 0, "struct"), stnul)) +%!assert (isequal (nargoutchk (0, 1, 1, "struct"), stnul)) +%!assert (nargoutchk (1, 1, 0, "struct"), stmin) +%!assert (nargoutchk (0, 1, 2, "struct"), stmax) + diff --git a/octave_packages/m/general/nextpow2.m b/octave_packages/m/general/nextpow2.m new file mode 100644 index 0000000..3d5475d --- /dev/null +++ b/octave_packages/m/general/nextpow2.m @@ -0,0 +1,68 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nextpow2 (@var{x}) +## If @var{x} is a scalar, return the first integer @var{n} such that +## @tex +## $2^n \ge |x|$. +## @end tex +## @ifnottex +## 2^n @geq{} abs (x). +## @end ifnottex +## +## If @var{x} is a vector, return @code{nextpow2 (length (@var{x}))}. +## @seealso{pow2, log2} +## @end deftypefn + +## Author: KH +## Created: 7 October 1994 +## Adapted-By: jwe + +function n = nextpow2 (x) + + if (nargin != 1) + print_usage (); + endif + + if (! (isscalar (x) || isvector (x))) + error ("nextpow2: X must be a scalar or a vector"); + endif + + t = length (x); + if (t > 1) + x = t; + endif + + [f, n] = log2 (abs (x)); + if (f == 0.5) + n = n - 1; + endif + +endfunction + +%!error nexpow2 (); +%!error nexpow2 (1, 2); + +%!assert (nextpow2 (16), 4); +%!assert (nextpow2 (17), 5); +%!assert (nextpow2 (31), 5); +%!assert (nextpow2 (-16), 4); +%!assert (nextpow2 (-17), 5); +%!assert (nextpow2 (-31), 5); +%!assert (nextpow2 (1:17), 5); diff --git a/octave_packages/m/general/nthargout.m b/octave_packages/m/general/nthargout.m new file mode 100644 index 0000000..8862e6c --- /dev/null +++ b/octave_packages/m/general/nthargout.m @@ -0,0 +1,113 @@ +## Copyright (C) 2012 Jordi Gutiérrez Hermoso +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nthargout (@var{n}, @var{func}, @dots{}) +## @deftypefnx {Function File} {} nthargout (@var{n}, @var{ntot}, @var{func}, @dots{}) +## Return the @var{n}th output argument of function given by the +## function handle or string @var{func}. Any arguments after @var{func} +## are passed to @var{func}. The total number of arguments to call +## @var{func} with can be passed in @var{ntot}; by default @var{ntot} +## is @var{n}. The input @var{n} can also be a vector of indices of the +## output, in which case the output will be a cell array of the +## requested output arguments. +## +## The intended use @code{nthargout} is to avoid intermediate variables. +## For example, when finding the indices of the maximum entry of a +## matrix, the following two compositions of nthargout +## +## @example +## @group +## @var{m} = magic (5); +## cell2mat (nthargout ([1, 2], @@ind2sub, size(@var{m}), +## nthargout (2, @@max, @var{m}(:)))) +## @result{} 5 3 +## @end group +## @end example +## +## @noindent +## are completely equivalent to the following lines: +## +## @example +## @group +## @var{m} = magic(5); +## [~, idx] = max (@var{M}(:)); +## [i, j] = ind2sub (size (@var{m}), idx); +## [i, j] +## @result{} 5 3 +## @end group +## @end example +## +## It can also be helpful to have all output arguments in a single cell +## in the following manner: +## +## @example +## @var{USV} = nthargout ([1:3], @@svd, hilb (5)); +## @end example +## +## @seealso{nargin, nargout, varargin, varargout, isargout} +## @end deftypefn + +## Author: Jordi Gutiérrez Hermoso + +function out = nthargout (n, varargin) + if (nargin < 2) + print_usage (); + endif + + if (isa (varargin{1}, "function_handle") || ischar (varargin{1})) + ntot = max (n(:)); + func = varargin{1}; + args = varargin(2:end); + elseif (isnumeric (varargin{1}) + && (isa (varargin{2}, "function_handle") || ischar (varargin{2}))) + ntot = varargin{1}; + func = varargin{2}; + args = varargin(3:end); + else + print_usage (); + endif + + if (any (n != fix (n)) || ntot != fix (ntot) || any (n <= 0) || ntot <= 0) + error ("nthargout: N and NTOT must consist of positive integers") + endif + + outargs = cell (1, ntot); + + try + [outargs{:}] = feval (func, args{:}); + if (numel (n) > 1) + out = outargs(n); + else + out = outargs{n}; + endif + catch + err = lasterr (); + if (strfind ("some elements undefined in return list", err)) + error ("nthargout: Too many output arguments: %d", ntot); + else + error (err); + endif + end_try_catch + +endfunction + +%!shared m +%! m = magic (5); +%!assert (nthargout ([1, 2], @ind2sub, size(m), nthargout (2, @max, m(:))), {5,3}) +%!assert (nthargout (3, @find, m(m>20)), [23, 24, 25, 21, 22]') diff --git a/octave_packages/m/general/num2str.m b/octave_packages/m/general/num2str.m new file mode 100644 index 0000000..8c46782 --- /dev/null +++ b/octave_packages/m/general/num2str.m @@ -0,0 +1,186 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} num2str (@var{x}) +## @deftypefnx {Function File} {} num2str (@var{x}, @var{precision}) +## @deftypefnx {Function File} {} num2str (@var{x}, @var{format}) +## Convert a number (or array) to a string (or a character array). The +## optional second argument may either give the number of significant +## digits (@var{precision}) to be used in the output or a format +## template string (@var{format}) as in @code{sprintf} (@pxref{Formatted +## Output}). @code{num2str} can also handle complex numbers. For +## example: +## +## @example +## @group +## num2str (123.456) +## @result{} "123.46" +## +## num2str (123.456, 4) +## @result{} "123.5" +## +## s = num2str ([1, 1.34; 3, 3.56], "%5.1f") +## @result{} s = +## 1.0 1.3 +## 3.0 3.6 +## whos s +## @result{} +## Attr Name Size Bytes Class +## ==== ==== ==== ===== ===== +## s 2x8 16 char +## +## num2str (1.234 + 27.3i) +## @result{} "1.234+27.3i" +## @end group +## @end example +## +## The @code{num2str} function is not very flexible. For better control +## over the results, use @code{sprintf} (@pxref{Formatted Output}). +## Note that for complex @var{x}, the format string may only contain one +## output conversion specification and nothing else. Otherwise, you +## will get unpredictable results. +## @seealso{sprintf, int2str, mat2str} +## @end deftypefn + +## Author: jwe + +function retval = num2str (x, arg) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (ischar (x)) + retval = x; + elseif (isempty (x)) + retval = ""; + elseif (iscomplex (x)) + if (nargin == 2) + if (ischar (arg)) + fmt = cstrcat (arg, "%-+", arg(2:end), "i"); + else + if (isnumeric (x) && x == fix (x) && abs (x) < (10 .^ arg)) + fmt = sprintf ("%%%dd%%-+%ddi ", arg, arg); + else + fmt = sprintf ("%%%d.%dg%%-+%d.%dgi", arg+7, arg, arg+7, arg); + endif + endif + else + ## Setup a suitable format string + if (isnumeric (x) && x == fix (x) && abs (x) < 1e10) + if (max (abs (real (x(:)))) == 0) + dgt1 = 2; + else + dgt1 = ceil (log10 (max (max (abs (real (x(:)))), + max (abs (imag (x(:))))))) + 2; + endif + dgt2 = dgt1 - (min (real (x(:))) >= 0); + + if (length (abs (x) == x) > 0) + fmt = sprintf("%%%dg%%+-%dgi ", dgt2, dgt1); + else + fmt = sprintf("%%%dd%%+-%ddi ", dgt2, dgt1); + endif + elseif (isscalar (x)) + fmt = "%.6g%-+.6gi"; + else + fmt = "%11.6g%-+11.6gi"; + endif + endif + + ## Manipulate the complex value to have real values in the odd + ## columns and imaginary values in the even columns. + sz = size (x); + nc = sz(2); + nd = ndims (x); + perm = fix ([1:0.5:nc+0.5]); + perm(2:2:2*nc) = perm(2:2:2*nc) + nc; + idx = repmat ({':'}, nd, 1); + idx{2} = perm; + x = horzcat (real (x), imag (x)); + x = x(idx{:}); + + fmt = cstrcat (deblank (repmat (fmt, 1, nc)), "\n"); + tmp = sprintf (fmt, permute (x, [2, 1, 3:nd])); + + ## Put the "i"'s where they are supposed to be. + while (true) + tmp2 = strrep (tmp, " i\n", "i\n"); + if (length (tmp) == length (tmp2)) + break; + else + tmp = tmp2; + endif + endwhile + while (true) + tmp2 = strrep (tmp, " i", "i "); + if (tmp == tmp2) + break; + else + tmp = tmp2; + endif + endwhile + + tmp(length (tmp)) = ""; + retval = char (strtrim (strsplit (tmp, "\n"))); + else + if (nargin == 2) + if (ischar (arg)) + fmt = arg; + else + if (isnumeric (x) && x == fix (x) && abs (x) < (10 .^ arg)) + fmt = sprintf ("%%%dd ", arg); + else + fmt = sprintf ("%%%d.%dg", arg+7, arg); + endif + endif + else + if (isnumeric (x) && x == fix (x) && abs (x) < 1e10) + if (max (abs (x(:))) == 0) + dgt = 2; + else + dgt = floor (log10 (max (abs(x(:))))) + (min (real (x(:))) < 0) + 2; + endif + if (length (abs (x) == x) > 0) + fmt = sprintf ("%%%dg ", dgt); + else + fmt = sprintf ("%%%dd ", dgt); + endif + elseif (isscalar (x)) + fmt = "%11.5g"; + else + fmt = "%11.5g"; + endif + endif + fmt = cstrcat (deblank (repmat (fmt, 1, columns (x))), "\n"); + nd = ndims (x); + tmp = sprintf (fmt, permute (x, [2, 1, 3:nd])); + tmp(length (tmp)) = ""; + retval = strtrim (char (strsplit (tmp, "\n"))); + endif + +endfunction + +%!assert ((strcmp (num2str (123), "123") && strcmp (num2str (1.23), "1.23"))); +%!assert (num2str (123.456, 4), "123.5"); +%!assert (all (num2str ([1, 1.34; 3, 3.56], "%5.1f") == ["1.0 1.3"; "3.0 3.6"])); +%!assert (num2str (1.234 + 27.3i), "1.234+27.3i"); +%!error num2str (); +%!error num2str (1, 2, 3); + diff --git a/octave_packages/m/general/pol2cart.m b/octave_packages/m/general/pol2cart.m new file mode 100644 index 0000000..587d185 --- /dev/null +++ b/octave_packages/m/general/pol2cart.m @@ -0,0 +1,142 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{y}] =} pol2cart (@var{theta}, @var{r}) +## @deftypefnx {Function File} {[@var{x}, @var{y}, @var{z}] =} pol2cart (@var{theta}, @var{r}, @var{z}) +## @deftypefnx {Function File} {[@var{x}, @var{y}] =} pol2cart (@var{p}) +## @deftypefnx {Function File} {[@var{x}, @var{y}, @var{z}] =} pol2cart (@var{p}) +## @deftypefnx {Function File} {@var{C} =} pol2cart (@dots{}) +## Transform polar or cylindrical to Cartesian coordinates. +## +## @var{theta}, @var{r}, (and @var{z}) must be the same shape, or scalar. +## @var{theta} describes the angle relative to the positive x-axis. +## @var{r} is the distance to the z-axis (0, 0, z). +## If called with a single matrix argument then each row of @var{p} +## represents the polar/(cylindrical) coordinate (@var{x}, @var{y} (, @var{z})). +## +## If only a single return argument is requested then return a matrix +## @var{C} where each row represents one Cartesian coordinate +## (@var{x}, @var{y} (, @var{z})). +## @seealso{cart2pol, sph2cart, cart2sph} +## @end deftypefn + +## Author: Kai Habel +## Adapted-by: jwe + +function [x, y, z] = pol2cart (theta, r, z) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (nargin == 1) + if (ismatrix (theta) && (columns (theta) == 2 || columns (theta) == 3)) + if (columns (theta) == 3) + z = theta(:,3); + else + z = []; + endif + r = theta(:,2); + theta = theta(:,1); + else + error ("pol2car: matrix input must have 2 or 3 columns [THETA, R (, Z)]"); + endif + elseif (nargin == 2) + if (! ((ismatrix (theta) && ismatrix (r)) + && (size_equal (theta, r) || isscalar (theta) || isscalar (r)))) + error ("pol2cart: arguments must be matrices of same size, or scalar"); + endif + elseif (nargin == 3) + if (! ((ismatrix (theta) && ismatrix (r) && ismatrix (z)) + && (size_equal (theta, r) || isscalar (theta) || isscalar (r)) + && (size_equal (theta, z) || isscalar (theta) || isscalar (z)) + && (size_equal (r, z) || isscalar (r) || isscalar (z)))) + error ("pol2cart: arguments must be matrices of same size, or scalar"); + endif + endif + + x = r .* cos (theta); + y = r .* sin (theta); + + if (nargout <= 1) + x = [x, y, z]; + endif + +endfunction + +%!test +%! t = [0, 0.5, 1] * pi; +%! r = 1; +%! [x, y] = pol2cart (t, r); +%! assert (x, [1, 0, -1], sqrt(eps)); +%! assert (y, [0, 1, 0], sqrt(eps)); + +%!test +%! t = [0, 1, 1] * pi/4; +%! r = sqrt(2) * [0, 1, 2]; +%! [x, y] = pol2cart (t, r); +%! assert (x, [0, 1, 2], sqrt(eps)); +%! assert (y, [0, 1, 2], sqrt(eps)); + +%!test +%! t = [0, 1, 1] * pi/4; +%! r = sqrt(2) * [0, 1, 2]; +%! z = [0, 1, 2]; +%! [x, y, z2] = pol2cart (t, r, z); +%! assert (x, [0, 1, 2], sqrt(eps)); +%! assert (y, [0, 1, 2], sqrt(eps)); +%! assert (z, z2); + +%!test +%! t = 0; +%! r = [0, 1, 2]; +%! z = [0, 1, 2]; +%! [x, y, z2] = pol2cart (t, r, z); +%! assert (x, [0, 1, 2], sqrt(eps)); +%! assert (y, [0, 0, 0], sqrt(eps)); +%! assert (z, z2); + +%!test +%! t = [1, 1, 1]*pi/4; +%! r = 1; +%! z = [0, 1, 2]; +%! [x, y, z2] = pol2cart (t, r, z); +%! assert (x, [1, 1, 1] / sqrt(2), eps); +%! assert (y, [1, 1, 1] / sqrt(2), eps); +%! assert (z, z2); + +%!test +%! t = 0; +%! r = [1, 2, 3]; +%! z = 1; +%! [x, y, z2] = pol2cart (t, r, z); +%! assert (x, [1, 2, 3], eps); +%! assert (y, [0, 0, 0] / sqrt(2), eps); +%! assert (z, z2); + +%!test +%! P = [0, 0; pi/4, sqrt(2); pi/4, 2*sqrt(2)]; +%! C = [0, 0; 1, 1; 2, 2]; +%! assert (pol2cart(P), C, sqrt(eps)); + +%!test +%! P = [0, 0, 0; pi/4, sqrt(2), 1; pi/4, 2*sqrt(2), 2]; +%! C = [0, 0, 0; 1, 1, 1; 2, 2, 2]; +%! assert (pol2cart(P), C, sqrt(eps)); + diff --git a/octave_packages/m/general/polyarea.m b/octave_packages/m/general/polyarea.m new file mode 100644 index 0000000..7b04a6d --- /dev/null +++ b/octave_packages/m/general/polyarea.m @@ -0,0 +1,70 @@ +## Copyright (C) 1999-2012 David M. Doolin +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polyarea (@var{x}, @var{y}) +## @deftypefnx {Function File} {} polyarea (@var{x}, @var{y}, @var{dim}) +## +## Determine area of a polygon by triangle method. The variables +## @var{x} and @var{y} define the vertex pairs, and must therefore have +## the same shape. They can be either vectors or arrays. If they are +## arrays then the columns of @var{x} and @var{y} are treated separately +## and an area returned for each. +## +## If the optional @var{dim} argument is given, then @code{polyarea} +## works along this dimension of the arrays @var{x} and @var{y}. +## +## @end deftypefn + +## todo: Add moments for centroid, etc. +## +## bugs and limitations: +## Probably ought to be an optional check to make sure that +## traversing the vertices doesn't make any sides cross +## (Is simple closed curve the technical definition of this?). + +## Author: David M. Doolin +## Date: 1999-04-14 +## Modified-by: +## 2000-01-15 Paul Kienzle +## * use matlab compatible interface +## * return absolute value of area so traversal order doesn't matter +## 2005-10-13 Torsten Finke +## * optimization saving half the sums and multiplies + +function a = polyarea (x, y, dim) + if (nargin != 2 && nargin != 3) + print_usage (); + elseif (size_equal (x, y)) + if (nargin == 2) + a = abs (sum (x .* (shift (y, -1) - shift (y, 1)))) / 2; + else + a = abs (sum (x .* (shift (y, -1, dim) - shift (y, 1, dim)), dim)) / 2; + endif + else + error ("polyarea: X and Y must have the same shape"); + endif +endfunction + +%!shared x, y +%! x = [1;1;3;3;1]; +%! y = [1;3;3;1;1]; +%!assert (polyarea(x,y), 4, eps) +%!assert (polyarea([x,x],[y,y]), [4,4], eps) +%!assert (polyarea([x,x],[y,y],1), [4,4], eps) +%!assert (polyarea([x,x]',[y,y]',2), [4;4], eps) diff --git a/octave_packages/m/general/postpad.m b/octave_packages/m/general/postpad.m new file mode 100644 index 0000000..580cb3d --- /dev/null +++ b/octave_packages/m/general/postpad.m @@ -0,0 +1,97 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} postpad (@var{x}, @var{l}) +## @deftypefnx {Function File} {} postpad (@var{x}, @var{l}, @var{c}) +## @deftypefnx {Function File} {} postpad (@var{x}, @var{l}, @var{c}, @var{dim}) +## Append the scalar value @var{c} to the vector @var{x} until it is of length +## @var{l}. If @var{c} is not given, a value of 0 is used. +## +## If @code{length (@var{x}) > @var{l}}, elements from the end of +## @var{x} are removed until a vector of length @var{l} is obtained. +## +## If @var{x} is a matrix, elements are appended or removed from each row. +## +## If the optional argument @var{dim} is given, operate along this +## dimension. +## @seealso{prepad, cat, resize} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 + +function y = postpad (x, l, c, dim) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (nargin < 3 || isempty (c)) + c = 0; + else + if (! isscalar (c)) + error ("postpad: third argument must be empty or a scalar"); + endif + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 4) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("postpad: DIM must be an integer and a valid dimension"); + endif + endif + + if (! isscalar (l) || l < 0) + error ("postpad: second argument must be a positive scaler"); + endif + + if (dim > nd) + sz(nd+1:dim) = 1; + endif + + d = sz (dim); + + if (d >= l) + idx = repmat ({':'}, nd, 1); + idx{dim} = 1:l; + y = x(idx{:}); + else + sz (dim) = l - d; + y = cat (dim, x, c * ones (sz)); + endif + +endfunction + +%!error postpad (); +%!error postpad (1); +%!error postpad (1,2,3,4,5); +%!error postpad ([1,2], 2, 2,3); + +%!assert (postpad ([1,2], 4), [1,2,0,0]); +%!assert (postpad ([1;2], 4), [1;2;0;0]); + +%!assert (postpad ([1,2], 4, 2), [1,2,2,2]); +%!assert (postpad ([1;2], 4, 2), [1;2;2;2]); + +%!assert (postpad ([1,2], 2, 2, 1), [1,2;2,2]); diff --git a/octave_packages/m/general/prepad.m b/octave_packages/m/general/prepad.m new file mode 100644 index 0000000..aeae2bf --- /dev/null +++ b/octave_packages/m/general/prepad.m @@ -0,0 +1,99 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} prepad (@var{x}, @var{l}) +## @deftypefnx {Function File} {} prepad (@var{x}, @var{l}, @var{c}) +## @deftypefnx {Function File} {} prepad (@var{x}, @var{l}, @var{c}, @var{dim}) +## Prepend the scalar value @var{c} to the vector @var{x} until it is of length +## @var{l}. If @var{c} is not given, a value of 0 is used. +## +## If @code{length (@var{x}) > @var{l}}, elements from the beginning of +## @var{x} are removed until a vector of length @var{l} is obtained. +## +## If @var{x} is a matrix, elements are prepended or removed from each row. +## +## If the optional argument @var{dim} is given, operate along this +## dimension. +## @seealso{postpad, cat, resize} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 + +function y = prepad (x, l, c, dim) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (nargin < 3 || isempty (c)) + c = 0; + else + if (! isscalar (c)) + error ("prepad: third argument must be empty or a scalar"); + endif + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 4) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("prepad: DIM must be an integer and a valid dimension"); + endif + endif + + if (! isscalar (l) || l < 0) + error ("prepad: second argument must be a positive scaler"); + endif + + if (dim > nd) + sz(nd+1:dim) = 1; + endif + + d = sz (dim); + + if (d >= l) + idx = repmat ({':'}, nd, 1); + idx{dim} = d-l+1:d; + y = x(idx{:}); + else + sz (dim) = l - d; + y = cat (dim, c * ones (sz), x); + endif + +endfunction + +%!error prepad (); +%!error prepad (1); +%!error prepad (1,2,3,4,5); +%!error prepad ([1,2], 2, 2,3); + +%!assert (prepad ([1,2], 4), [0,0,1,2]); +%!assert (prepad ([1;2], 4), [0;0;1;2]); + +%!assert (prepad ([1,2], 4, 2), [2,2,1,2]); +%!assert (prepad ([1;2], 4, 2), [2;2;1;2]); + +%!assert (prepad ([1,2], 2, 2, 1), [2,2;1,2]); + +## FIXME -- we need tests for multidimensional arrays. diff --git a/octave_packages/m/general/private/__isequal__.m b/octave_packages/m/general/private/__isequal__.m new file mode 100644 index 0000000..c29e6d9 --- /dev/null +++ b/octave_packages/m/general/private/__isequal__.m @@ -0,0 +1,182 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## Undocumented internal function. + +## -*- texinfo -*- +## @deftypefn {Function File} {} __isequal__ (@var{nans_compare_equal}, @var{x1}, @var{x2}, @dots{}) +## Undocumented internal function. +## @end deftypefn + +## Return true if @var{x1}, @var{x2}, @dots{} are all equal and +## @var{nans_compare_equal} evaluates to false. +## +## If @var{nans_compare_equal} evaluates to true, then assume NaN == NaN. + +## Modified by: William Poetra Yoga Hadisoeseno + +## Algorithm: +## +## 1. Determine the class of x +## 2. If x is of the struct, cell, list or char class, for each +## argument after x, determine whether it has the same class +## and size as x. +## Otherwise, for each argument after x, verify that it is not +## of the struct, cell, list or char class, and that it has +## the same size as x. +## 3. For each argument after x, compare it for equality with x: +## a. struct compare each member by name, not by order (recursive) +## b. cell/list compare each member by order (recursive) +## c. char compare each member with strcmp +## d. compare each nonzero member, and assume NaN == NaN +## if nans_compare_equal is nonzero. + +function t = __isequal__ (nans_compare_equal, x, varargin) + + if (nargin < 3) + print_usage (); + endif + + l_v = nargin - 2; + + ## Generic tests. + + ## All arguments must either be of the same class or they must be + ## numeric values. + t = (all (strcmp (class(x), + cellfun ("class", varargin, "uniformoutput", false))) + || ((isnumeric (x) || islogical (x)) + && all (cellfun ("isnumeric", varargin) + | cellfun ("islogical", varargin)))); + + if (t) + ## Test that everything has the same number of dimensions. + s_x = size (x); + s_v = cellfun (@size, varargin, "uniformoutput", false); + t = all (length (s_x) == cellfun ("length", s_v)); + endif + + if (t) + ## Test that everything is the same size since it has the same + ## dimensionality. + l_x = length (s_x); + s_v = reshape ([s_v{:}], length (s_x), []); + idx = 0; + while (t && idx < l_x) + idx++; + t = all (s_x(idx) == s_v(idx,:)); + endwhile + endif + + ## From here on, compare objects as if they were structures. + if (isobject (x)) + x = builtin ("struct", x); + varargin = cellfun (@(x) builtin ("struct", x), varargin, + "uniformoutput", false); + endif + + if (t) + ## Check individual classes. + if (isstruct (x)) + ## Test the number of fields. + fn_x = fieldnames (x); + l_fn_x = length (fn_x); + fn_v = cellfun ("fieldnames", varargin, "uniformoutput", false); + t = all (l_fn_x == cellfun ("length", fn_v)); + + ## Test that all the names are equal. + idx = 0; + s_fn_x = sort (fn_x); + while (t && idx < l_v) + idx++; + ## We'll allow the fieldnames to be in a different order. + t = all (strcmp (s_fn_x, sort (fn_v{idx}))); + endwhile + + idx = 0; + while (t && idx < l_fn_x) + ## Test that all field values are equal. + idx++; + args = {nans_compare_equal, {x.(fn_x{idx})}}; + for argn = 1:l_v + args{argn+2} = {varargin{argn}.(fn_x{idx})}; + endfor + ## Minimize function calls by calling for all the arguments at + ## once. + t = __isequal__ (args{:}); + endwhile + + elseif (iscell (x)) + ## Check that each element of a cell is equal. + l_x = numel (x); + idx = 0; + while (t && idx < l_x) + idx++; + args = {nans_compare_equal, x{idx}}; + for p = 1:l_v + args{p+2} = varargin{p}{idx}; + endfor + t = __isequal__ (args{:}); + endwhile + + elseif (ischar (x)) + + ## Sizes are equal already, so we can just make everything into a + ## row and test the rows. + for i = 1:l_v + strings{i} = reshape (varargin{i}, 1, []); + endfor + t = all (strcmp (reshape (x, 1, []), strings)); + + elseif (isa (x, "function_handle")) + + ## The == operator is overloaded for handles. + t = all (cellfun ("eq", {x}, varargin)); + + else + ## Check the numeric types. + + f_x = find (x); + l_f_x = length (f_x); + x = x(f_x); + for argn = 1:l_v + y = varargin{argn}; + f_y = find (y); + + t = (l_f_x == length (f_y)) && all (f_x == f_y); + if (!t) + return; + endif + + y = y(f_y); + m = (x == y); + t = all (m); + + if (!t && nans_compare_equal) + t = isnan (x(!m)) && isnan (y(!m)); + endif + + if (!t) + return; + endif + endfor + + endif + endif + +endfunction diff --git a/octave_packages/m/general/private/__splinen__.m b/octave_packages/m/general/private/__splinen__.m new file mode 100644 index 0000000..6e1e30d --- /dev/null +++ b/octave_packages/m/general/private/__splinen__.m @@ -0,0 +1,49 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## Undocumented internal function. + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{yi} =} __splinen__ (@var{x}, @var{y}, @var{xi}) +## Undocumented internal function. +## @end deftypefn + +## FIXME: Allow arbitrary grids.. + +function yi = __splinen__ (x, y, xi, extrapval, f) + if (nargin != 5) + error ("__splinen__: Incorrect number of arguments"); + endif + ## ND isvector function. + isvec = @(x) numel (x) == length (x); + if (!iscell (x) || length(x) < ndims(y) || any (! cellfun (isvec, x)) + || !iscell (xi) || length(xi) < ndims(y) || any (! cellfun (isvec, xi))) + error ("__splinen__: %s: non gridded data or dimensions inconsistent", f); + endif + yi = y; + for i = length(x):-1:1 + yi = permute (spline (x{i}, yi, xi{i}(:)), [length(x),1:length(x)-1]); + endfor + + [xi{:}] = ndgrid (cellfun (@(x) x(:), xi, "uniformoutput", false){:}); + idx = zeros (size(xi{1})); + for i = 1 : length(x) + idx |= xi{i} < min (x{i}(:)) | xi{i} > max (x{i}(:)); + endfor + yi(idx) = extrapval; +endfunction diff --git a/octave_packages/m/general/profexplore.m b/octave_packages/m/general/profexplore.m new file mode 100644 index 0000000..2255ca6 --- /dev/null +++ b/octave_packages/m/general/profexplore.m @@ -0,0 +1,132 @@ +## Copyright (C) 2012 Daniel Kraft +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} profexplore (@var{data}) +## Interactively explore hierarchical profiler output. +## +## Assuming @var{data} is the structure with profile data returned by +## @code{profile ('info')}, this command opens an interactive prompt +## that can be used to explore the call-tree. Type @kbd{help} to get a list +## of possible commands. +## @seealso{profile, profshow} +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft + +function profexplore (data) + + if (nargin ~= 1) + print_usage (); + endif + + ## The actual work is done by a recursive worker function, since that + ## is an easy way to traverse the tree datastructure. Here, we just check + ## the arguments (already done) and give over to it. + + __profexplore_worker (data.FunctionTable, data.Hierarchical, "Top\n", " "); + +endfunction + +## This is the worker function. tree is the current subtree we want to +## display / explore. parents is a string containing the already 'rendered' +## data for the parents which is displayed on top of the list of current +## children. prefix is the prefix to add to each line rendered; this +## is just a string of spaces to get indentation right. +## +## Returning 0 indicates that the user requested to totally exit the +## explorer, thus also all higher levels should exit immediately. An integer +## greater zero indicates to exit that many levels since the user wants to go +## up (but not necessarily quit). + +function rv = __profexplore_worker (fcn_table, tree, parents, prefix) + + ## Sort children by total time. + times = -[ tree.TotalTime ]; + [~, p] = sort (times); + tree = tree(p); + + while (true) + + printf ("\n%s", parents); + strings = cell (length (tree), 1); + for i = 1 : length (tree) + strings{i} = sprintf ("%s: %d calls, %.3f total, %.3f self", ... + fcn_table(tree(i).Index).FunctionName, ... + tree(i).NumCalls, ... + tree(i).TotalTime, tree(i).SelfTime); + printf ("%s%d) %s\n", prefix, i, strings{i}); + endfor + printf ("\n"); + + cmd = input ("profexplore> ", "s"); + option = fix (str2double (cmd)); + + if (strcmp (cmd, "exit")) + rv = 0; + return; + elseif (strcmp (cmd, "help")) + printf ("\nCommands for profile explorer:\n\n"); + printf ("exit Return to Octave prompt.\n"); + printf ("help Display this help message.\n"); + printf ("up [N] Go up N levels, where N is an integer. Default is 1.\n"); + printf ("N Go down a level into option N.\n"); + elseif (~isnan (option)) + if (option < 1 || option > length (tree)) + printf ("The chosen option is out of range!\n"); + else + newParents = sprintf ("%s%s%s\n", parents, prefix, strings{option}); + newPrefix = sprintf ("%s ", prefix); + + rv = __profexplore_worker (fcn_table, tree(option).Children, ... + newParents, newPrefix); + + if (rv == 0) + return; + elseif (rv > 1) + rv = rv - 1; + return; + else + assert (rv == 1); + ## It was requested to return to this level, so just stay. + endif + endif + elseif (length (cmd) >= 2 && strcmp (substr (cmd, 1, 2), "up")) + if (length (cmd) == 2) + rv = 1; + return; + endif + + if (length (cmd) > 3 && cmd(3) == ' ') + opt = fix (str2double (substr (cmd, 3))); + if (~isnan (opt) && opt > 0) + rv = opt; + return; + endif + endif + + printf ("Invalid 'up' command. Type 'help' for further"); + printf (" information.\n"); + else + printf ("Unrecognized input. Type 'help' to get a list of possible"); + printf (" commands.\n"); + endif + + endwhile +endfunction diff --git a/octave_packages/m/general/profile.m b/octave_packages/m/general/profile.m new file mode 100644 index 0000000..45fc46a --- /dev/null +++ b/octave_packages/m/general/profile.m @@ -0,0 +1,151 @@ +## Copyright (C) 2012 Daniel Kraft +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} profile on +## @deftypefnx {Command} {} profile off +## @deftypefnx {Command} {} profile resume +## @deftypefnx {Command} {} profile clear +## @deftypefnx {Function File} {@var{S} =} profile ('status') +## @deftypefnx {Function File} {@var{T} =} profile ('info') +## Control the built-in profiler. +## +## @table @code +## @item profile on +## Start the profiler, clearing all previously collected data if there +## is any. +## +## @item profile off +## Stop profiling. The collected data can later be retrieved and examined +## with calls like @code{S = profile ('info')}. +## +## @item profile clear +## Clear all collected profiler data. +## +## @item profile resume +## Restart profiling without cleaning up the old data and instead +## all newly collected statistics are added to the already existing ones. +## +## @item @var{S} = profile ('status') +## Return a structure filled with certain information about the current status +## of the profiler. At the moment, the only field is @code{ProfilerStatus} +## which is either 'on' or 'off'. +## +## @item @var{T} = profile ('info') +## Return the collected profiling statistics in the structure @var{T}. +## The flat profile is returned in the field @code{FunctionTable} which is an +## array of structures, each entry corresponding to a function which was called +## and for which profiling statistics are present. Furthermore, the field +## @code{Hierarchical} contains the hierarchical call-tree. Each node +## has an index into the @code{FunctionTable} identifying the function it +## corresponds to as well as data fields for number of calls and time spent +## at this level in the call-tree. +## @seealso{profshow, profexplore} +## @end table +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft + +function retval = profile (option) + + if (nargin != 1) + print_usage (); + endif + + switch (option) + case 'on' + __profiler_reset__ (); + __profiler_enable__ (true); + + case 'off' + __profiler_enable__ (false); + + case 'clear' + __profiler_reset__ (); + + case 'resume' + __profiler_enable__ (true); + + case 'status' + enabled = __profiler_enable__ (); + if (enabled) + enabled = 'on'; + else + enabled = 'off'; + endif + retval = struct ('ProfilerStatus', enabled); + + case 'info' + [flat, tree] = __profiler_data__ (); + retval = struct ('FunctionTable', flat, 'Hierarchical', tree); + + otherwise + warning ("profile: Unrecognized option '%s'", option); + print_usage (); + + endswitch + +endfunction + + +%!demo +%! profile ('on'); +%! A = rand (100); +%! B = expm (A); +%! profile ('off'); +%! profile ('resume'); +%! C = sqrtm (A); +%! profile ('off'); +%! T = profile ('info'); +%! profshow (T); + +%!error profile (); +%!error profile ('on', 2); + +%!test +%! on_struct.ProfilerStatus = "on"; +%! off_struct.ProfilerStatus = "off"; +%! profile ('on'); +%! result = logm (rand (200) + 10 * eye (200)); +%! assert (profile ('status'), on_struct); +%! profile ('off'); +%! assert (profile ('status'), off_struct); +%! profile ('resume'); +%! result = logm (rand (200) + 10 * eye (200)); +%! profile ('off'); +%! assert (profile ('status'), off_struct); +%! info = profile ('info'); +%! assert (isstruct (info)); +%! assert (size (info), [1, 1]); +%! assert (fieldnames (info), {'FunctionTable'; 'Hierarchical'}); +%! ftbl = info.FunctionTable; +%! assert (fieldnames (ftbl), {'FunctionName'; 'TotalTime'; 'NumCalls'; 'IsRecursive'; 'Parents'; 'Children'}); +%! hier = info.Hierarchical; +%! assert (fieldnames (hier), {'Index'; 'SelfTime'; 'TotalTime'; 'NumCalls'; 'Children'}); +%! profile ('clear'); +%! info = profile ('info'); +%! assert (isstruct (info)); +%! assert (size (info), [1, 1]); +%! assert (fieldnames (info), {'FunctionTable'; 'Hierarchical'}); +%! ftbl = info.FunctionTable; +%! assert (size (ftbl), [0, 1]); +%! assert (fieldnames (ftbl), {'FunctionName'; 'TotalTime'; 'NumCalls'; 'IsRecursive'; 'Parents'; 'Children'}); +%! hier = info.Hierarchical; +%! assert (size (hier), [0, 1]); +%! assert (fieldnames (hier), {'Index'; 'SelfTime'; 'NumCalls'; 'Children'}); diff --git a/octave_packages/m/general/profshow.m b/octave_packages/m/general/profshow.m new file mode 100644 index 0000000..01e6f52 --- /dev/null +++ b/octave_packages/m/general/profshow.m @@ -0,0 +1,100 @@ +## Copyright (C) 2012 Daniel Kraft +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} profshow (@var{data}) +## @deftypefnx {Function File} {} profshow (@var{data}, @var{n}) +## Show flat profiler results. +## +## This command prints out profiler data as a flat profile. @var{data} is the +## structure returned by @code{profile ('info')}. If @var{n} is given, it +## specifies the number of functions to show in the profile; functions are +## sorted in descending order by total time spent in them. If there are more +## than @var{n} included in the profile, those will not be shown. @var{n} +## defaults to 20. +## +## The attribute column shows @samp{R} for recursive functions and nothing +## otherwise. +## @seealso{profexplore, profile} +## @end deftypefn + +## Built-in profiler. +## Author: Daniel Kraft + +function profshow (data, n = 20) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + n = fix (n); + if (! isscalar (n) || ! isreal (n) || ! (n > 0)) + error ("profile: N must be a positive integer"); + endif + + m = length (data.FunctionTable); + n = min (n, m); + + ## We want to sort by times in descending order. For this, extract the + ## times to an array, then sort this, and use the resulting index permutation + ## to print out our table. + times = -[ data.FunctionTable.TotalTime ]; + + [~, p] = sort (times); + + ## For printing the table, find out the maximum length of a function name + ## so that we can proportion the table accordingly. Based on this, + ## we can build the format used for printing table rows. + nameLen = length ("Function"); + for i = 1 : n + nameLen = max (nameLen, length (data.FunctionTable(p(i)).FunctionName)); + endfor + headerFormat = sprintf ("%%4s %%%ds %%4s %%12s %%12s\n", nameLen); + rowFormat = sprintf ("%%4d %%%ds %%4s %%12.3f %%12d\n", nameLen); + + printf (headerFormat, "#", "Function", "Attr", "Time (s)", "Calls"); + printf ("%s\n", repmat ("-", 1, nameLen + 2 * 5 + 2 * 13)); + for i = 1 : n + row = data.FunctionTable(p(i)); + attr = ""; + if (row.IsRecursive) + attr = "R"; + endif + printf (rowFormat, p(i), row.FunctionName, attr, ... + row.TotalTime, row.NumCalls); + endfor + +endfunction + +%!demo +%! profile ("on"); +%! A = rand (100); +%! B = expm (A); +%! profile ("off"); +%! T = profile ("info"); +%! profshow (T, 10); + +%!demo +%! profile ("on"); +%! expm (rand (500) + eye (500)); +%! profile ("off"); +%! profshow (profile ("info"), 5); + +%!error profshow (); +%!error profshow (1, 2, 3); +%!error profshow (struct (), 1.2); diff --git a/octave_packages/m/general/quadgk.m b/octave_packages/m/general/quadgk.m new file mode 100644 index 0000000..916f2e8 --- /dev/null +++ b/octave_packages/m/general/quadgk.m @@ -0,0 +1,461 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} quadgk (@var{f}, @var{a}, @var{b}) +## @deftypefnx {Function File} {@var{q} =} quadgk (@var{f}, @var{a}, @var{b}, @var{abstol}) +## @deftypefnx {Function File} {@var{q} =} quadgk (@var{f}, @var{a}, @var{b}, @var{abstol}, @var{trace}) +## @deftypefnx {Function File} {@var{q} =} quadgk (@var{f}, @var{a}, @var{b}, @var{prop}, @var{val}, @dots{}) +## @deftypefnx {Function File} {[@var{q}, @var{err}] =} quadgk (@dots{}) +## +## Numerically evaluate the integral of @var{f} from @var{a} to @var{b} +## using adaptive Gauss-Konrod quadrature. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. +## The formulation is based on a proposal by L.F. Shampine, +## @cite{"Vectorized adaptive quadrature in @sc{matlab}", Journal of +## Computational and Applied Mathematics, pp131-140, Vol 211, Issue 2, +## Feb 2008} where all function evaluations at an iteration are +## calculated with a single call to @var{f}. Therefore, the function +## @var{f} must be vectorized and must accept a vector of input values @var{x} +## and return an output vector representing the function evaluations at the +## given values of @var{x}. +## +## @var{a} and @var{b} are the lower and upper limits of integration. Either +## or both limits may be infinite or contain weak end singularities. +## Variable transformation will be used to treat any infinite intervals and +## weaken the singularities. For example: +## +## @example +## quadgk (@@(x) 1 ./ (sqrt (x) .* (x + 1)), 0, Inf) +## @end example +## +## @noindent +## Note that the formulation of the integrand uses the +## element-by-element operator @code{./} and all user functions to +## @code{quadgk} should do the same. +## +## The optional argument @var{tol} defines the absolute tolerance used to stop +## the integration procedure. The default value is @math{1e^{-10}}. +## +## The algorithm used by @code{quadgk} involves subdividing the +## integration interval and evaluating each subinterval. +## If @var{trace} is true then after computing each of these partial +## integrals display: (1) the number of subintervals at this step, +## (2) the current estimate of the error @var{err}, (3) the current estimate +## for the integral @var{q}. +## +## Alternatively, properties of @code{quadgk} can be passed to the function as +## pairs @code{"@var{prop}", @var{val}}. Valid properties are +## +## @table @code +## @item AbsTol +## Define the absolute error tolerance for the quadrature. The default +## absolute tolerance is 1e-10. +## +## @item RelTol +## Define the relative error tolerance for the quadrature. The default +## relative tolerance is 1e-5. +## +## @item MaxIntervalCount +## @code{quadgk} initially subdivides the interval on which to perform +## the quadrature into 10 intervals. Subintervals that have an +## unacceptable error are subdivided and re-evaluated. If the number of +## subintervals exceeds 650 subintervals at any point then a poor +## convergence is signaled and the current estimate of the integral is +## returned. The property 'MaxIntervalCount' can be used to alter the +## number of subintervals that can exist before exiting. +## +## @item WayPoints +## Discontinuities in the first derivative of the function to integrate can be +## flagged with the @code{"WayPoints"} property. This forces the ends of +## a subinterval to fall on the breakpoints of the function and can result in +## significantly improved estimation of the error in the integral, faster +## computation, or both. For example, +## +## @example +## quadgk (@@(x) abs (1 - x.^2), 0, 2, "Waypoints", 1) +## @end example +## +## @noindent +## signals the breakpoint in the integrand at @code{@var{x} = 1}. +## +## @item Trace +## If logically true @code{quadgk} prints information on the +## convergence of the quadrature at each iteration. +## @end table +## +## If any of @var{a}, @var{b}, or @var{waypoints} is complex then the +## quadrature is treated as a contour integral along a piecewise +## continuous path defined by the above. In this case the integral is +## assumed to have no edge singularities. For example, +## +## @example +## @group +## quadgk (@@(z) log (z), 1+1i, 1+1i, "WayPoints", +## [1-1i, -1,-1i, -1+1i]) +## @end group +## @end example +## +## @noindent +## integrates @code{log (z)} along the square defined by @code{[1+1i, +## 1-1i, -1-1i, -1+1i]} +## +## The result of the integration is returned in @var{q}. +## @var{err} is an approximate bound on the error in the integral +## @code{abs (@var{q} - @var{I})}, where @var{I} is the exact value of the +## integral. +## +## @seealso{quad, quadv, quadl, quadcc, trapz, dblquad, triplequad} +## @end deftypefn + +function [q, err] = quadgk (f, a, b, varargin) + if (nargin < 3) + print_usage (); + endif + + if (b < a) + [q, err] = quadgk (f, b, a, varargin{:}); + q = -q; + else + abstol = 1e-10; + reltol = 1e-5; + waypoints = []; + maxint = 650; + trace = false; + + if (nargin > 3) + if (! ischar (varargin{1})) + if (!isempty (varargin{1})) + abstol = varargin{1}; + reltol = 0; + endif + if (nargin > 4) + trace = varargin{2}; + endif + if (nargin > 5) + error ("quadgk: can not pass additional arguments to user function"); + endif + else + idx = 1; + while (idx < nargin - 3) + if (ischar (varargin{idx})) + str = varargin{idx++}; + if (strcmpi (str, "reltol")) + reltol = varargin{idx++}; + elseif (strcmpi (str, "abstol")) + abstol = varargin{idx++}; + elseif (strcmpi (str, "waypoints")) + waypoints = varargin{idx++} (:); + if (isreal(waypoints)) + waypoints (waypoints < a | waypoints > b) = []; + endif + elseif (strcmpi (str, "maxintervalcount")) + maxint = varargin{idx++}; + elseif (strcmpi (str, "trace")) + trace = varargin{idx++}; + else + error ("quadgk: unknown property %s", str); + endif + else + error ("quadgk: expecting property to be a string"); + endif + endwhile + if (idx != nargin - 2) + error ("quadgk: expecting properties in pairs"); + endif + endif + endif + + ## Convert function given as a string to a function handle + if (ischar (f)) + f = @(x) feval (f, x); + endif + + ## Use variable subsitution to weaken endpoint singularities and to + ## perform integration with endpoints at infinity. No transform for + ## contour integrals + if (iscomplex (a) || iscomplex (b) || iscomplex(waypoints)) + ## contour integral, no transform + subs = [a; waypoints; b]; + h = sum (abs (diff (subs))); + h0 = h; + trans = @(t) t; + elseif (isinf (a) && isinf(b)) + ## Standard Infinite to finite integral transformation. + ## \int_{-\infinity_^\infinity f(x) dx = \int_-1^1 f (g(t)) g'(t) dt + ## where + ## g(t) = t / (1 - t^2) + ## g'(t) = (1 + t^2) / (1 - t^2) ^ 2 + ## waypoint transform is then + ## t = (2 * g(t)) ./ (1 + sqrt(1 + 4 * g(t) .^ 2)) + if (!isempty (waypoints)) + trans = @(x) (2 * x) ./ (1 + sqrt(1 + 4 * x .^ 2)); + subs = [-1; trans(waypoints); 1]; + else + subs = linspace (-1, 1, 11)'; + endif + h = 2; + h0 = b - a; + trans = @(t) t ./ (1 - t.^2); + f = @(t) f (t ./ (1 - t .^ 2)) .* (1 + t .^ 2) ./ ((1 - t .^ 2) .^ 2); + elseif (isinf(a)) + ## Formula defined in Shampine paper as two separate steps. One to + ## weaken singularity at finite end, then a second to transform to + ## a finite interval. The singularity weakening transform is + ## \int_{-\infinity}^b f(x) dx = + ## - \int_{-\infinity}^0 f (b - t^2) 2 t dt + ## (note minus sign) and the finite interval transform is + ## \int_{-\infinity}^0 f(b - t^2) 2 t dt = + ## \int_{-1}^0 f (b - g(s) ^ 2) 2 g(s) g'(s) ds + ## where + ## g(s) = s / (1 + s) + ## g'(s) = 1 / (1 + s) ^ 2 + ## waypoint transform is then + ## t = sqrt (b - x) + ## s = - t / (t + 1) + if (!isempty (waypoints)) + tmp = sqrt (b - waypoints); + trans = @(x) - x ./ (x + 1); + subs = [-1; trans(tmp); 0]; + else + subs = linspace (-1, 0, 11)'; + endif + h = 1; + h0 = b - a; + trans = @(t) b - (t ./ (1 + t)).^2; + f = @(s) - 2 * s .* f (b - (s ./ (1 + s)) .^ 2) ./ ((1 + s) .^ 3); + elseif (isinf(b)) + ## Formula defined in Shampine paper as two separate steps. One to + ## weaken singularity at finite end, then a second to transform to + ## a finite interval. The singularity weakening transform is + ## \int_a^\infinity f(x) dx = \int_0^\infinity f (a + t^2) 2 t dt + ## and the finite interval transform is + ## \int_0^\infinity f(a + t^2) 2 t dt = + ## \int_0^1 f (a + g(s) ^ 2) 2 g(s) g'(s) ds + ## where + ## g(s) = s / (1 - s) + ## g'(s) = 1 / (1 - s) ^ 2 + ## waypoint transform is then + ## t = sqrt (x - a) + ## s = t / (t + 1) + if (!isempty (waypoints)) + tmp = sqrt (waypoints - a); + trans = @(x) x ./ (x + 1); + subs = [0; trans(tmp); 1]; + else + subs = linspace (0, 1, 11)'; + endif + h = 1; + h0 = b - a; + trans = @(t) a + (t ./ (1 - t)).^2; + f = @(s) 2 * s .* f (a + (s ./ (1 - s)) .^ 2) ./ ((1 - s) .^ 3); + else + ## Davis, Rabinowitz, "Methods of Numerical Integration" p441 2ed. + ## Presented in section 5 of the Shampine paper as + ## g(t) = ((b - a) / 2) * (t / 2 * (3 - t^2)) + (b + a) / 2 + ## g'(t) = ((b-a)/4) * (3 - 3t^2); + ## waypoint transform can then be found by solving for t with + ## Maxima (solve (c + 3*t - 3^3, t);). This gives 3 roots, two of + ## which are complex for values between a and b and so can be + ## ignored. The third is + ## c = (-4*x + 2*(b+a)) / (b-a); + ## k = ((sqrt(c^2 - 4) + c)/2)^(1/3); + ## t = (sqrt(3)* 1i * (1 - k^2) - (1 + k^2)) / 2 / k; + if (! isempty (waypoints)) + trans = @__quadgk_finite_waypoint__; + subs = [-1; trans(waypoints, a, b); 1]; + else + subs = linspace(-1, 1, 11)'; + endif + h = 2; + h0 = b - a; + trans = @(t) ((b - a) ./ 4) * t .* (3 - t.^2) + (b + a) ./ 2; + f = @(t) f((b - a) ./ 4 .* t .* (3 - t.^2) + (b + a) ./ 2) .* ... + 3 .* (b - a) ./ 4 .* (1 - t.^2); + endif + + ## Split interval into at least 10 subinterval with a 15 point + ## Gauss-Kronrod rule giving a minimum of 150 function evaluations + while (length (subs) < 11) + subs = [subs' ; subs(1:end-1)' + diff(subs') ./ 2, NaN](:)(1 : end - 1); + endwhile + subs = [subs(1:end-1), subs(2:end)]; + + warn_state = warning ("query", "Octave:divide-by-zero"); + + unwind_protect + ## Singularity will cause divide by zero warnings + warning ("off", "Octave:divide-by-zero"); + + ## Initial evaluation of the integrand on the subintervals + [q_subs, q_errs] = __quadgk_eval__ (f, subs); + q0 = sum (q_subs); + err0 = sum (q_errs); + + if (isa (a, "single") || isa (b, "single") || isa (waypoints, "single")) + myeps = eps ("single"); + else + myeps = eps; + endif + + first = true; + while (true) + ## Check for subintervals that are too small. Test must be + ## performed in untransformed subintervals. What is a good + ## value for this test. Shampine suggests 100*eps + if (any (abs (diff (trans (subs), [], 2) / h0) < 100 * myeps)) + q = q0; + err = err0; + break; + endif + + ## Quit if any evaluations are not finite (Inf or NaN) + if (any (! isfinite (q_subs))) + warning ("quadgk: non finite integrand encountered"); + q = q0; + err = err0; + break; + endif + + tol = max (abstol, reltol .* abs (q0)); + + ## If the global error estimate is meet exit + if (err0 < tol) + q = q0; + err = err0; + break; + endif + + ## Accept the subintervals that meet the convergence criteria + idx = find (abs (q_errs) < tol .* abs(diff (subs, [], 2)) ./ h); + if (first) + q = sum (q_subs (idx)); + err = sum (q_errs(idx)); + first = false; + else + q0 = q + sum (q_subs); + err0 = err + sum (q_errs); + q += sum (q_subs (idx)); + err += sum (q_errs(idx)); + endif + subs(idx,:) = []; + + ## If no remaining subintervals exit + if (rows (subs) == 0) + break; + endif + + if (trace) + disp([rows(subs), err, q0]); + endif + + ## Split remaining subintervals in two + mid = (subs(:,2) + subs(:,1)) ./ 2; + subs = [subs(:,1), mid; mid, subs(:,2)]; + + ## If the maximum subinterval count is met accept remaining + ## subinterval and exit + if (rows (subs) > maxint) + warning ("quadgk: maximum interval count (%d) met", maxint); + q += sum (q_subs); + err += sum (q_errs); + break; + endif + + ## Evaluation of the integrand on the remaining subintervals + [q_subs, q_errs] = __quadgk_eval__ (f, subs); + endwhile + + if (err > max (abstol, reltol * abs(q))) + warning ("quadgk: Error tolerance not met. Estimated error %g", err); + endif + unwind_protect_cleanup + if (strcmp (warn_state.state, "on")) + warning ("on", "Octave:divide-by-zero"); + endif + end_unwind_protect + endif +endfunction + +function [q, err] = __quadgk_eval__ (f, subs) + ## A (15,7) point pair of Gauss-Konrod quadrature rules. The abscissa + ## and weights are copied directly from dqk15w.f from quadpack + + persistent abscissa = [-0.9914553711208126e+00, -0.9491079123427585e+00, ... + -0.8648644233597691e+00, -0.7415311855993944e+00, ... + -0.5860872354676911e+00, -0.4058451513773972e+00, ... + -0.2077849550078985e+00, 0.0000000000000000e+00, ... + 0.2077849550078985e+00, 0.4058451513773972e+00, ... + 0.5860872354676911e+00, 0.7415311855993944e+00, ... + 0.8648644233597691e+00, 0.9491079123427585e+00, ... + 0.9914553711208126e+00]; + + persistent weights15 = ... + diag ([0.2293532201052922e-01, 0.6309209262997855e-01, ... + 0.1047900103222502e+00, 0.1406532597155259e+00, ... + 0.1690047266392679e+00, 0.1903505780647854e+00, ... + 0.2044329400752989e+00, 0.2094821410847278e+00, ... + 0.2044329400752989e+00, 0.1903505780647854e+00, ... + 0.1690047266392679e+00, 0.1406532597155259e+00, ... + 0.1047900103222502e+00, 0.6309209262997855e-01, ... + 0.2293532201052922e-01]); + + persistent weights7 = ... + diag ([0.1294849661688697e+00, 0.2797053914892767e+00, ... + 0.3818300505051889e+00, 0.4179591836734694e+00, ... + 0.3818300505051889e+00, 0.2797053914892767e+00, ... + 0.1294849661688697e+00]); + + halfwidth = diff (subs, [], 2) ./ 2; + center = sum (subs, 2) ./ 2;; + x = bsxfun (@plus, halfwidth * abscissa, center); + y = reshape (f (x(:)), size(x)); + + ## This is faster than using bsxfun as the * operator can use a + ## single BLAS call, rather than rows(sub) calls to the @times + ## function. + q = sum (y * weights15, 2) .* halfwidth; + err = abs (sum (y(:,2:2:end) * weights7, 2) .* halfwidth - q); +endfunction + +function t = __quadgk_finite_waypoint__ (x, a, b) + c = (-4 .* x + 2.* (b + a)) ./ (b - a); + k = ((sqrt(c .^ 2 - 4) + c) ./ 2) .^ (1/3); + t = real ((sqrt(3) .* 1i * (1 - k .^ 2) - (1 + k .^ 2)) ./ 2 ./ k); +endfunction + +%error (quadgk (@sin)) +%error (quadgk (@sin, -pi)) +%error (quadgk (@sin, -pi, pi, 'DummyArg')) + +%!assert (quadgk(@sin,-pi,pi), 0, 1e-6) +%!assert (quadgk(inline('sin'),-pi,pi), 0, 1e-6) +%!assert (quadgk('sin',-pi,pi), 0, 1e-6) +%!assert (quadgk(@sin,-pi,pi,'waypoints', 0, 'MaxIntervalCount', 100, 'reltol', 1e-3, 'abstol', 1e-6, 'trace', false), 0, 1e-6) +%!assert (quadgk(@sin,-pi,pi,1e-6,false), 0, 1e-6) + +%!assert (quadgk(@sin,-pi,0), -2, 1e-6) +%!assert (quadgk(@sin,0,pi), 2, 1e-6) +%!assert (quadgk(@(x) 1./sqrt(x), 0, 1), 2, 1e-6) +%!assert (quadgk (@(x) abs (1 - x.^2), 0, 2, 'Waypoints', 1), 2, 1e-6) +%!assert (quadgk(@(x) 1./(sqrt(x).*(x+1)), 0, Inf), pi, 1e-6) +%!assert (quadgk (@(z) log (z), 1+1i, 1+1i, 'WayPoints', [1-1i, -1,-1i, -1+1i]), -pi * 1i, 1e-6) + +%!assert (quadgk (@(x) exp(-x .^ 2), -Inf, Inf), sqrt(pi), 1e-6) +%!assert (quadgk (@(x) exp(-x .^ 2), -Inf, 0), sqrt(pi)/2, 1e-6) diff --git a/octave_packages/m/general/quadl.m b/octave_packages/m/general/quadl.m new file mode 100644 index 0000000..7a431a2 --- /dev/null +++ b/octave_packages/m/general/quadl.m @@ -0,0 +1,217 @@ +## Copyright (C) 1998-2012 Walter Gautschi +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}) +## @deftypefnx {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}, @var{tol}) +## @deftypefnx {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}) +## @deftypefnx {Function File} {@var{q} =} quadl (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}, @var{p1}, @var{p2}, @dots{}) +## +## Numerically evaluate the integral of @var{f} from @var{a} to @var{b} +## using an adaptive Lobatto rule. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. +## The function @var{f} must be vectorized and return a vector of output values +## if given a vector of input values. +## +## @var{a} and @var{b} are the lower and upper limits of integration. Both +## limits must be finite. +## +## The optional argument @var{tol} defines the relative tolerance with which +## to perform the integration. The default value is @code{eps}. +## +## The algorithm used by @code{quadl} involves recursively subdividing the +## integration interval. +## If @var{trace} is defined then for each subinterval display: (1) the left +## end of the subinterval, (2) the length of the subinterval, (3) the +## approximation of the integral over the subinterval. +## +## Additional arguments @var{p1}, etc., are passed directly to the function +## @var{f}. To use default values for @var{tol} and @var{trace}, one may pass +## empty matrices ([]). +## +## Reference: W. Gander and W. Gautschi, @cite{Adaptive Quadrature - +## Revisited}, BIT Vol. 40, No. 1, March 2000, pp. 84--101. +## @url{http://www.inf.ethz.ch/personal/gander/} +## @seealso{quad, quadv, quadgk, quadcc, trapz, dblquad, triplequad} +## @end deftypefn + +## Author: Walter Gautschi +## Date: 08/03/98 +## Reference: Gander, Computermathematik, Birkhaeuser, 1992. + +## 2003-08-05 Shai Ayal +## * permission from author to release as GPL +## 2004-02-10 Paul Kienzle +## * renamed to quadl for compatibility +## * replace global variable terminate2 with local function need_warning +## * add paper ref to docs + +function q = quadl (f, a, b, tol = [], trace = false, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (isa (a, "single") || isa (b, "single")) + myeps = eps ("single"); + else + myeps = eps; + endif + if (isempty (tol)) + tol = myeps; + endif + if (isempty (trace)) + trace = false; + endif + if (tol < myeps) + tol = myeps; + endif + + ## Track whether recursion has occurred + global __quadl_recurse_done__; + __quadl_recurse_done__ = false; + ## Track whether warning about machine precision has been issued + global __quadl_need_warning__; + __quadl_need_warning__ = true; + + m = (a+b)/2; + h = (b-a)/2; + alpha = sqrt (2/3); + beta = 1/sqrt (5); + + x1 = .942882415695480; + x2 = .641853342345781; + x3 = .236383199662150; + + x = [a, m-x1*h, m-alpha*h, m-x2*h, m-beta*h, m-x3*h, m, m+x3*h, ... + m+beta*h, m+x2*h, m+alpha*h, m+x1*h, b]; + + y = feval (f, x, varargin{:}); + + fa = y(1); + fb = y(13); + + i2 = (h/6)*(y(1) + y(13) + 5*(y(5)+y(9))); + + i1 = (h/1470)*( 77*(y(1)+y(13)) + + 432*(y(3)+y(11)) + + 625*(y(5)+y(9)) + + 672*y(7)); + + is = h*( .0158271919734802*(y(1)+y(13)) + +.0942738402188500*(y(2)+y(12)) + + .155071987336585*(y(3)+y(11)) + + .188821573960182*(y(4)+y(10)) + + .199773405226859*(y(5)+y(9)) + + .224926465333340*(y(6)+y(8)) + + .242611071901408*y(7)); + + s = sign (is); + if (s == 0) + s = 1; + endif + erri1 = abs (i1-is); + erri2 = abs (i2-is); + if (erri2 != 0) + R = erri1/erri2; + else + R = 1; + endif + if (R > 0 && R < 1) + tol = tol/R; + endif + is = s * abs(is) * tol/myeps; + if (is == 0) + is = b-a; + endif + + q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin{:}); + +endfunction + +## ADAPTLOBSTP Recursive function used by QUADL. +## +## Q = ADAPTLOBSTP('F', A, B, FA, FB, IS, TRACE) tries to +## approximate the integral of F(X) from A to B to +## an appropriate relative error. The argument 'F' is +## a string containing the name of f. The remaining +## arguments are generated by ADAPTLOB or by recursion. +## +## Walter Gautschi, 08/03/98 + +function q = adaptlobstp (f, a, b, fa, fb, is, trace, varargin) + global __quadl_recurse_done__; + global __quadl_need_warning__; + + h = (b-a)/2; + m = (a+b)/2; + alpha = sqrt (2/3); + beta = 1 / sqrt(5); + mll = m-alpha*h; + ml = m-beta*h; + mr = m+beta*h; + mrr = m+alpha*h; + x = [mll, ml, m, mr, mrr]; + y = feval (f, x, varargin{:}); + fmll = y(1); + fml = y(2); + fm = y(3); + fmr = y(4); + fmrr = y(5); + i2 = (h/6)*(fa + fb + 5*(fml+fmr)); + i1 = (h/1470)*(77*(fa+fb) + 432*(fmll+fmrr) + 625*(fml+fmr) + 672*fm); + if ((is+(i1-i2) == is || mll <= a || b <= mrr) && __quadl_recurse_done__) + if ((m <= a || b <= m) && __quadl_need_warning__) + warning ("quadl: interval contains no more machine number"); + warning ("quadl: required tolerance may not be met"); + __quadl_need_warning__ = false; + endif + q = i1; + if (trace) + disp ([a, b-a, q]); + endif + else + __quadl_recurse_done__ = true; + q = ( adaptlobstp (f, a , mll, fa , fmll, is, trace, varargin{:}) + + adaptlobstp (f, mll, ml , fmll, fml , is, trace, varargin{:}) + + adaptlobstp (f, ml , m , fml , fm , is, trace, varargin{:}) + + adaptlobstp (f, m , mr , fm , fmr , is, trace, varargin{:}) + + adaptlobstp (f, mr , mrr, fmr , fmrr, is, trace, varargin{:}) + + adaptlobstp (f, mrr, b , fmrr, fb , is, trace, varargin{:})); + endif +endfunction + + +## basic functionality +%!assert (quadl (@(x) sin (x), 0, pi, [], []), 2, -3e-16) + +## the values here are very high so it may be unavoidable that this fails +%!assert (quadl (@(x) sin (3*x).*cosh (x).*sinh (x),10,15), +%! 2.588424538641647e+10, -1.1e-14) + +## extra parameters +%!assert (quadl (@(x,a,b) sin (a + b*x), 0, 1, [], [], 2, 3), +%! cos(2)/3 - cos(5)/3, -3e-16) + +## test different tolerances. +%!assert (quadl (@(x) sin (2 + 3*x).^2, 0, 10, 0.3, []), +%! (60 + sin(4) - sin(64))/12, -0.3) +%!assert (quadl (@(x) sin (2 + 3*x).^2, 0, 10, 0.1, []), +%! (60 + sin(4) - sin(64))/12, -0.1) + diff --git a/octave_packages/m/general/quadv.m b/octave_packages/m/general/quadv.m new file mode 100644 index 0000000..1f0dbba --- /dev/null +++ b/octave_packages/m/general/quadv.m @@ -0,0 +1,161 @@ +## Copyright (C) 2008-2012 David Bateman +## Copyright (C) 2012 Alexander Klein +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} quadv (@var{f}, @var{a}, @var{b}) +## @deftypefnx {Function File} {@var{q} =} quadv (@var{f}, @var{a}, @var{b}, @var{tol}) +## @deftypefnx {Function File} {@var{q} =} quadv (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}) +## @deftypefnx {Function File} {@var{q} =} quadv (@var{f}, @var{a}, @var{b}, @var{tol}, @var{trace}, @var{p1}, @var{p2}, @dots{}) +## @deftypefnx {Function File} {[@var{q}, @var{nfun}] =} quadv (@dots{}) +## +## Numerically evaluate the integral of @var{f} from @var{a} to @var{b} +## using an adaptive Simpson's rule. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. +## @code{quadv} is a vectorized version of @code{quad} and the function +## defined by @var{f} must accept a scalar or vector as input and return a +## scalar, vector, or array as output. +## +## @var{a} and @var{b} are the lower and upper limits of integration. Both +## limits must be finite. +## +## The optional argument @var{tol} defines the tolerance used to stop +## the adaptation procedure. The default value is @math{1e^{-6}}. +## +## The algorithm used by @code{quadv} involves recursively subdividing the +## integration interval and applying Simpson's rule on each subinterval. +## If @var{trace} is true then after computing each of these partial +## integrals display: (1) the total number of function evaluations, +## (2) the left end of the subinterval, (3) the length of the subinterval, +## (4) the approximation of the integral over the subinterval. +## +## Additional arguments @var{p1}, etc., are passed directly to the function +## @var{f}. To use default values for @var{tol} and @var{trace}, one may pass +## empty matrices ([]). +## +## The result of the integration is returned in @var{q}. @var{nfun} indicates +## the number of function evaluations that were made. +## +## Note: @code{quadv} is written in Octave's scripting language and can be +## used recursively in @code{dblquad} and @code{triplequad}, unlike the +## similar @code{quad} function. +## @seealso{quad, quadl, quadgk, quadcc, trapz, dblquad, triplequad} +## @end deftypefn + +function [q, nfun] = quadv (f, a, b, tol, trace, varargin) + ## TODO: Make norm for convergence testing configurable + + if (nargin < 3) + print_usage (); + endif + if (nargin < 4) + tol = []; + endif + if (nargin < 5) + trace = []; + endif + if (isa (a, "single") || isa (b, "single")) + myeps = eps ("single"); + else + myeps = eps; + endif + if (isempty (tol)) + tol = 1e-6; + endif + if (isempty (trace)) + trace = 0; + endif + + ## Split the interval into 3 abscissa, and apply a 3 point Simpson's rule + c = (a + b) / 2; + fa = feval (f, a, varargin{:}); + fc = feval (f, c, varargin{:}); + fb = feval (f, b, varargin{:}); + nfun = 3; + + ## If have edge singularities, move edge point by eps*(b-a) as + ## discussed in Shampine paper used to implement quadgk + if (any (isinf (fa(:)))) + fa = feval (f, a + myeps * (b-a), varargin{:}); + endif + if (any (isinf (fb(:)))) + fb = feval (f, b - myeps * (b-a), varargin{:}); + endif + + h = (b - a); + q = (b - a) / 6 * (fa + 4 * fc + fb); + + [q, nfun, hmin] = simpsonstp (f, a, b, c, fa, fb, fc, q, nfun, abs (h), + tol, trace, varargin{:}); + + if (nfun > 10000) + warning ("maximum iteration count reached"); + elseif (any (isnan (q)(:) | isinf (q)(:))) + warning ("infinite or NaN function evaluations were returned"); + elseif (hmin < (b - a) * myeps) + warning ("minimum step size reached -- possibly singular integral"); + endif +endfunction + +function [q, nfun, hmin] = simpsonstp (f, a, b, c, fa, fb, fc, q0, + nfun, hmin, tol, trace, varargin) + if (nfun > 10000) + q = q0; + else + d = (a + c) / 2; + e = (c + b) / 2; + fd = feval (f, d, varargin{:}); + fe = feval (f, e, varargin{:}); + nfun += 2; + q1 = (c - a) / 6 * (fa + 4 * fd + fc); + q2 = (b - c) / 6 * (fc + 4 * fe + fb); + q = q1 + q2; + + if (abs(a - c) < hmin) + hmin = abs (a - c); + endif + + if (trace) + disp ([nfun, a, b-a, q]); + endif + + ## Force at least one adpative step. + ## Not vectorizing q-q0 in the norm provides a more rigid criterion for + ## matrix-valued functions. + if (nfun == 5 || norm (q - q0, Inf) > tol) + [q1, nfun, hmin] = simpsonstp (f, a, c, d, fa, fc, fd, q1, nfun, hmin, + tol, trace, varargin{:}); + [q2, nfun, hmin] = simpsonstp (f, c, b, e, fc, fb, fe, q2, nfun, hmin, + tol, trace, varargin{:}); + q = q1 + q2; + endif + endif +endfunction + +%!assert (quadv (@sin, 0, 2 * pi), 0, 1e-5) +%!assert (quadv (@sin, 0, pi), 2, 1e-5) + +%% Handles weak singularities at the edge +%!assert (quadv (@(x) 1 ./ sqrt(x), 0, 1), 2, 1e-5) + +%% Handles vector-valued functions +%!assert (quadv (@(x) [(sin (x)), (sin (2 * x))], 0, pi), [2, 0], 1e-5) + +%% Handles matrix-valued functions +%!assert (quadv (@(x) [ x, x, x; x, 1./sqrt(x), x; x, x, x ], 0, 1 ), [0.5, 0.5, 0.5; 0.5, 2, 0.5; 0.5, 0.5, 0.5], 1e-5) diff --git a/octave_packages/m/general/randi.m b/octave_packages/m/general/randi.m new file mode 100644 index 0000000..dec0e1a --- /dev/null +++ b/octave_packages/m/general/randi.m @@ -0,0 +1,141 @@ +## Copyright (C) 2010-2012 Rik Wehbring +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} randi (@var{imax}) +## @deftypefnx {Function File} {} randi (@var{imax}, @var{n}) +## @deftypefnx {Function File} {} randi (@var{imax}, @var{m}, @var{n}, @dots{}) +## @deftypefnx {Function File} {} randi ([@var{imin} @var{imax}], @dots{}) +## @deftypefnx {Function File} {} randi (@dots{}, "@var{class}") +## Return random integers in the range 1:@var{imax}. +## +## Additional arguments determine the shape of the return matrix. When no +## arguments are specified a single random integer is returned. If one +## argument @var{n} is specified then a square matrix @w{(@var{n} x @var{n})} is +## returned. Two or more arguments will return a multi-dimensional +## matrix @w{(@var{m} x @var{n} x @dots{})}. +## +## The integer range may optionally be described by a two element matrix +## with a lower and upper bound in which case the returned integers will be +## on the interval @w{[@var{imin}, @var{imax}]}. +## +## The optional argument "@var{class}" will return a matrix of the requested +## type. The default is "double". +## +## The following example returns 150 integers in the range 1-10. +## +## @example +## ri = randi (10, 150, 1) +## @end example +## +## Implementation Note: @code{randi} relies internally on @code{rand} which +## uses class "double" to represent numbers. This limits the maximum +## integer (@var{imax}) and range (@var{imax} - @var{imin}) to the value +## returned by the @code{bitmax} function. For IEEE floating point numbers +## this value is @w{@math{2^{53} - 1}}. +## +## @seealso{rand} +## @end deftypefn + +## Author: Rik Wehbring + +function ri = randi (bounds, varargin) + + if (nargin < 1) + print_usage(); + endif + + if (! (isnumeric (bounds) && isreal (bounds))) + error ("randi: IMIN and IMAX must be real numeric bounds"); + endif + + if (isscalar (bounds)) + imin = 1; + imax = fix (bounds); + if (imax < 1) + error ("randi: require IMAX >= 1"); + endif + else + imin = fix (bounds(1)); + imax = fix (bounds(2)); + if (imax < imin) + error ("randi: require IMIN <= IMAX"); + endif + endif + + if (nargin > 1 && ischar (varargin{end})) + rclass = varargin{end}; + varargin(end) = []; + else + rclass = "double"; + endif + + if (strfind (rclass, "int")) + if (imax > intmax (rclass)) + error ("randi: require IMAX < intmax (CLASS)"); + endif + elseif (strcmp (rclass, "single")) + if (imax > bitmax (rclass)) + error ("randi: require IMAX < bitmax (CLASS)"); + endif + endif + ## Limit set by use of class double in rand() + if (imax > bitmax) + error ("randi: maximum integer IMAX must be smaller than bitmax ()"); + endif + if ((imax - imin) > bitmax) + error ("randi: maximum integer range must be smaller than bitmax ()"); + endif + + + ri = imin + floor ( (imax-imin+1)*rand (varargin{:}) ); + + if (! strcmp (rclass, "double")) + ri = cast (ri, rclass); + endif + +endfunction + +%!test +%! ri = randi (10, 1000, 1); +%! assert(isequal(ri, fix (ri))); +%! assert(min(ri) == 1); +%! assert(max(ri) == 10); +%! assert(rows(ri) == 1000); +%! assert(columns(ri) == 1); +%! assert(strcmp (class (ri), "double")); +%!test +%! ri = randi ([-5, 10], 1000, 1, "int8"); +%! assert(isequal(ri, fix (ri))); +%! assert(min(ri) == -5); +%! assert(max(ri) == 10); +%! assert(strcmp (class (ri), "int8")); +%! +%!assert(size (randi(10, 3,1,2)) == [3, 1, 2]) + +%% Test input validation +%!error(randi()) +%!error(randi("test")) +%!error(randi(10+2i)) +%!error(randi(0)) +%!error(randi([10, 1])) +%!error(randi(256, "uint8")) +%!error(randi(2^25, "single")) +%!error(randi(bitmax() + 1)) +%!error(randi([-1, bitmax()])) + diff --git a/octave_packages/m/general/rat.m b/octave_packages/m/general/rat.m new file mode 100644 index 0000000..6e75c8a --- /dev/null +++ b/octave_packages/m/general/rat.m @@ -0,0 +1,160 @@ +## Copyright (C) 2001-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{s} =} rat (@var{x}, @var{tol}) +## @deftypefnx {Function File} {[@var{n}, @var{d}] =} rat (@var{x}, @var{tol}) +## +## Find a rational approximation to @var{x} within the tolerance defined +## by @var{tol} using a continued fraction expansion. For example: +## +## @example +## @group +## rat (pi) = 3 + 1/(7 + 1/16) = 355/113 +## rat (e) = 3 + 1/(-4 + 1/(2 + 1/(5 + 1/(-2 + 1/(-7))))) +## = 1457/536 +## @end group +## @end example +## +## Called with two arguments returns the numerator and denominator separately +## as two matrices. +## @seealso{rats} +## @end deftypefn + +function [n,d] = rat(x,tol) + + if (nargin != [1,2] || nargout > 2) + print_usage (); + endif + + y = x(:); + + ## Replace Inf with 0 while calculating ratios. + y(isinf(y)) = 0; + + ## default norm + if (nargin < 2) + tol = 1e-6 * norm(y,1); + endif + + ## First step in the approximation is the integer portion + + ## First element in the continued fraction. + n = round(y); + d = ones(size(y)); + frac = y-n; + lastn = ones(size(y)); + lastd = zeros(size(y)); + + nd = ndims(y); + nsz = numel (y); + steps = zeros([nsz, 0]); + + ## Grab new factors until all continued fractions converge. + while (1) + ## Determine which fractions have not yet converged. + idx = find(abs (y-n./d) >= tol); + if (isempty(idx)) + if (isempty (steps)) + steps = NaN (nsz, 1); + endif + break; + endif + + ## Grab the next step in the continued fraction. + flip = 1./frac(idx); + ## Next element in the continued fraction. + step = round(flip); + + if (nargout < 2) + tsteps = NaN (nsz, 1); + tsteps (idx) = step; + steps = [steps, tsteps]; + endif + + frac(idx) = flip-step; + + ## Update the numerator/denominator. + nextn = n; + nextd = d; + n(idx) = n(idx).*step + lastn(idx); + d(idx) = d(idx).*step + lastd(idx); + lastn = nextn; + lastd = nextd; + endwhile + + if (nargout == 2) + ## Move the minus sign to the top. + n = n.*sign(d); + d = abs(d); + + ## Return the same shape as you receive. + n = reshape(n, size(x)); + d = reshape(d, size(x)); + + ## Use 1/0 for Inf. + n(isinf(x)) = sign(x(isinf(x))); + d(isinf(x)) = 0; + + ## Reshape the output. + n = reshape (n, size (x)); + d = reshape (d, size (x)); + else + n = ""; + nsteps = size(steps, 2); + for i = 1: nsz + s = [int2str(y(i))," "]; + j = 1; + + while (true) + step = steps(i, j++); + if (isnan (step)) + break; + endif + if (j > nsteps || isnan (steps(i, j))) + if (step < 0) + s = [s(1:end-1), " + 1/(", int2str(step), ")"]; + else + s = [s(1:end-1), " + 1/", int2str(step)]; + endif + break; + else + s = [s(1:end-1), " + 1/(", int2str(step), ")"]; + endif + endwhile + s = [s, repmat(")", 1, j-2)]; + n_nc = columns (n); + s_nc = columns (s); + if (n_nc > s_nc) + s(:,s_nc+1:n_nc) = " "; + elseif (s_nc > n_nc) + n(:,n_nc+1:s_nc) = " "; + endif + n = cat (1, n, s); + endfor + endif + +endfunction + +%!error rat (); +%!error rat (1, 2, 3); + +%!test +%! [n, d] = rat ([0.5, 0.3, 1/3]); +%! assert (n, [1, 3, 1]); +%! assert (d, [2, 10, 3]); diff --git a/octave_packages/m/general/repmat.m b/octave_packages/m/general/repmat.m new file mode 100644 index 0000000..561ab71 --- /dev/null +++ b/octave_packages/m/general/repmat.m @@ -0,0 +1,162 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2008 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} repmat (@var{A}, @var{m}) +## @deftypefnx {Function File} {} repmat (@var{A}, @var{m}, @var{n}) +## @deftypefnx {Function File} {} repmat (@var{A}, @var{m}, @var{n}, @var{p}, @dots{}) +## @deftypefnx {Function File} {} repmat (@var{A}, [@var{m} @var{n}]) +## @deftypefnx {Function File} {} repmat (@var{A}, [@var{m} @var{n} @var{p} @dots{}]) +## Form a block matrix of size @var{m} by @var{n}, with a copy of matrix +## @var{A} as each element. If @var{n} is not specified, form an +## @var{m} by @var{m} block matrix. +## @seealso{repelems} +## @end deftypefn + +## Author: Paul Kienzle +## Created: July 2000 + +function x = repmat (A, m, n) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (nargin == 3) + if (! (isscalar (m) && isscalar (n))) + error ("repmat: with 3 arguments M and N must be scalar"); + endif + idx = [m, n]; + else + if (isscalar (m)) + idx = [m, m]; + n = m; + elseif (isvector (m) && length (m) > 1) + ## Ensure that we have a row vector + idx = m(:).'; + else + error ("repmat: invalid dimensional argument"); + endif + endif + + if (all (idx < 0)) + error ("repmat: invalid dimensions"); + else + idx = max (idx, 0); + endif + + if (numel (A) == 1) + ## optimize the scalar fill case. + if (any (idx == 0)) + x = resize (A, idx); + else + x(1:prod (idx)) = A; + x = reshape (x, idx); + endif + elseif (ndims (A) == 2 && length (idx) < 3) + if (issparse (A)) + x = kron (ones (idx), A); + else + ## indexing is now faster, so we use it rather than kron. + m = rows (A); n = columns (A); + p = idx(1); q = idx(2); + x = reshape (A, m, 1, n, 1); + x = x(:, ones (1, p), :, ones (1, q)); + x = reshape (x, m*p, n*q); + endif + else + aidx = size (A); + ## ensure matching size + idx(end+1:length (aidx)) = 1; + aidx(end+1:length (idx)) = 1; + ## create subscript array + cidx = cell (2, length (aidx)); + for i = 1:length (aidx) + cidx{1,i} = ':'; + cidx{2,i} = ones (1, idx (i)); + endfor + aaidx = aidx; + # add singleton dims + aaidx(2,:) = 1; + A = reshape (A, aaidx(:)); + x = reshape (A (cidx{:}), idx .* aidx); + endif + +endfunction + +# Test various methods of providing size parameters +%!shared x +%! x = [1 2;3 4]; +%!assert(repmat(x, [1 1]), repmat(x, 1)); +%!assert(repmat(x, [3 3]), repmat(x, 3)); +%!assert(repmat(x, [1 1]), repmat(x, 1, 1)); +%!assert(repmat(x, [1 3]), repmat(x, 1, 3)); +%!assert(repmat(x, [3 1]), repmat(x, 3, 1)); +%!assert(repmat(x, [3 3]), repmat(x, 3, 3)); + +# Tests for numel==1 case: +%!shared x, r +%! x = [ 65 ]; +%! r = kron(ones(2,2), x); +%!assert(r, repmat(x, [2 2])); +%!assert(char(r), repmat(char(x), [2 2])); +%!assert(int8(r), repmat(int8(x), [2 2])); + +# Tests for ndims==2 case: +%!shared x, r +%! x = [ 65 66 67 ]; +%! r = kron(ones(2,2), x); +%!assert(r, repmat(x, [2 2])); +%!assert(char(r), repmat(char(x), [2 2])); +%!assert(int8(r), repmat(int8(x), [2 2])); + +# Tests for dim>2 case: +%!shared x, r +%! x = [ 65 66 67 ]; +%! r = kron(ones(2,2), x); +%! r(:,:,2) = r(:,:,1); +%!assert(r, repmat(x, [2 2 2])); +%!assert(char(r), repmat(char(x), [2 2 2])); +%!assert(int8(r), repmat(int8(x), [2 2 2])); + +# Test that sparsity is kept +%!assert(sparse(4,4), repmat(sparse(2,2),[2 2])); + + +%!assert (size (repmat (".", -1, 1)), [0, 1]); +%!assert (size (repmat (".", 1, -1)), [1, 0]); +%!error (size (repmat (".", -1, -1))); + +%!assert (size (repmat (1, [1, 0])), [1, 0]); +%!assert (size (repmat (1, [5, 0])), [5, 0]); +%!assert (size (repmat (1, [0, 1])), [0, 1]); +%!assert (size (repmat (1, [0, 5])), [0, 5]); + +%!shared x +%! x = struct ("a", [], "b", []); +%!assert (size (repmat (x, [1, 0])), [1, 0]); +%!assert (size (repmat (x, [5, 0])), [5, 0]); +%!assert (size (repmat (x, [0, 1])), [0, 1]); +%!assert (size (repmat (x, [0, 5])), [0, 5]); + +%!assert (size (repmat ({1}, [1, 0])), [1, 0]); +%!assert (size (repmat ({1}, [5, 0])), [5, 0]); +%!assert (size (repmat ({1}, [0, 1])), [0, 1]); +%!assert (size (repmat ({1}, [0, 5])), [0, 5]); + diff --git a/octave_packages/m/general/rot90.m b/octave_packages/m/general/rot90.m new file mode 100644 index 0000000..824b24f --- /dev/null +++ b/octave_packages/m/general/rot90.m @@ -0,0 +1,102 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rot90 (@var{A}) +## @deftypefnx {Function File} {} rot90 (@var{A}, @var{k}) +## Return a copy of @var{A} with the elements rotated counterclockwise in +## 90-degree increments. The second argument is optional, and specifies +## how many 90-degree rotations are to be applied (the default value is 1). +## Negative values of @var{k} rotate the matrix in a clockwise direction. +## For example, +## +## @example +## @group +## rot90 ([1, 2; 3, 4], -1) +## @result{} 3 1 +## 4 2 +## @end group +## @end example +## +## @noindent +## rotates the given matrix clockwise by 90 degrees. The following are all +## equivalent statements: +## +## @example +## @group +## rot90 ([1, 2; 3, 4], -1) +## rot90 ([1, 2; 3, 4], 3) +## rot90 ([1, 2; 3, 4], 7) +## @end group +## @end example +## +## Note that @code{rot90} only works with 2-D arrays. To rotate N-D arrays +## use @code{rotdim} instead. +## @seealso{rotdim, flipud, fliplr, flipdim} +## @end deftypefn + +## Author: jwe + +function B = rot90 (A, k = 1) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (ndims (A) > 2) + error ("rot90: A must be a 2-D array"); + elseif (! (isscalar (k) && isreal (k) && k == fix (k))) + error ("rot90: K must be a single real integer"); + endif + + k = mod (k, 4); + + if (k == 0) + B = A; + elseif (k == 1) + B = flipud (A.'); + elseif (k == 2) + B = flipud (fliplr (A)); + elseif (k == 3) + B = (flipud (A)).'; + else + error ("rot90: internal error!"); + endif + +endfunction + + +%!test +%! x1 = [1, 2; 3, 4]; +%! x2 = [2, 4; 1, 3]; +%! x3 = [4, 3; 2, 1]; +%! x4 = [3, 1; 4, 2]; +%! +%! assert(rot90 (x1), x2); +%! assert(rot90 (x1, 2), x3); +%! assert(rot90 (x1, 3), x4); +%! assert(rot90 (x1, 4), x1); +%! assert(rot90 (x1, 5), x2); +%! assert(rot90 (x1, -1), x4); + +%% Test input validation +%!error rot90 (); +%!error rot90 (1, 2, 3); +%!error rot90 (1, ones(2)); +%!error rot90 (1, 1.5); +%!error rot90 (1, 1+i); diff --git a/octave_packages/m/general/rotdim.m b/octave_packages/m/general/rotdim.m new file mode 100644 index 0000000..b669ecf --- /dev/null +++ b/octave_packages/m/general/rotdim.m @@ -0,0 +1,158 @@ +## Copyright (C) 2004-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rotdim (@var{x}) +## @deftypefnx {Function File} {} rotdim (@var{x}, @var{n}) +## @deftypefnx {Function File} {} rotdim (@var{x}, @var{n}, @var{plane}) +## Return a copy of @var{x} with the elements rotated counterclockwise in +## 90-degree increments. +## The second argument @var{n} is optional, and specifies how many 90-degree +## rotations are to be applied (the default value is 1). +## The third argument is also optional and defines the plane of the +## rotation. If present, @var{plane} is a two element vector containing two +## different valid dimensions of the matrix. When @var{plane} is not given +## the first two non-singleton dimensions are used. +## +## Negative values of @var{n} rotate the matrix in a clockwise direction. +## For example, +## +## @example +## @group +## rotdim ([1, 2; 3, 4], -1, [1, 2]) +## @result{} 3 1 +## 4 2 +## @end group +## @end example +## +## @noindent +## rotates the given matrix clockwise by 90 degrees. The following are all +## equivalent statements: +## +## @example +## @group +## rotdim ([1, 2; 3, 4], -1, [1, 2]) +## rotdim ([1, 2; 3, 4], 3, [1, 2]) +## rotdim ([1, 2; 3, 4], 7, [1, 2]) +## @end group +## @end example +## @seealso{rot90, flipud, fliplr, flipdim} +## @end deftypefn + +function y = rotdim (x, n, plane) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (nargin > 1 && ! isempty(n)) + if (!isscalar (n) || !isreal(n) || fix (n) != n) + error ("rotdim: N must be a scalar integer"); + endif + else + n = 1; + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 3) + if (nd > 2) + ## Find the first two non-singleton dimension. + plane = []; + dim = 0; + while (dim < nd) + dim = dim + 1; + if (sz (dim) != 1) + plane = [plane, dim]; + if (length (plane) == 2) + break; + endif + endif + endwhile + if (length (plane) < 1) + plane = [1, 2]; + elseif (length (plane) < 2) + plane = [1, plane]; + endif + else + plane = [1, 2]; + endif + else + if (! (isvector (plane) && length (plane) == 2 + && all (plane == fix (plane)) && all (plane > 0) + && all (plane < (nd + 1)) && plane(1) != plane(2))) + error ("rotdim: PLANE must be a 2 element integer vector defining a valid PLANE"); + endif + endif + + n = rem (n, 4); + if (n < 0) + n = n + 4; + endif + if (n == 0) + y = x; + elseif (n == 2) + y = flipdim (flipdim (x, plane(1)), plane(2)); + elseif (n == 1 || n == 3) + perm = 1:nd; + perm(plane(1)) = plane(2); + perm(plane(2)) = plane(1); + y = permute (x, perm); + if (n == 1) + y = flipdim (y, min (plane)); + else + y = flipdim (y, max (plane)); + endif + else + error ("rotdim: internal error!"); + endif + +endfunction + +%!error rotdim (); +%!error rotdim (1, 2, 3, 4); + +%!shared r, rr +%! r = [1,2,3]; rr = [3,2,1]; +%!assert (rotdim (r, 0), r); +%!assert (rotdim (r, 1), rr'); +%!assert (rotdim (r, 2), rr); +%!assert (rotdim (r, 3), r'); +%!assert (rotdim (r, 3), rotdim (r, -1)); +%!assert (rotdim (r, 1), rotdim (r)); + +%!shared c, cr +%! c = [1;2;3]; cr = [3;2;1]; +%!assert (rotdim (c, 0), c); +%!assert (rotdim (c, 1), c'); +%!assert (rotdim (c, 2), cr); +%!assert (rotdim (c, 3), cr'); +%!assert (rotdim (c, 3), rotdim (c, -1)); +%!assert (rotdim (c, 1), rotdim (c)); + +%!shared m +%! m = [1,2;3,4]; +%!assert (rotdim (m, 0), m); +%!assert (rotdim (m, 1), [2,4;1,3]); +%!assert (rotdim (m, 2), [4,3;2,1]); +%!assert (rotdim (m, 3), [3,1;4,2]); +%!assert (rotdim (m, 3), rotdim (m, -1)); +%!assert (rotdim (m, 1), rotdim (m)); + +## FIXME -- we need tests for multidimensional arrays and different +## values of PLANE. diff --git a/octave_packages/m/general/saveobj.m b/octave_packages/m/general/saveobj.m new file mode 100644 index 0000000..e5a5bda --- /dev/null +++ b/octave_packages/m/general/saveobj.m @@ -0,0 +1,44 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{b} =} saveobj (@var{a}) +## Method of a class to manipulate an object prior to saving it to a file. +## The function @code{saveobj} is called when the object @var{a} is saved +## using the @code{save} function. An example of the use of @code{saveobj} +## might be to remove fields of the object that don't make sense to be saved +## or it might be used to ensure that certain fields of the object are +## initialized before the object is saved. For example: +## +## @example +## @group +## function b = saveobj (a) +## b = a; +## if (isempty (b.field)) +## b.field = initfield (b); +## endif +## endfunction +## @end group +## @end example +## +## @seealso{loadobj, class} +## @end deftypefn + +function b = saveobj (a) + error ("saveobj: not defined for class \"%s\"", class(a)); +endfunction diff --git a/octave_packages/m/general/shift.m b/octave_packages/m/general/shift.m new file mode 100644 index 0000000..5fab575 --- /dev/null +++ b/octave_packages/m/general/shift.m @@ -0,0 +1,99 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} shift (@var{x}, @var{b}) +## @deftypefnx {Function File} {} shift (@var{x}, @var{b}, @var{dim}) +## If @var{x} is a vector, perform a circular shift of length @var{b} of +## the elements of @var{x}. +## +## If @var{x} is a matrix, do the same for each column of @var{x}. +## If the optional @var{dim} argument is given, operate along this +## dimension. +## @end deftypefn + +## Author: AW +## Created: 14 September 1994 +## Adapted-By: jwe + +function y = shift (x, b, dim) + + if (nargin != 2 && nargin != 3) + print_usage (); + endif + + if (numel (x) < 1) + error ("shift: X must not be empty"); + elseif (! (isscalar (b) && b == fix (b))) + error ("shift: B must be an integer"); + endif + + nd = ndims (x); + sz = size (x); + + if (nargin == 3) + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("shift: DIM must be an integer and a valid dimension"); + endif + else + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + endif + + d = sz(dim); + + idx = repmat ({':'}, nd, 1); + if (b > 0) + b = rem (b, d); + idx{dim} = [d-b+1:d, 1:d-b]; + elseif (b < 0) + b = rem (abs (b), d); + idx{dim} = [b+1:d, 1:b]; + endif + + y = x(idx{:}); + +endfunction + + +%!test +%! a = [1, 2, 3]; +%! b = [4, 5, 6]; +%! c = [7, 8, 9]; +%! +%! r = [a, b, c]; +%! m = [a; b; c]; +%! +%! assert(shift (r, 0), r); +%! assert(shift (r, 3), [c, a, b]); +%! assert(shift (r, -6), [c, a, b]); +%! assert(shift (r, -3), [b, c, a]); +%! assert(shift (m, 1), [c; a; b]); +%! assert(shift (m, -2), [c; a; b]); + +%% Test input validation +%!error shift () +%!error shift (1, 2, 3, 4) +%!error shift ([], 1) +%!error shift (ones(2), ones(2)) +%!error shift (ones(2), 1.5) +%!error shift (1, 1, 1.5) +%!error shift (1, 1, 0) +%!error shift (1, 1, 3) + diff --git a/octave_packages/m/general/shiftdim.m b/octave_packages/m/general/shiftdim.m new file mode 100644 index 0000000..a2a9165 --- /dev/null +++ b/octave_packages/m/general/shiftdim.m @@ -0,0 +1,100 @@ +## Copyright (C) 2004-2012 John Eaton and David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} shiftdim (@var{x}, @var{n}) +## @deftypefnx {Function File} {[@var{y}, @var{ns}] =} shiftdim (@var{x}) +## Shift the dimensions of @var{x} by @var{n}, where @var{n} must be +## an integer scalar. When @var{n} is positive, the dimensions of +## @var{x} are shifted to the left, with the leading dimensions +## circulated to the end. If @var{n} is negative, then the dimensions +## of @var{x} are shifted to the right, with @var{n} leading singleton +## dimensions added. +## +## Called with a single argument, @code{shiftdim}, removes the leading +## singleton dimensions, returning the number of dimensions removed +## in the second output argument @var{ns}. +## +## For example: +## +## @example +## @group +## x = ones (1, 2, 3); +## size (shiftdim (x, -1)) +## @result{} [1, 1, 2, 3] +## size (shiftdim (x, 1)) +## @result{} [2, 3] +## [b, ns] = shiftdim (x) +## @result{} b = [1, 1, 1; 1, 1, 1] +## @result{} ns = 1 +## @end group +## @end example +## @seealso {reshape, permute, ipermute, circshift, squeeze} +## @end deftypefn + +function [y, ns] = shiftdim (x, n) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + nd = ndims (x); + orig_dims = size (x); + + if (nargin == 1) + ## Find the first non-singleton dimension. + (n = find (orig_dims != 1, 1) - 1) || (n = nd); + elseif (! (isscalar (n) && n == fix (n))) + error ("shiftdim: N must be a scalar integer"); + endif + + if (n >= nd) + n = rem (n, nd); + endif + + if (n < 0) + singleton_dims = ones (1, -n); + y = reshape (x, [singleton_dims, orig_dims]); + elseif (n > 0) + ## We need permute here instead of reshape to shift values in a + ## compatible way. + y = permute (x, [n+1:nd 1:n]); + else + y = x; + endif + + ns = n; + +endfunction + + +%!test +%! x = rand (1, 1, 4, 2); +%! [y, ns] = shiftdim (x); +%! assert (size (y), [4 2]); +%! assert (ns, 2); +%! assert (shiftdim (y, -2), x); +%! assert (size (shiftdim (x, 2)), [4 2]); +%!assert (size (shiftdim (rand (0, 1, 2))), [0 1 2]); + +%% Test input validation +%!error(shiftdim ()); +%!error(shiftdim (1,2,3)); +%!error(shiftdim (1, ones (2))); +%!error(shiftdim (1, 1.5)); + diff --git a/octave_packages/m/general/sortrows.m b/octave_packages/m/general/sortrows.m new file mode 100644 index 0000000..edd759f --- /dev/null +++ b/octave_packages/m/general/sortrows.m @@ -0,0 +1,137 @@ +## Copyright (C) 2000-2012 Daniel Calvelo +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{s}, @var{i}] =} sortrows (@var{A}) +## @deftypefnx {Function File} {[@var{s}, @var{i}] =} sortrows (@var{A}, @var{c}) +## Sort the rows of the matrix @var{A} according to the order of the +## columns specified in @var{c}. If @var{c} is omitted, a +## lexicographical sort is used. By default ascending order is used +## however if elements of @var{c} are negative then the corresponding +## column is sorted in descending order. +## @seealso{sort} +## @end deftypefn + +## Author: Daniel Calvelo, Paul Kienzle +## Adapted-by: jwe + +function [s, i] = sortrows (A, c) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 2) + if (! (isnumeric (c) && isvector (c))) + error ("sortrows: C must be a numeric vector"); + elseif (any (c == 0) || any (abs (c) > columns (A))) + error ("sortrows: all elements of C must be in the range [1, columns (A)]"); + endif + endif + + default_mode = "ascend"; + reverse_mode = "descend"; + + if (issparse (A)) + ## FIXME: Eliminate this case once __sort_rows_idx__ is fixed to + ## handle sparse matrices. + if (nargin == 1) + i = sort_rows_idx_generic (default_mode, reverse_mode, A); + else + i = sort_rows_idx_generic (default_mode, reverse_mode, A, c); + endif + elseif (nargin == 1) + i = __sort_rows_idx__ (A, default_mode); + elseif (all (c > 0)) + i = __sort_rows_idx__ (A(:,c), default_mode); + elseif (all (c < 0)) + i = __sort_rows_idx__ (A(:,-c), reverse_mode); + else + ## Otherwise, fall back to the old algorithm. + i = sort_rows_idx_generic (default_mode, reverse_mode, A, c); + endif + + ## Only bother to compute s if needed. + if (isargout (1)) + s = A(i,:); + endif + +endfunction + +function i = sort_rows_idx_generic (default_mode, reverse_mode, m, c) + + if (nargin == 3) + indices = [1:columns(m)]'; + mode(1:columns(m)) = {default_mode}; + else + for j = 1:length (c); + if (c(j) < 0) + mode{j} = reverse_mode; + else + mode{j} = default_mode; + endif + endfor + indices = abs (c(:)); + endif + + ## Since sort is 'stable' the order of identical elements will be + ## preserved, so by traversing the sort indices in reverse order we + ## will make sure that identical elements in index i are subsorted by + ## index j. + indices = flipud (indices); + mode = flipud (mode'); + i = [1:rows(m)]'; + for j = 1:length (indices); + [~, idx] = sort (m(i, indices(j)), mode{j}); + i = i(idx); + endfor + +endfunction + + +%!test +%! m = [1, 1; 1, 2; 3, 6; 2, 7]; +%! c = [1, -2]; +%! [x, idx] = sortrows (m, c); +%! [sx, sidx] = sortrows (sparse (m), c); +%! assert (x, [1, 2; 1, 1; 2, 7; 3, 6]); +%! assert (idx, [2; 1; 4; 3]); +%! assert (issparse (sx)); +%! assert (x, full (sx)); +%! assert (idx, sidx); + +%!test +%! m = [1, 0, 0, 4]; +%! c = 1; +%! [x, idx] = sortrows (m, c); +%! [sx, sidx] = sortrows (sparse (m), c); +%! assert (x, m); +%! assert (idx, 1); +%! assert (issparse (sx)); +%! assert (x, full (sx)); +%! assert (idx, sidx); + +%% Test input validation +%!error sortrows () +%!error sortrows (1, 2, 3) +%!error sortrows (1, "ascend") +%!error sortrows (1, ones (2,2)) +%!error sortrows (1, 0) +%!error sortrows (1, 2) + diff --git a/octave_packages/m/general/sph2cart.m b/octave_packages/m/general/sph2cart.m new file mode 100644 index 0000000..65d1a67 --- /dev/null +++ b/octave_packages/m/general/sph2cart.m @@ -0,0 +1,114 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{y}, @var{z}] =} sph2cart (@var{theta}, @var{phi}, @var{r}) +## @deftypefnx {Function File} {[@var{x}, @var{y}, @var{z}] =} sph2cart (@var{S}) +## @deftypefnx {Function File} {C =} sph2cart (@dots{}) +## Transform spherical to Cartesian coordinates. +## +## @var{theta} describes the angle relative to the positive x-axis. +## @var{phi} is the angle relative to the xy-plane. +## @var{r} is the distance to the origin @w{(0, 0, 0)}. +## @var{theta}, @var{phi}, and @var{r} must be the same shape, or scalar. +## If called with a single matrix argument then each row of @var{s} +## represents the spherical coordinate (@var{theta}, @var{phi}, @var{r}). +## +## If only a single return argument is requested then return a matrix +## @var{C} where each row represents one Cartesian coordinate +## (@var{x}, @var{y}, @var{z}). +## @seealso{cart2sph, pol2cart, cart2pol} +## @end deftypefn + +## Author: Kai Habel +## Adapted-by: jwe + +function [x, y, z] = sph2cart (theta, phi, r) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (nargin == 1) + if (ismatrix (theta) && columns (theta) == 3) + r = theta(:,3); + phi = theta(:,2); + theta = theta(:,1); + else + error ("sph2cart: matrix input must have 3 columns [THETA, PHI, R]"); + endif + elseif (nargin == 3) + if (! ((ismatrix (theta) && ismatrix (phi) && ismatrix (r)) + && (size_equal (theta, phi) || isscalar (theta) || isscalar (phi)) + && (size_equal (theta, r) || isscalar (theta) || isscalar (r)) + && (size_equal (phi, r) || isscalar (phi) || isscalar (r)))) + error ("sph2cart: THETA, PHI, and R must be matrices of the same size, or scalar"); + endif + endif + + x = r .* cos (phi) .* cos (theta); + y = r .* cos (phi) .* sin (theta); + z = r .* sin (phi); + + if (nargout <= 1) + x = [x, y, z]; + endif + +endfunction + +%!test +%! t = [0, 0, 0]; +%! p = [0, 0, 0]; +%! r = [0, 1, 2]; +%! [x, y, z] = sph2cart (t, p, r); +%! assert (x, r); +%! assert (y, [0, 0, 0]); +%! assert (z, [0, 0, 0]); + +%!test +%! t = 0; +%! p = [0, 0, 0]; +%! r = [0, 1, 2]; +%! [x, y, z] = sph2cart (t, p, r); +%! assert (x, r); +%! assert (y, [0, 0, 0]); +%! assert (z, [0, 0, 0]); + +%!test +%! t = [0, 0, 0]; +%! p = 0; +%! r = [0, 1, 2]; +%! [x, y, z] = sph2cart (t, p, r); +%! assert (x, r); +%! assert (y, [0, 0, 0]); +%! assert (z, [0, 0, 0]); + +%!test +%! t = [0, 0.5, 1]*pi; +%! p = [0, 0, 0]; +%! r = 1; +%! [x, y, z] = sph2cart (t, p, r); +%! assert (x, [1, 0, -1], eps); +%! assert (y, [0, 1, 0], eps); +%! assert (z, [0, 0, 0], eps); + +%!test +%! S = [ 0, 0, 1; 0.5*pi, 0, 1; pi, 0, 1]; +%! C = [ 1, 0, 0; 0, 1, 0; -1, 0, 0]; +%! assert (sph2cart(S), C, eps); + diff --git a/octave_packages/m/general/structfun.m b/octave_packages/m/general/structfun.m new file mode 100644 index 0000000..3b48e19 --- /dev/null +++ b/octave_packages/m/general/structfun.m @@ -0,0 +1,146 @@ +## Copyright (C) 2007-2012 David Bateman +## Copyright (C) 2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} structfun (@var{func}, @var{S}) +## @deftypefnx {Function File} {[@var{A}, @dots{}] =} structfun (@dots{}) +## @deftypefnx {Function File} {} structfun (@dots{}, "ErrorHandler", @var{errfunc}) +## @deftypefnx {Function File} {} structfun (@dots{}, "UniformOutput", @var{val}) +## +## Evaluate the function named @var{name} on the fields of the structure +## @var{S}. The fields of @var{S} are passed to the function @var{func} +## individually. +## +## @code{structfun} accepts an arbitrary function @var{func} in the form of +## an inline function, function handle, or the name of a function (in a +## character string). In the case of a character string argument, the +## function must accept a single argument named @var{x}, and it must return +## a string value. If the function returns more than one argument, they are +## returned as separate output variables. +## +## If the parameter "UniformOutput" is set to true (the default), then the +## function +## must return a single element which will be concatenated into the +## return value. If "UniformOutput" is false, the outputs are placed into a +## structure +## with the same fieldnames as the input structure. +## +## @example +## @group +## s.name1 = "John Smith"; +## s.name2 = "Jill Jones"; +## structfun (@@(x) regexp (x, '(\w+)$', "matches")@{1@}, s, +## "UniformOutput", false) +## @result{} +## @{ +## name1 = Smith +## name2 = Jones +## @} +## @end group +## @end example +## +## Given the parameter "ErrorHandler", @var{errfunc} defines a function to +## call in case @var{func} generates an error. The form of the function is +## +## @example +## function [@dots{}] = errfunc (@var{se}, @dots{}) +## @end example +## +## @noindent +## where there is an additional input argument to @var{errfunc} relative to +## @var{func}, given by @var{se}. This is a structure with the elements +## "identifier", "message" and "index", giving respectively the error +## identifier, the error message, and the index into the input arguments +## of the element that caused the error. For an example on how to use +## an error handler, @pxref{doc-cellfun, @code{cellfun}}. +## +## @seealso{cellfun, arrayfun, spfun} +## @end deftypefn + +function varargout = structfun (func, S, varargin); + + if (nargin < 2) + print_usage (); + endif + + nargs = length (varargin); + + recognized_opts = {"UniformOutput", "ErrorHandler"}; + uo_str = recognized_opts{1}; + + uniform_output = true; + + while (nargs >= 2) + opt_match = strcmpi (varargin{nargs-1}, recognized_opts); + if (opt_match(1)) + uniform_output = varargin{nargs}; + endif + if (any (opt_match)) + nargs -= 2; + else + break; + endif + endwhile + + if (nargs > 0) + error ("structfun: invalid options"); + endif + + varargout = cell (max ([nargout, 1]), 1); + [varargout{:}] = cellfun (func, struct2cell (S), varargin{:}); + + if (! uniform_output) + varargout = cellfun ("cell2struct", varargout, {fieldnames(S)}, {1}, uo_str, false); + endif +endfunction + + +%!test +%! s.name1 = "John Smith"; +%! s.name2 = "Jill Jones"; +%! l.name1 = "Smith"; +%! l.name2 = "Jones"; +%! o = structfun (@(x) regexp (x, '(\w+)$', "matches"){1}, s, +%! "UniformOutput", false); +%! assert (o, l); + +%!function [a, b] = __twoouts (x) +%! a = x + x; +%! b = x * x; +%!endfunction + +%!test +%! s = struct ("a", {1, 2, 3}, "b", {4, 5, 6}); +%! c(1:2, 1, 1) = [2; 8]; +%! c(1:2, 1, 2) = [4; 10]; +%! c(1:2, 1, 3) = [6; 12]; +%! d(1:2, 1, 1) = [1; 16]; +%! d(1:2, 1, 2) = [4; 25]; +%! d(1:2, 1, 3) = [9; 36]; +%! [aa, bb] = structfun(@__twoouts, s); +%! assert(aa, c); +%! assert(bb, d); + +%!test +%! s = struct ("a", {1, 2, 3}, "b", {4, 5, 6}); +%! c = struct ("a", {2, 4, 6}, "b", {8, 10, 12}); +%! d = struct ("a", {1, 4, 9}, "b", {16, 25, 36}); +%! [aa, bb] = structfun(@__twoouts, s, "UniformOutput", false); +%! assert(aa, c); +%! assert(bb, d); diff --git a/octave_packages/m/general/subsindex.m b/octave_packages/m/general/subsindex.m new file mode 100644 index 0000000..121680e --- /dev/null +++ b/octave_packages/m/general/subsindex.m @@ -0,0 +1,65 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{idx} =} subsindex (@var{a}) +## Convert an object to an index vector. When @var{a} is a class object +## defined with a class constructor, then @code{subsindex} is the +## overloading method that allows the conversion of this class object to +## a valid indexing vector. It is important to note that +## @code{subsindex} must return a zero-based real integer vector of the +## class "double". For example, if the class constructor +## +## @example +## @group +## function b = myclass (a) +## b = class (struct ("a", a), "myclass"); +## endfunction +## @end group +## @end example +## +## @noindent +## then the @code{subsindex} function +## +## @example +## @group +## function idx = subsindex (a) +## idx = double (a.a) - 1.0; +## endfunction +## @end group +## @end example +## +## @noindent +## can then be used as follows +## +## @example +## @group +## a = myclass (1:4); +## b = 1:10; +## b(a) +## @result{} 1 2 3 4 +## @end group +## @end example +## +## @seealso{class, subsref, subsasgn} +## @end deftypefn + +function idx = subsindex (a) + error ("subsindex: not defined for class \"%s\"", class(a)); +endfunction + diff --git a/octave_packages/m/general/trapz.m b/octave_packages/m/general/trapz.m new file mode 100644 index 0000000..e528df0 --- /dev/null +++ b/octave_packages/m/general/trapz.m @@ -0,0 +1,138 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} trapz (@var{y}) +## @deftypefnx {Function File} {@var{q} =} trapz (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{q} =} trapz (@dots{}, @var{dim}) +## +## Numerically evaluate the integral of points @var{y} using the trapezoidal +## method. +## @w{@code{trapz (@var{y})}} computes the integral of @var{y} along the first +## non-singleton dimension. When the argument @var{x} is omitted an +## equally spaced @var{x} vector with unit spacing (1) is assumed. +## @code{trapz (@var{x}, @var{y})} evaluates the integral with respect +## to the spacing in @var{x} and the values in @var{y}. This is useful if +## the points in @var{y} have been sampled unevenly. +## If the optional @var{dim} argument is given, operate along this dimension. +## +## If @var{x} is not specified then unit spacing will be used. To scale +## the integral to the correct value you must multiply by the actual spacing +## value (deltaX). As an example, the integral of @math{x^3} over the range +## [0, 1] is @math{x^4/4} or 0.25. The following code uses @code{trapz} to +## calculate the integral in three different ways. +## +## @example +## @group +## x = 0:0.1:1; +## y = x.^3; +## q = trapz (y) +## @result{} q = 2.525 # No scaling +## q * 0.1 +## @result{} q = 0.2525 # Approximation to integral by scaling +## trapz (x, y) +## @result{} q = 0.2525 # Same result by specifying @var{x} +## @end group +## @end example +## +## @seealso{cumtrapz} +## @end deftypefn + +## Author: Kai Habel +## +## also: June 2000 - Paul Kienzle (fixes,suggestions) +## 2006-05-12 David Bateman - Modified for NDArrays + +function z = trapz (x, y, dim) + + if (nargin < 1) || (nargin > 3) + print_usage (); + endif + + have_xy = have_dim = false; + + if (nargin == 3) + have_xy = true; + have_dim = true; + elseif (nargin == 2) + if (! size_equal (x, y) && isscalar (y)) + dim = y; + have_dim = true; + else + have_xy = true; + endif + endif + + if (have_xy) + nd = ndims (y); + sz = size (y); + else + nd = ndims (x); + sz = size (x); + endif + + if (! have_dim) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("trapz: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + idx1 = idx2 = repmat ({':'}, [nd, 1]); + idx1{dim} = 2 : n; + idx2{dim} = 1 : (n - 1); + + if (! have_xy) + z = 0.5 * sum (x(idx1{:}) + x(idx2{:}), dim); + else + if (isvector (x) && !isvector (y)) + if (length (x) != sz(dim)) + error ("trapz: length of X and length of Y along DIM must match"); + endif + ## Reshape vector to point along dimension DIM + shape = ones (nd, 1); + shape(dim) = sz(dim); + x = reshape (x, shape); + z = 0.5 * sum (bsxfun (@times, diff (x), y(idx1{:}) + y(idx2{:})), dim); + else + if (! size_equal (x, y)) + error ("trapz: X and Y must have same shape"); + endif + z = 0.5 * sum (diff (x, 1, dim) .* (y(idx1{:}) + y(idx2{:})), dim); + endif + endif +endfunction + + +%!assert (trapz(1:5), 12) +%!assert (trapz(0:0.5:2,1:5), 6) +%!assert (trapz([1:5;1:5].',1), [12,12]) +%!assert (trapz([1:5;1:5],2), [12;12]) +%!assert (trapz(repmat(reshape(1:5,1,1,5),2,2), 3), [12 12; 12 12]) +%!assert (trapz([0:0.5:2;0:0.5:2].',[1:5;1:5].',1), [6, 6]) +%!assert (trapz([0:0.5:2;0:0.5:2],[1:5;1:5],2), [6; 6]) +%!assert (trapz(repmat(reshape([0:0.5:2],1,1,5),2,2), ... +%! repmat(reshape(1:5,1,1,5),2,2), 3), [6 6; 6 6]) +%!assert (trapz(0:0.5:2,[(1:5)',(1:5)']), [6, 6]) +%!assert (trapz(0:0.5:2,[(1:5);(1:5)],2), [6; 6]) +%!assert (trapz(0:0.5:2,repmat(reshape(1:5,1,1,5),2,2),3), [6 6; 6 6]) + diff --git a/octave_packages/m/general/triplequad.m b/octave_packages/m/general/triplequad.m new file mode 100644 index 0000000..0e61e91 --- /dev/null +++ b/octave_packages/m/general/triplequad.m @@ -0,0 +1,85 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}) +## @deftypefnx {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}, @var{tol}) +## @deftypefnx {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}, @var{tol}, @var{quadf}) +## @deftypefnx {Function File} {} triplequad (@var{f}, @var{xa}, @var{xb}, @var{ya}, @var{yb}, @var{za}, @var{zb}, @var{tol}, @var{quadf}, @dots{}) +## Numerically evaluate the triple integral of @var{f}. +## @var{f} is a function handle, inline function, or string +## containing the name of the function to evaluate. The function @var{f} must +## have the form @math{w = f(x,y,z)} where either @var{x} or @var{y} is a +## vector and the remaining inputs are scalars. It should return a vector of +## the same length and orientation as @var{x} or @var{y}. +## +## @var{xa}, @var{ya}, @var{za} and @var{xb}, @var{yb}, @var{zb} are the lower +## and upper limits of integration for x, y, and z respectively. The +## underlying integrator determines whether infinite bounds are accepted. +## +## The optional argument @var{tol} defines the absolute tolerance used to +## integrate each sub-integral. The default value is @math{1e^{-6}}. +## +## The optional argument @var{quadf} specifies which underlying integrator +## function to use. Any choice but @code{quad} is available and the default +## is @code{quadcc}. +## +## Additional arguments, are passed directly to @var{f}. To use the default +## value for @var{tol} or @var{quadf} one may pass ':' or an empty matrix ([]). +## @seealso{dblquad, quad, quadv, quadl, quadgk, quadcc, trapz} +## @end deftypefn + +function q = triplequad (f, xa, xb, ya, yb, za, zb, tol = 1e-6, quadf = @quadcc, varargin) + + if (nargin < 7) + print_usage (); + endif + + ## Allow use of empty matrix ([]) to indicate default + if (isempty (tol)) + tol = 1e-6; + endif + if (isempty (quadf)) + quadf = @quadcc; + endif + + inner = @__triplequad_inner__; + if (ischar (f)) + f = @(x,y,z) feval (f, x, y, z, varargin{:}); + varargin = {}; + endif + + q = dblquad (@(y, z) inner (y, z, f, xa, xb, tol, quadf, varargin{:}), ya, yb, za, zb, tol); + +endfunction + +function q = __triplequad_inner__ (y, z, f, xa, xb, tol, quadf, varargin) + q = zeros (size(y)); + for i = 1 : length (y) + q(i) = feval (quadf, @(x) f (x, y(i), z, varargin{:}), xa, xb, tol); + endfor +endfunction + + +%!assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadcc), pi ^ (3/2) * erf(1).^3, 1e-6) + +%% These tests are too expensive to run normally (~30 sec each). Disable them +#%!assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadgk), pi ^ (3/2) * erf(1).^3, 1e-6) +#%!#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadl), pi ^ (3/2) * erf(1).^3, 1e-6) +#%!#assert (triplequad (@(x,y,z) exp(-x.^2 - y.^2 - z.^2) , -1, 1, -1, 1, -1, 1, [], @quadv), pi ^ (3/2) * erf(1).^3, 1e-6) + diff --git a/octave_packages/m/geometry/convhull.m b/octave_packages/m/geometry/convhull.m new file mode 100644 index 0000000..a63db86 --- /dev/null +++ b/octave_packages/m/geometry/convhull.m @@ -0,0 +1,100 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{H} =} convhull (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{H} =} convhull (@var{x}, @var{y}, @var{options}) +## Compute the convex hull of the set of points defined by the +## vectors @var{x} and @var{y}. The hull @var{H} is an index vector into +## the set of points and specifies which points form the enclosing hull. +## +## An optional third argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default option is @code{@{"Qt"@}}. +## +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## To append user options to the defaults it is necessary to repeat the +## default arguments in @var{options}. Use a null string to pass no arguments. +## +## @seealso{convhulln, delaunay, voronoi} +## @end deftypefn + +## Author: Kai Habel + +function H = convhull (x, y, options) + + if (nargin != 2 && nargin != 3) + print_usage (); + endif + + if (! (isvector (x) && isvector (y) && length (x) == length (y)) + && ! size_equal (x, y)) + error ("convhull: X and Y must be the same size"); + elseif (nargin == 3 && ! (ischar (options) || iscellstr (options))) + error ("convhull: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 2) + i = convhulln ([x(:), y(:)]); + else + i = convhulln ([x(:), y(:)], options); + endif + + n = rows (i); + i = i'(:); + H = zeros (n + 1, 1); + + H(1) = i(1); + next_i = i(2); + i(2) = 0; + for k = 2:n + next_idx = find (i == next_i); + + if (rem (next_idx, 2) == 0) + H(k) = i(next_idx); + next_i = i(next_idx - 1); + i(next_idx - 1) = 0; + else + H(k) = i(next_idx); + next_i = i(next_idx + 1); + i(next_idx + 1) = 0; + endif + endfor + + H(n + 1) = H(1); + +endfunction + + +%!demo +%! x = -3:0.05:3; +%! y = abs (sin (x)); +%! k = convhull (x, y); +%! plot (x(k),y(k),"r-;convex hull;", x,y,"b+;points;"); +%! axis ([-3.05, 3.05, -0.05, 1.05]); + +%!testif HAVE_QHULL +%! x = -3:0.5:3; +%! y = abs (sin (x)); +%! assert (convhull (x, y), [1;7;13;12;11;10;4;3;2;1]) + +%% FIXME: Need input validation tests + diff --git a/octave_packages/m/geometry/delaunay.m b/octave_packages/m/geometry/delaunay.m new file mode 100644 index 0000000..6ae2480 --- /dev/null +++ b/octave_packages/m/geometry/delaunay.m @@ -0,0 +1,119 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} delaunay (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{tri} =} delaunay (@var{x}, @var{y}, @var{options}) +## Compute the Delaunay triangulation for a 2-D set of points. +## The return value @var{tri} is a set of triangles which satisfies the +## Delaunay circum-circle criterion, i.e., only a single data point from +## [@var{x}, @var{y}] is within the circum-circle of the defining triangle. +## +## The set of triangles @var{tri} is a matrix of size [n, 3]. Each +## row defines a triangle and the three columns are the three vertices +## of the triangle. The value of @code{@var{tri}(i,j)} is an index into +## @var{x} and @var{y} for the location of the j-th vertex of the i-th +## triangle. +## +## An optional third argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options are @code{@{"Qt", "Qbb", "Qc", "Qz"@}}. +## +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## To append user options to the defaults it is necessary to repeat the +## default arguments in @var{options}. Use a null string to pass no arguments. +## +## If no output argument is specified the resulting Delaunay triangulation +## is plotted along with the original set of points. +## +## @example +## @group +## x = rand (1, 10); +## y = rand (1, 10); +## T = delaunay (x, y); +## VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; +## VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; +## axis ([0,1,0,1]); +## plot (VX, VY, "b", x, y, "r*"); +## @end group +## @end example +## @seealso{delaunay3, delaunayn, convhull, voronoi} +## @end deftypefn + +## Author: Kai Habel + +function tri = delaunay (x, y, options) + + if (nargin != 2 && nargin != 3) + print_usage (); + endif + + if (! (isvector (x) && isvector (y) && length (x) == length (y)) + && ! size_equal (x, y)) + error ("delaunay: X and Y must be the same size"); + elseif (nargin == 3 && ! (ischar (options) || iscellstr (options))) + error ("delaunay: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 2) + T = delaunayn ([x(:), y(:)]); + else + T = delaunayn ([x(:), y(:)], options); + endif + + if (nargout == 0) + x = x(:).'; + y = y(:).'; + VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; + VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; + plot (VX, VY, "b", x, y, "r*"); + else + tri = T; + endif + +endfunction + + +%!demo +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 1); +%! x = rand (1,10); +%! y = rand (1,10); +%! T = delaunay (x,y); +%! VX = [ x(T(:,1)); x(T(:,2)); x(T(:,3)); x(T(:,1)) ]; +%! VY = [ y(T(:,1)); y(T(:,2)); y(T(:,3)); y(T(:,1)) ]; +%! axis ([0,1,0,1]); +%! plot (VX,VY,"b", x,y,"r*"); + +%!testif HAVE_QHULL +%! x = [-1, 0, 1, 0]; +%! y = [0, 1, 0, -1]; +%! assert (sortrows (sort (delaunay (x, y), 2)), [1,2,4;2,3,4]); + +%!testif HAVE_QHULL +%! x = [-1, 0, 1, 0, 0]; +%! y = [0, 1, 0, -1, 0]; +%! assert (sortrows (sort (delaunay (x, y), 2)), [1,2,5;1,4,5;2,3,5;3,4,5]); + +%% FIXME: Need input validation tests + diff --git a/octave_packages/m/geometry/delaunay3.m b/octave_packages/m/geometry/delaunay3.m new file mode 100644 index 0000000..914a9c3 --- /dev/null +++ b/octave_packages/m/geometry/delaunay3.m @@ -0,0 +1,77 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{tetr} =} delaunay3 (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {@var{tetr} =} delaunay3 (@var{x}, @var{y}, @var{z}, @var{options}) +## Compute the Delaunay triangulation for a 3-D set of points. +## The return value @var{tetr} is a set of tetrahedrons which satisfies the +## Delaunay circum-circle criterion, i.e., only a single data point from +## [@var{x}, @var{y}, @var{z}] is within the circum-circle of the defining +## tetrahedron. +## +## The set of tetrahedrons @var{tetr} is a matrix of size [n, 4]. Each +## row defines a tetrahedron and the four columns are the four vertices +## of the tetrahedron. The value of @code{@var{tetr}(i,j)} is an index into +## @var{x}, @var{y}, @var{z} for the location of the j-th vertex of the i-th +## tetrahedron. +## +## An optional fourth argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options are @code{@{"Qt", "Qbb", "Qc", "Qz"@}}. +## +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## To append user options to the defaults it is necessary to repeat the +## default arguments in @var{options}. Use a null string to pass no arguments. +## +## @seealso{delaunay, delaunayn, convhull, voronoi} +## @end deftypefn + +## Author: Kai Habel + +function tetr = delaunay3 (x, y, z, options) + + if (nargin < 3 || nargin > 4) + print_usage (); + endif + + if (! (isvector (x) && isvector (y) && isvector (z) + && length (x) == length (y) && length(x) == length (z))) + error ("delaunay: X, Y, and Z must be the same size"); + elseif (nargin == 4 && ! (ischar (options) || iscellstr (options))) + error ("delaunay3: OPTIONS must be a string or cell array of strings"); + endif + + if (nargin == 3) + tetr = delaunayn ([x(:), y(:), z(:)]); + else + tetr = delaunayn ([x(:), y(:), z(:)], options); + endif + +endfunction + + +%!testif HAVE_QHULL +%! x = [-1, -1, 1, 0, -1]; y = [-1, 1, 1, 0, -1]; z = [0, 0, 0, 1, 1]; +%! assert (sortrows (sort (delaunay3 (x, y, z), 2)), [1,2,3,4;1,2,4,5]) + +%% FIXME: Need input validation tests + diff --git a/octave_packages/m/geometry/delaunayn.m b/octave_packages/m/geometry/delaunayn.m new file mode 100644 index 0000000..ca04ad4 --- /dev/null +++ b/octave_packages/m/geometry/delaunayn.m @@ -0,0 +1,93 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{T} =} delaunayn (@var{pts}) +## @deftypefnx {Function File} {@var{T} =} delaunayn (@var{pts}, @var{options}) +## Compute the Delaunay triangulation for an N-dimensional set of points. +## The Delaunay triangulation is a tessellation of the convex hull of a set +## of points such that no N-sphere defined by the N-triangles contains +## any other points from the set. +## +## The input matrix @var{pts} of size [n, dim] contains n points in a space of +## dimension dim. The return matrix @var{T} has size [m, dim+1]. Each row +## of @var{T} contains a set of indices back into the original set of points +## @var{pts} which describes a simplex of dimension dim. For example, a 2-D +## simplex is a triangle and 3-D simplex is a tetrahedron. +## +## An optional second argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## The default options depend on the dimension of the input: +## +## @itemize +## @item 2-D and 3-D: @var{options} = @code{@{"Qt", "Qbb", "Qc", "Qz"@}} +## +## @item 4-D and higher: @var{options} = @code{@{"Qt", "Qbb", "Qc", "Qx"@}} +## @end itemize +## +## If @var{options} is not present or @code{[]} then the default arguments are +## used. Otherwise, @var{options} replaces the default argument list. +## To append user options to the defaults it is necessary to repeat the +## default arguments in @var{options}. Use a null string to pass no arguments. +## +## @seealso{delaunay, delaunay3, convhulln, voronoin} +## @end deftypefn + +function T = delaunayn (pts, varargin) + + if (nargin < 1) + print_usage (); + endif + + T = __delaunayn__ (pts, varargin{:}); + + if (isa (pts, "single")) + myeps = eps ("single"); + else + myeps = eps; + endif + + ## Try to remove the zero volume simplices. The volume of the i-th simplex is + ## given by abs(det(pts(T(i,1:end-1),:)-pts(T(i,2:end),:)))/prod(1:n) + ## (reference http://en.wikipedia.org/wiki/Simplex). Any simplex with a + ## relative volume less than some arbitrary criteria is rejected. The + ## criteria we use is the volume of the simplex corresponding to an + ## orthogonal simplex is equal edge length all equal to the edge length of + ## the original simplex. If the relative volume is 1e3*eps then the simplex + ## is rejected. Note division of the two volumes means that the factor + ## prod(1:n) is dropped. + idx = []; + [nt, n] = size (T); + ## FIXME: Vectorize this for loop or convert to delaunayn to .oct function + for i = 1:nt + X = pts(T(i,1:end-1),:) - pts(T(i,2:end),:); + if (abs (det (X)) / sqrt (sum (X .^ 2, 2)) < 1e3 * myeps) + idx(end+1) = i; + endif + endfor + T(idx,:) = []; + +endfunction + + +%% FIXME: Need tests for delaunayn + +%% FIXME: Need input validation tests + diff --git a/octave_packages/m/geometry/dsearch.m b/octave_packages/m/geometry/dsearch.m new file mode 100644 index 0000000..0648b87 --- /dev/null +++ b/octave_packages/m/geometry/dsearch.m @@ -0,0 +1,40 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{idx} =} dsearch (@var{x}, @var{y}, @var{tri}, @var{xi}, @var{yi}) +## @deftypefnx {Function File} {@var{idx} =} dsearch (@var{x}, @var{y}, @var{tri}, @var{xi}, @var{yi}, @var{s}) +## Return the index @var{idx} or the closest point in @code{@var{x}, @var{y}} +## to the elements @code{[@var{xi}(:), @var{yi}(:)]}. The variable @var{s} is +## accepted for compatibility but is ignored. +## @seealso{dsearchn, tsearch} +## @end deftypefn + +function idx = dsearch (x, y, tri, xi, yi, s) + if (nargin < 5 || nargin > 6) + print_usage (); + endif + idx = __dsearchn__ ([x(:), y(:)], [xi(:), yi(:)]); +endfunction + +%!shared x, y, tri +%! x = [-1;-1;1]; +%! y = [-1;1;-1]; +%! tri = [1,2,3]; +%!assert (dsearch(x,y,tri,1,1/3), 3); +%!assert (dsearch(x,y,tri,1/3,1), 2); diff --git a/octave_packages/m/geometry/dsearchn.m b/octave_packages/m/geometry/dsearchn.m new file mode 100644 index 0000000..48a99e1 --- /dev/null +++ b/octave_packages/m/geometry/dsearchn.m @@ -0,0 +1,57 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{idx} =} dsearchn (@var{x}, @var{tri}, @var{xi}) +## @deftypefnx {Function File} {@var{idx} =} dsearchn (@var{x}, @var{tri}, @var{xi}, @var{outval}) +## @deftypefnx {Function File} {@var{idx} =} dsearchn (@var{x}, @var{xi}) +## @deftypefnx {Function File} {[@var{idx}, @var{d}] =} dsearchn (@dots{}) +## Return the index @var{idx} or the closest point in @var{x} to the elements +## @var{xi}. If @var{outval} is supplied, then the values of @var{xi} that are +## not contained within one of the simplices @var{tri} are set to +## @var{outval}. Generally, @var{tri} is returned from @code{delaunayn +## (@var{x})}. +## @seealso{dsearch, tsearch} +## @end deftypefn + +function [idx, d] = dsearchn (x, tri, xi, outval) + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (nargin == 2) + [idx, d] = __dsearchn__ (x, tri); + else + [idx, d] = __dsearchn__ (x, xi); + if (nargin == 4) + idx2 = isnan (tsearchn (x, tri, xi)); + idx(idx2) = outval; + d(idx2) = outval; + endif + endif +endfunction + +%!shared x, tri +%! x = [-1,-1;-1,1;1,-1]; +%! tri = [1,2,3]; +%!assert (dsearchn(x,tri,[1,1/3]), 3); +%!assert (dsearchn(x,tri,[1,1/3],NaN), NaN); +%!assert (dsearchn(x,tri,[1,1/3],NA), NA); +%!assert (dsearchn(x,tri,[1/3,1]), 2); +%!assert (dsearchn(x,tri,[1/3,1],NaN), NaN); +%!assert (dsearchn(x,tri,[1/3,1],NA), NA); diff --git a/octave_packages/m/geometry/griddata.m b/octave_packages/m/geometry/griddata.m new file mode 100644 index 0000000..9d55f4e --- /dev/null +++ b/octave_packages/m/geometry/griddata.m @@ -0,0 +1,177 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{zi} =} griddata (@var{x}, @var{y}, @var{z}, @var{xi}, @var{yi}, @var{method}) +## @deftypefnx {Function File} {[@var{xi}, @var{yi}, @var{zi}] =} griddata (@var{x}, @var{y}, @var{z}, @var{xi}, @var{yi}, @var{method}) +## +## Generate a regular mesh from irregular data using interpolation. +## The function is defined by @code{@var{z} = f (@var{x}, @var{y})}. +## Inputs @code{@var{x}, @var{y}, @var{z}} are vectors of the same length +## or @code{@var{x}, @var{y}} are vectors and @code{@var{z}} is matrix. +## +## The interpolation points are all @code{(@var{xi}, @var{yi})}. If +## @var{xi}, @var{yi} are vectors then they are made into a 2-D mesh. +## +## The interpolation method can be @code{"nearest"}, @code{"cubic"} or +## @code{"linear"}. If method is omitted it defaults to @code{"linear"}. +## @seealso{delaunay} +## @end deftypefn + +## Author: Kai Habel +## Adapted-by: Alexander Barth +## xi and yi are not "meshgridded" if both are vectors +## of the same size (for compatibility) + +function [rx, ry, rz] = griddata (x, y, z, xi, yi, method) + + if (nargin == 5) + method = "linear"; + endif + if (nargin < 5 || nargin > 7) + print_usage (); + endif + + if (ischar (method)) + method = tolower (method); + endif + + if (isvector (x) && isvector (y) && all ([numel(y), numel(x)] == size (z))) + [x, y] = meshgrid (x, y); + elseif (! all (size (x) == size (y) & size (x) == size (z))) + if (isvector (z)) + error ("griddata: X, Y, and Z, be vectors of same length"); + else + error ("griddata: lengths of X, Y must match the columns and rows of Z"); + endif + endif + + ## Meshgrid xi and yi if they are a row and column vector. + if (rows (xi) == 1 && columns (yi) == 1) + [xi, yi] = meshgrid (xi, yi); + endif + + if (! size_equal (xi, yi)) + error ("griddata: XI and YI must be vectors or matrices of same size"); + endif + + [nr, nc] = size (xi); + + x = x(:); + y = y(:); + z = z(:); + + ## Triangulate data. + tri = delaunay (x, y); + zi = NaN (size (xi)); + + if (strcmp (method, "cubic")) + error ("griddata: cubic interpolation not yet implemented"); + + elseif (strcmp (method, "nearest")) + ## Search index of nearest point. + idx = dsearch (x, y, tri, xi, yi); + valid = !isnan (idx); + zi(valid) = z(idx(valid)); + + elseif (strcmp (method, "linear")) + ## Search for every point the enclosing triangle. + tri_list = tsearch (x, y, tri, xi(:), yi(:)); + + ## Only keep the points within triangles. + valid = !isnan (tri_list); + tri_list = tri_list(valid); + nr_t = rows (tri_list); + + tri = tri(tri_list,:); + + ## Assign x,y,z for each point of triangle. + x1 = x(tri(:,1)); + x2 = x(tri(:,2)); + x3 = x(tri(:,3)); + + y1 = y(tri(:,1)); + y2 = y(tri(:,2)); + y3 = y(tri(:,3)); + + z1 = z(tri(:,1)); + z2 = z(tri(:,2)); + z3 = z(tri(:,3)); + + ## Calculate norm vector. + N = cross ([x2-x1, y2-y1, z2-z1], [x3-x1, y3-y1, z3-z1]); + ## Normalize. + N = diag (norm (N, "rows")) \ N; + + ## Calculate D of plane equation + ## Ax+By+Cz+D = 0; + D = -(N(:,1) .* x1 + N(:,2) .* y1 + N(:,3) .* z1); + + ## Calculate zi by solving plane equation for xi, yi. + zi(valid) = -(N(:,1).*xi(:)(valid) + N(:,2).*yi(:)(valid) + D) ./ N(:,3); + + else + error ("griddata: unknown interpolation METHOD"); + endif + + if (nargout == 3) + rx = xi; + ry = yi; + rz = zi; + elseif (nargout == 1) + rx = zi; + elseif (nargout == 0) + mesh (xi, yi, zi); + endif +endfunction + +%!testif HAVE_QHULL +%! [xx,yy]=meshgrid(linspace(-1,1,32)); +%! x = xx(:); +%! x = x + 10 * (2 * round(rand(size(x))) - 1) * eps; +%! y = yy(:); +%! y = y + 10 * (2 * round(rand(size(y))) - 1) * eps; +%! z = sin(2*(x.^2+y.^2)); +%! zz = griddata(x,y,z,xx,yy,'linear'); +%! zz2 = sin(2*(xx.^2+yy.^2)); +%! zz2(isnan(zz)) = NaN; +%! assert (zz, zz2, 100 * eps) + +%!demo +%! x=2*rand(100,1)-1; +%! y=2*rand(size(x))-1; +%! z=sin(2*(x.^2+y.^2)); +%! [xx,yy]=meshgrid(linspace(-1,1,32)); +%! griddata(x,y,z,xx,yy); +%! title('nonuniform grid sampled at 100 points'); + +%!demo +%! x=2*rand(1000,1)-1; +%! y=2*rand(size(x))-1; +%! z=sin(2*(x.^2+y.^2)); +%! [xx,yy]=meshgrid(linspace(-1,1,32)); +%! griddata(x,y,z,xx,yy); +%! title('nonuniform grid sampled at 1000 points'); + +%!demo +%! x=2*rand(1000,1)-1; +%! y=2*rand(size(x))-1; +%! z=sin(2*(x.^2+y.^2)); +%! [xx,yy]=meshgrid(linspace(-1,1,32)); +%! griddata(x,y,z,xx,yy,'nearest'); +%! title('nonuniform grid sampled at 1000 points with nearest neighbor'); diff --git a/octave_packages/m/geometry/griddata3.m b/octave_packages/m/geometry/griddata3.m new file mode 100644 index 0000000..10e7f93 --- /dev/null +++ b/octave_packages/m/geometry/griddata3.m @@ -0,0 +1,84 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{vi} =} griddata3 (@var{x}, @var{y}, @var{z}, @var{v}, @var{xi}, @var{yi}, @var{zi}, @var{method}, @var{options}) +## +## Generate a regular mesh from irregular data using interpolation. +## The function is defined by @code{@var{v} = f (@var{x}, @var{y}, @var{z})}. +## The interpolation points are specified by @var{xi}, @var{yi}, @var{zi}. +## +## The interpolation method can be @code{"nearest"} or @code{"linear"}. +## If method is omitted it defaults to @code{"linear"}. +## @seealso{griddata, griddatan, delaunayn} +## @end deftypefn + +## Author: David Bateman + +function vi = griddata3 (x, y, z, v, xi, yi, zi, method, varargin) + + if (nargin < 7) + print_usage (); + endif + + if (!all (size (x) == size (y) & size (x) == size(z) & size(x) == size (v))) + error ("griddata3: X, Y, Z, and V must be vectors of same length"); + endif + + ## meshgrid xi, yi and zi if they are vectors unless they + ## are vectors of the same length + if (isvector (xi) && isvector (yi) && isvector (zi) + && (numel (xi) != numel (yi) || numel (xi) != numel (zi))) + [xi, yi, zi] = meshgrid (xi, yi, zi); + endif + + if (any (size(xi) != size(yi)) || any (size(xi) != size(zi))) + error ("griddata3: XI, YI and ZI must be vectors or matrices of same size"); + endif + + vi = griddatan ([x(:), y(:), z(:)], v(:), [xi(:), yi(:), zi(:)], varargin{:}); + vi = reshape (vi, size (xi)); + +endfunction + + +%!testif HAVE_QHULL +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 0); +%! x = 2 * rand (1000, 1) - 1; +%! y = 2 * rand (1000, 1) - 1; +%! z = 2 * rand (1000, 1) - 1; +%! v = x.^2 + y.^2 + z.^2; +%! [xi, yi, zi] = meshgrid (-0.8:0.2:0.8); +%! vi = griddata3 (x, y, z, v, xi, yi, zi, 'linear'); +%! vv = vi - xi.^2 - yi.^2 - zi.^2; +%! assert (max (abs (vv(:))), 0, 0.1); + +%!testif HAVE_QHULL +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 0); +%! x = 2 * rand (1000, 1) - 1; +%! y = 2 * rand (1000, 1) - 1; +%! z = 2 * rand (1000, 1) - 1; +%! v = x.^2 + y.^2 + z.^2; +%! [xi, yi, zi] = meshgrid (-0.8:0.2:0.8); +%! vi = griddata3 (x, y, z, v, xi, yi, zi, 'nearest'); +%! vv = vi - xi.^2 - yi.^2 - zi.^2; +%! assert (max (abs (vv(:))), 0, 0.1) diff --git a/octave_packages/m/geometry/griddatan.m b/octave_packages/m/geometry/griddatan.m new file mode 100644 index 0000000..37f15d2 --- /dev/null +++ b/octave_packages/m/geometry/griddatan.m @@ -0,0 +1,106 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{yi} =} griddatan (@var{x}, @var{y}, @var{xi}, @var{method}, @var{options}) +## +## Generate a regular mesh from irregular data using interpolation. +## The function is defined by @code{@var{y} = f (@var{x})}. +## The interpolation points are all @var{xi}. +## +## The interpolation method can be @code{"nearest"} or @code{"linear"}. +## If method is omitted it defaults to @code{"linear"}. +## @seealso{griddata, delaunayn} +## @end deftypefn + +## Author: David Bateman + +function yi = griddatan (x, y, xi, method, varargin) + + if (nargin == 3) + method = "linear"; + endif + if (nargin < 3) + print_usage (); + endif + + if (ischar (method)) + method = tolower (method); + endif + + [m, n] = size (x); + [mi, ni] = size (xi); + + if (n != ni || size (y, 1) != m || size (y, 2) != 1) + error ("griddatan: dimensional mismatch"); + endif + + ## triangulate data + ## tri = delaunayn(x, varargin{:}); + tri = delaunayn (x); + + yi = NaN (mi, 1); + + if (strcmp (method, "nearest")) + ## search index of nearest point + idx = dsearchn (x, tri, xi); + valid = !isnan (idx); + yi(valid) = y(idx(valid)); + + elseif (strcmp (method, "linear")) + ## search for every point the enclosing triangle + [tri_list, bary_list] = tsearchn (x, tri, xi); + + ## only keep the points within triangles. + valid = !isnan (tri_list); + tri_list = tri_list(!isnan (tri_list)); + bary_list = bary_list(!isnan (tri_list), :); + nr_t = rows (tri_list); + + ## assign x,y for each point of simplex + xt = reshape (x(tri(tri_list,:),:), [nr_t, n+1, n]); + yt = y(tri(tri_list,:)); + + ## Use barycentric coordinate of point to calculate yi + yi(valid) = sum (y(tri(tri_list,:)) .* bary_list, 2); + + else + error ("griddatan: unknown interpolation METHOD"); + endif + +endfunction + +%!testif HAVE_QHULL +%! [xx,yy] = meshgrid(linspace(-1,1,32)); +%! xi = [xx(:), yy(:)]; +%! x = (2 * rand(100,2) - 1); +%! x = [x;1,1;1,-1;-1,-1;-1,1]; +%! y = sin(2*(sum(x.^2,2))); +%! zz = griddatan(x,y,xi,'linear'); +%! zz2 = griddata(x(:,1),x(:,2),y,xi(:,1),xi(:,2),'linear'); +%! assert (zz, zz2, 1e-10) + +%!testif HAVE_QHULL +%! [xx,yy] = meshgrid(linspace(-1,1,32)); +%! xi = [xx(:), yy(:)]; +%! x = (2 * rand(100,2) - 1); +%! x = [x;1,1;1,-1;-1,-1;-1,1]; +%! y = sin(2*(sum(x.^2,2))); +%! zz = griddatan(x,y,xi,'nearest'); +%! zz2 = griddata(x(:,1),x(:,2),y,xi(:,1),xi(:,2),'nearest'); +%! assert (zz, zz2, 1e-10) diff --git a/octave_packages/m/geometry/inpolygon.m b/octave_packages/m/geometry/inpolygon.m new file mode 100644 index 0000000..488eab3 --- /dev/null +++ b/octave_packages/m/geometry/inpolygon.m @@ -0,0 +1,143 @@ +## Copyright (C) 2006-2012 Frederick (Rick) A Niles +## and S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{in}, @var{on}] =} inpolygon (@var{x}, @var{y}, @var{xv}, @var{yv}) +## +## For a polygon defined by vertex points @code{(@var{xv}, @var{yv})}, determine +## if the points @code{(@var{x}, @var{y})} are inside or outside the polygon. +## The variables @var{x}, @var{y}, must have the same dimension. The optional +## output @var{on} gives the points that are on the polygon. +## +## @end deftypefn + +## Author: Frederick (Rick) A Niles +## Created: 14 November 2006 + +## Vectorized by S�ren Hauberg + +## The method for determining if a point is in in a polygon is based on +## the algorithm shown on +## http://local.wasp.uwa.edu.au/~pbourke/geometry/insidepoly/ and is +## credited to Randolph Franklin. + +function [in, on] = inpolygon (x, y, xv, yv) + + if (nargin != 4) + print_usage (); + endif + + if (! (isreal (x) && isreal (y) && ismatrix (y) && ismatrix (y) + && size_equal (x, y))) + error ("inpolygon: first two arguments must be real matrices of same size"); + elseif (! (isreal (xv) && isreal (yv) && isvector (xv) && isvector (yv) + && size_equal (xv, yv))) + error ("inpolygon: last two arguments must be real vectors of same size"); + endif + + npol = length (xv); + do_boundary = (nargout >= 2); + + in = zeros (size(x), "logical"); + if (do_boundary) + on = zeros (size(x), "logical"); + endif + + j = npol; + for i = 1 : npol + delta_xv = xv(j) - xv(i); + delta_yv = yv(j) - yv(i); + ## distance = [distance from (x,y) to edge] * length(edge) + distance = delta_xv .* (y - yv(i)) - (x - xv(i)) .* delta_yv; + ## + ## is y between the y-values of edge i,j + ## AND (x,y) on the left of the edge ? + idx1 = (((yv(i) <= y & y < yv(j)) | (yv(j) <= y & y < yv(i))) + & 0 < distance.*delta_yv); + in (idx1) = !in (idx1); + + ## Check if (x,y) are actually on the boundary of the polygon. + if (do_boundary) + idx2 = (((yv(i) <= y & y <= yv(j)) | (yv(j) <= y & y <= yv(i))) + & ((xv(i) <= x & x <= xv(j)) | (xv(j) <= x & x <= xv(i))) + & (0 == distance | !delta_xv)); + on (idx2) = true; + endif + j = i; + endfor + +endfunction + +%!demo +%! xv=[ 0.05840, 0.48375, 0.69356, 1.47478, 1.32158, \ +%! 1.94545, 2.16477, 1.87639, 1.18218, 0.27615, \ +%! 0.05840 ]; +%! yv=[ 0.60628, 0.04728, 0.50000, 0.50000, 0.02015, \ +%! 0.18161, 0.78850, 1.13589, 1.33781, 1.04650, \ +%! 0.60628 ]; +%! xa=[0:0.1:2.3]; +%! ya=[0:0.1:1.4]; +%! [x,y]=meshgrid(xa,ya); +%! [in,on]=inpolygon(x,y,xv,yv); +%! +%! inside=in & !on; +%! plot(xv,yv) +%! hold on +%! plot(x(inside),y(inside),"@g") +%! plot(x(~in),y(~in),"@m") +%! plot(x(on),y(on),"@b") +%! hold off +%! disp("Green points are inside polygon, magenta are outside,"); +%! disp("and blue are on boundary."); + +%!demo +%! xv=[ 0.05840, 0.48375, 0.69356, 1.47478, 1.32158, \ +%! 1.94545, 2.16477, 1.87639, 1.18218, 0.27615, \ +%! 0.05840, 0.73295, 1.28913, 1.74221, 1.16023, \ +%! 0.73295, 0.05840 ]; +%! yv=[ 0.60628, 0.04728, 0.50000, 0.50000, 0.02015, \ +%! 0.18161, 0.78850, 1.13589, 1.33781, 1.04650, \ +%! 0.60628, 0.82096, 0.67155, 0.96114, 1.14833, \ +%! 0.82096, 0.60628]; +%! xa=[0:0.1:2.3]; +%! ya=[0:0.1:1.4]; +%! [x,y]=meshgrid(xa,ya); +%! [in,on]=inpolygon(x,y,xv,yv); +%! +%! inside=in & ~ on; +%! plot(xv,yv) +%! hold on +%! plot(x(inside),y(inside),"@g") +%! plot(x(~in),y(~in),"@m") +%! plot(x(on),y(on),"@b") +%! hold off +%! disp("Green points are inside polygon, magenta are outside,"); +%! disp("and blue are on boundary."); + +%!error inpolygon (); +%!error inpolygon (1, 2); +%!error inpolygon (1, 2, 3); + +%!error inpolygon (1, [1,2], [3, 4], [5, 6]); +%!error inpolygon ([1,2], [3, 4], [5, 6], 1); + +%!test +%! [in, on] = inpolygon ([1, 0], [1, 0], [-1, -1, 1, 1], [-1, 1, 1, -1]); +%! assert (in, [false, true]); +%! assert (on, [true, false]); diff --git a/octave_packages/m/geometry/rectint.m b/octave_packages/m/geometry/rectint.m new file mode 100644 index 0000000..ac09b03 --- /dev/null +++ b/octave_packages/m/geometry/rectint.m @@ -0,0 +1,131 @@ +## Copyright (C) 2008-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{area} =} rectint (@var{a}, @var{b}) +## +## Compute the area of intersection of rectangles in @var{a} and +## rectangles in @var{b}. Rectangles are defined as [x y width height] +## where x and y are the minimum values of the two orthogonal +## dimensions. +## +## If @var{a} or @var{b} are matrices, then the output, @var{area}, is a +## matrix where the i-th row corresponds to the i-th row of a and the j-th +## column corresponds to the j-th row of b. +## +## @seealso{polyarea} +## @end deftypefn + +## Author: Bill Denney + +function area = rectint (a, b) + + if (nargin != 2) + print_usage (); + elseif (ndims (a) != 2 || ndims (b) != 2) + error ("rectint: expecting arguments to be 2-d arrays"); + elseif (columns (a) != 4) + error ("rectint: A must have 4 columns"); + elseif (columns (b) != 4) + error ("rectint: B must have 4 columns"); + elseif any ([a(:,3:4);b(:,3:4)](:) < 0) + error ("rectint: all widths and heights must be > 0"); + endif + + ## This runs faster if the number of rows of a is greater than the + ## number of rows of b. Swap them and transpose to make it run + ## faster. + swapinputs = false (); + if (rows (a) > rows (b)) + tmp = a; + a = b; + b = tmp; + swapinputs = true (); + endif + + area = zeros (rows (a), rows (b)); + r1 = [a(:,1:2) a(:,1:2)+a(:,3:4)]; + r2 = [b(:,1:2) b(:,1:2)+b(:,3:4)]; + for i = 1:columns (area) + ## Find the location of each point relative to the other points. + r1x1small = r1(:,1) < r2(i,1); + r1x1large = r1(:,1) > r2(i,3); + r1x1mid = (r1(:,1) >= r2(i,1)) & (r1(:,1) <= r2(i,3)); + r1x2small = r1(:,3) < r2(i,1); + r1x2large = r1(:,3) > r2(i,3); + r1x2mid = (r1(:,3) >= r2(i,1)) & (r1(:,3) <= r2(i,3)); + + r1y1small = r1(:,2) < r2(i,2); + r1y1large = r1(:,2) > r2(i,4); + r1y1mid = (r1(:,2) >= r2(i,2)) & (r1(:,2) <= r2(i,4)); + r1y2small = r1(:,4) < r2(i,2); + r1y2large = r1(:,4) > r2(i,4); + r1y2mid = (r1(:,4) >= r2(i,2)) & (r1(:,4) <= r2(i,4)); + + ## determine the width of the rectangle + ## r1 completely encloses r2 + area(r1x1small & r1x2large,i) = r2(i,3) - r2(i,1); + ## the range goes from r2x min to r1x max + mask = r1x1small & r1x2mid; + area(mask,i) = r1(mask,3) - r2(i,1); + ## the range goes from r1x min to r2x max + mask = r1x1mid & r1x2large; + area(mask,i) = r2(i,3) - r1(mask,1); + ## the range goes from r1x min to r1x max + mask = r1x1mid & r1x2mid; + area(mask,i) = r1(mask,3) - r1(mask,1); + + ## determine the height of the rectangle + ## r1 completely encloses r2 + area(r1y1small & r1y2large,i) .*= r2(i,4) - r2(i,2); + ## the range goes from r2y min to r1y max + mask = r1y1small & r1y2mid; + area(mask,i) .*= r1(mask,4) - r2(i,2); + ## the range goes from r1y min to r2y max + mask = r1y1mid & r1y2large; + area(mask,i) .*= r2(i,4) - r1(mask,2); + ## the range goes from r1x min to r1x max + mask = r1y1mid & r1y2mid; + area(mask,i) .*= r1(mask,4) - r1(mask,2); + + endfor + + if swapinputs + area = area'; + endif + +endfunction + +## Tests +## Exactly overlapping +%!assert(rectint([0 0 1 1], [0 0 1 1]), 1) +## rect2 completely enclosed by rect1 +%!assert(rectint([-1 -1 3 3], [0 0 1 1]), 1) +## rect1 completely enclosed by rect2 +%!assert(rectint([0 0 1 1], [-1 -1 3 3]), 1) +## rect1 right and top in rect2 +%!assert(rectint([-1 -1 1.5 1.5], [0 0 1 1]), 0.25) +## rect2 right and top in rect1 +%!assert(rectint([0 0 1 1], [-1 -1 1.5 1.5]), 0.25) +## no overlap - shared corner +%!assert(rectint([0 0 1 1], [1 1 2 2]), 0) +## no overlap - shared edge +%!assert(rectint([0 0 1 1], [0 1 2 2]), 0) +## Correct orientation of output +%!assert(rectint([0 0 1 1;0.5 0.5 1 1;-1 -1 2 2], [1 1 2 2]), [0;0.25;0]) +%!assert(rectint([1 1 2 2], [0 0 1 1;0.5 0.5 1 1;-1 -1 2 2]), [0 0.25 0]) diff --git a/octave_packages/m/geometry/tsearchn.m b/octave_packages/m/geometry/tsearchn.m new file mode 100644 index 0000000..86875d2 --- /dev/null +++ b/octave_packages/m/geometry/tsearchn.m @@ -0,0 +1,107 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{idx}, @var{p}] =} tsearchn (@var{x}, @var{t}, @var{xi}) +## Search for the enclosing Delaunay convex hull. For @code{@var{t} = +## delaunayn (@var{x})}, finds the index in @var{t} containing the +## points @var{xi}. For points outside the convex hull, @var{idx} is NaN. +## If requested @code{tsearchn} also returns the Barycentric coordinates @var{p} +## of the enclosing triangles. +## @seealso{delaunay, delaunayn} +## @end deftypefn + +function [idx, p] = tsearchn (x, t, xi) + if (nargin != 3) + print_usage (); + endif + + nt = size (t, 1); + [m, n] = size (x); + mi = size (xi, 1); + idx = NaN (mi, 1); + p = NaN (mi, n + 1); + + ni = [1:mi].'; + for i = 1 : nt + ## Only calculate the Barycentric coordinates for points that have not + ## already been found in a triangle. + b = cart2bary (x (t (i, :), :), xi(ni,:)); + + ## Our points xi are in the current triangle if + ## (all(b >= 0) && all (b <= 1)). However as we impose that + ## sum(b,2) == 1 we only need to test all(b>=0). Note need to add + ## a small margin for rounding errors + intri = all (b >= -1e-12, 2); + idx(ni(intri)) = i; + p(ni(intri),:) = b(intri, :); + ni(intri) = []; + endfor +endfunction + +function Beta = cart2bary (T, P) + ## Conversion of Cartesian to Barycentric coordinates. + ## Given a reference simplex in N dimensions represented by a + ## (N+1)-by-(N) matrix, and arbitrary point P in cartesion coordinates, + ## represented by a N-by-1 row vector can be written as + ## + ## P = Beta * T + ## + ## Where Beta is a N+1 vector of the barycentric coordinates. A criteria + ## on Beta is that + ## + ## sum (Beta) == 1 + ## + ## and therefore we can write the above as + ## + ## P - T(end, :) = Beta(1:end-1) * (T(1:end-1,:) - ones(N,1) * T(end,:)) + ## + ## and then we can solve for Beta as + ## + ## Beta(1:end-1) = (P - T(end,:)) / (T(1:end-1,:) - ones(N,1) * T(end,:)) + ## Beta(end) = sum(Beta) + ## + ## Note below is generalize for multiple values of P, one per row. + [M, N] = size (P); + Beta = (P - ones (M,1) * T(end,:)) / (T(1:end-1,:) - ones(N,1) * T(end,:)); + Beta (:,end+1) = 1 - sum(Beta, 2); +endfunction + +%!shared x, tri +%! x = [-1,-1;-1,1;1,-1]; +%! tri = [1, 2, 3]; +%!test +%! [idx, p] = tsearchn (x,tri,[-1,-1]); +%! assert (idx, 1) +%! assert (p, [1,0,0], 1e-12) +%!test +%! [idx, p] = tsearchn (x,tri,[-1,1]); +%! assert (idx, 1) +%! assert (p, [0,1,0], 1e-12) +%!test +%! [idx, p] = tsearchn (x,tri,[1,-1]); +%! assert (idx, 1) +%! assert (p, [0,0,1], 1e-12) +%!test +%! [idx, p] = tsearchn (x,tri,[-1/3,-1/3]); +%! assert (idx, 1) +%! assert (p, [1/3,1/3,1/3], 1e-12) +%!test +%! [idx, p] = tsearchn (x,tri,[1,1]); +%! assert (idx, NaN) +%! assert (p, [NaN, NaN, NaN]) diff --git a/octave_packages/m/geometry/voronoi.m b/octave_packages/m/geometry/voronoi.m new file mode 100644 index 0000000..77c15d0 --- /dev/null +++ b/octave_packages/m/geometry/voronoi.m @@ -0,0 +1,187 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} voronoi (@var{x}, @var{y}) +## @deftypefnx {Function File} {} voronoi (@var{x}, @var{y}, @var{options}) +## @deftypefnx {Function File} {} voronoi (@dots{}, "linespec") +## @deftypefnx {Function File} {} voronoi (@var{hax}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} voronoi (@dots{}) +## @deftypefnx {Function File} {[@var{vx}, @var{vy}] =} voronoi (@dots{}) +## Plot the Voronoi diagram of points @code{(@var{x}, @var{y})}. +## The Voronoi facets with points at infinity are not drawn. +## +## If "linespec" is given it is used to set the color and line style of the +## plot. If an axis graphics handle @var{hax} is supplied then the Voronoi +## diagram is drawn on the specified axis rather than in a new figure. +## +## The @var{options} argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## +## If a single output argument is requested then the Voronoi diagram will be +## plotted and a graphics handle @var{h} to the plot is returned. +## [@var{vx}, @var{vy}] = voronoi(@dots{}) returns the Voronoi vertices +## instead of plotting the diagram. +## +## @example +## @group +## x = rand (10, 1); +## y = rand (size (x)); +## h = convhull (x, y); +## [vx, vy] = voronoi (x, y); +## plot (vx, vy, "-b", x, y, "o", x(h), y(h), "-g"); +## legend ("", "points", "hull"); +## @end group +## @end example +## +## @seealso{voronoin, delaunay, convhull} +## @end deftypefn + +## Author: Kai Habel +## First Release: 20/08/2000 + +## 2002-01-04 Paul Kienzle +## * limit the default graph to the input points rather than the whole diagram +## * provide example +## * use unique(x,"rows") rather than __unique_rows__ + +## 2003-12-14 Rafael Laboissiere +## Added optional fourth argument to pass options to the underlying +## qhull command + +function [vx, vy] = voronoi (varargin) + + if (nargin < 1) + print_usage (); + endif + + narg = 1; + if (isscalar (varargin{1}) && ishandle (varargin{1})) + handl = varargin{1}; + if (! strcmp (get (handl, "type"), "axes")) + error ("voronoi: expecting first argument to be an axes object"); + endif + narg++; + elseif (nargout < 2) + handl = gca (); + endif + + if (nargin < 1 + narg || nargin > 3 + narg) + print_usage (); + endif + + x = varargin{narg++}; + y = varargin{narg++}; + + opts = {}; + if (narg <= nargin) + if (iscell (varargin{narg})) + opts = varargin(narg++); + elseif (isnumeric (varargin{narg})) + ## Accept, but ignore, the triangulation + narg++; + endif + endif + + linespec = {"b"}; + if (narg <= nargin && ischar (varargin{narg})) + linespec = varargin(narg); + endif + + lx = length (x); + ly = length (y); + + if (lx != ly) + error ("voronoi: X and Y must be vectors of the same length"); + endif + + ## Add box to approximate rays to infinity. For Voronoi diagrams the + ## box can (and should) be close to the points themselves. To make the + ## job of finding the exterior edges it should be at least two times the + ## delta below however + xmax = max (x(:)); + xmin = min (x(:)); + ymax = max (y(:)); + ymin = min (y(:)); + xdelta = xmax - xmin; + ydelta = ymax - ymin; + scale = 2; + + xbox = [xmin - scale * xdelta; xmin - scale * xdelta; ... + xmax + scale * xdelta; xmax + scale * xdelta]; + ybox = [xmin - scale * xdelta; xmax + scale * xdelta; ... + xmax + scale * xdelta; xmin - scale * xdelta]; + + [p, c, infi] = __voronoi__ ("voronoi", + [[x(:) ; xbox(:)], [y(:); ybox(:)]], + opts{:}); + + idx = find (! infi); + ll = length (idx); + c = c(idx).'; + k = sum (cellfun ("length", c)); + edges = cell2mat (cellfun (@(x) [x ; [x(end), x(1:end-1)]], c, + "uniformoutput", false)); + + ## Identify the unique edges of the Voronoi diagram + edges = sortrows (sort (edges).').'; + edges = edges (:, [(edges(1, 1: end - 1) != edges(1, 2 : end) | ... + edges(2, 1 :end - 1) != edges(2, 2 : end)), true]); + + ## Eliminate the edges of the diagram representing the box + poutside = (1 : rows(p)) ... + (p (:, 1) < xmin - xdelta | p (:, 1) > xmax + xdelta | ... + p (:, 2) < ymin - ydelta | p (:, 2) > ymax + ydelta); + edgeoutside = ismember (edges (1, :), poutside) & ... + ismember (edges (2, :), poutside); + edges (:, edgeoutside) = []; + + ## Get points of the diagram + Vvx = reshape (p(edges, 1), size (edges)); + Vvy = reshape (p(edges, 2), size (edges)); + + if (nargout < 2) + lim = [xmin, xmax, ymin, ymax]; + h = plot (handl, Vvx, Vvy, linespec{:}, x, y, '+'); + axis (lim + 0.1 * [[-1, 1] * (lim (2) - lim (1)), ... + [-1, 1] * (lim (4) - lim (3))]); + if (nargout == 1) + vx = h; + endif + else + vx = Vvx; + vy = Vvy; + endif + +endfunction + + +%!demo +%! voronoi (rand(10,1), rand(10,1)); + +%!testif HAVE_QHULL +%! phi = linspace (-pi, 3/4*pi, 8); +%! [x,y] = pol2cart (phi, 1); +%! [vx,vy] = voronoi (x,y); +%! assert(vx(2,:), zeros (1, columns (vx)), eps); +%! assert(vy(2,:), zeros (1, columns (vy)), eps); + +%% FIXME: Need input validation tests + diff --git a/octave_packages/m/geometry/voronoin.m b/octave_packages/m/geometry/voronoin.m new file mode 100644 index 0000000..c2fc11f --- /dev/null +++ b/octave_packages/m/geometry/voronoin.m @@ -0,0 +1,67 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{C}, @var{F}] =} voronoin (@var{pts}) +## @deftypefnx {Function File} {[@var{C}, @var{F}] =} voronoin (@var{pts}, @var{options}) +## Compute N-dimensional Voronoi facets. The input matrix @var{pts} +## of size [n, dim] contains n points in a space of dimension dim. +## @var{C} contains the points of the Voronoi facets. The list @var{F} +## contains, for each facet, the indices of the Voronoi points. +## +## An optional second argument, which must be a string or cell array of strings, +## contains options passed to the underlying qhull command. +## See the documentation for the Qhull library for details +## @url{http://www.qhull.org/html/qh-quick.htm#options}. +## @seealso{voronoi, convhulln, delaunayn} +## @end deftypefn + +## Author: Kai Habel +## First Release: 20/08/2000 + +## 2003-12-14 Rafael Laboissiere +## Added optional second argument to pass options to the underlying +## qhull command + +function [C, F] = voronoin (pts, options) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + [np, dim] = size (pts); + + if (np <= dim) + error ("voronoin: number of points must be greater than their dimension"); + endif + + caller = "voronoin"; + + if (nargin == 1) + [C, F] = __voronoi__ (caller, pts); + else + [C, F] = __voronoi__ (caller, pts, options); + endif + +endfunction + + +%% FIXME: Need functional tests + +%% FIXME: Need input validation tests + diff --git a/octave_packages/m/help/__makeinfo__.m b/octave_packages/m/help/__makeinfo__.m new file mode 100644 index 0000000..4569be7 --- /dev/null +++ b/octave_packages/m/help/__makeinfo__.m @@ -0,0 +1,150 @@ +## Copyright (C) 2009-2012 S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{retval}, @var{status}] =} __makeinfo__ (@var{text}, @var{output_type}) +## @deftypefnx {Function File} {[@var{retval}, @var{status}] =} __makeinfo__ (@var{text}, @var{output_type}, @var{see_also}) +## Undocumented internal function. +## @end deftypefn + +## Run @code{makeinfo} on a given text. +## +## The string @var{text} is run through the @code{__makeinfo__} program +## to generate output in various formats. This string must contain valid +## Texinfo formatted text. +## +## The @var{output_type} selects the format of the output. This can be either +## @t{"html"}, @t{"texinfo"}, or @t{"plain text"}. By default this is +## @t{"plain text"}. If @var{output_type} is @t{"texinfo"}, the @t{@@seealso} +## macro is expanded, but otherwise the text is unaltered. +## +## If the optional argument @var{see_also} is present, it is used to expand the +## Octave specific @t{@@seealso} macro. This argument must be a function handle, +## that accepts a cell array of strings as input argument (each elements of the +## array corresponds to the arguments to the @t{@@seealso} macro), and return +## the expanded string. If this argument is not given, the @t{@@seealso} macro +## will be expanded to the text +## +## @example +## See also: arg1, arg2, ... +## @end example +## +## @noindent +## for @t{"plain text"} output, and +## +## @example +## See also: @@ref@{arg1@}, @@ref@{arg2@}, ... +## @end example +## +## @noindent +## otherwise. +## +## The optional output argument @var{status} contains the exit status of the +## @code{makeinfo} program as returned by @code{system}. + +function [retval, status] = __makeinfo__ (text, output_type = "plain text", fsee_also) + + ## Check input + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (! ischar (text)) + error ("__makeinfo__: first input argument must be a string"); + endif + + if (! ischar (output_type)) + error ("__makeinfo__: second input argument must be a string"); + endif + + if (nargin < 3) + if (strcmpi (output_type, "plain text")) + fsee_also = @(T) strcat ... + ("\nSee also:", sprintf (" %s,", T{:})(1:end-1), "\n"); + else + fsee_also = @(T) strcat ... + ("\nSee also:", sprintf (" @ref{%s},", T{:})(1:end-1), "\n"); + endif + endif + + if (! isa (fsee_also, "function_handle")) + error ("__makeinfo__: third input argument must be a function handle"); + endif + + + ## It seems like makeinfo sometimes gets angry if the first character + ## on a line is a space, so we remove these. + text = strrep (text, "\n ", "\n"); + + ## Handle @seealso macro + see_also_pat = '@seealso *\{(.*)\}'; + args = regexp (text, see_also_pat, 'tokens'); + for ii = 1:numel (args) + expanded = fsee_also (strtrim (strsplit (args{ii}{:}, ',', true))); + text = regexprep (text, see_also_pat, expanded, 'once'); + endfor + + ## Handle @nospell macro + text = regexprep (text, '@nospell *\{([^}]*)\}', "$1"); + ## Handle @xcode macro + text = regexprep (text, '@xcode *\{([^}]*)\}', "$1"); + + if (strcmpi (output_type, "texinfo")) + status = 0; + retval = text; + return; + endif + + ## Create the final TeXinfo input string + text = sprintf ("\\input texinfo\n\n%s\n\n@bye\n", text); + + unwind_protect + ## Write Texinfo to tmp file + template = "octave-help-XXXXXX"; + [fid, name] = mkstemp (fullfile (P_tmpdir, template), true); + if (fid < 0) + error ("__makeinfo__: could not create temporary file"); + endif + fwrite (fid, text); + fclose (fid); + + ## Take action depending on output type + switch (lower (output_type)) + case "plain text" + cmd = sprintf ("%s --no-headers --no-warn --force --no-validate %s", + makeinfo_program (), name); + case "html" + cmd = sprintf ("%s --no-headers --html --no-warn --no-validate --force %s", + makeinfo_program (), name); + otherwise + error ("__makeinfo__: unsupported output type: '%s'", output_type); + endswitch + + ## Call makeinfo + [status, retval] = system (cmd); + + unwind_protect_cleanup + if (exist (name, "file")) + delete (name); + endif + end_unwind_protect +endfunction + +## No test needed for internal helper function. +%!assert (1) + diff --git a/octave_packages/m/help/doc.m b/octave_packages/m/help/doc.m new file mode 100644 index 0000000..e277505 --- /dev/null +++ b/octave_packages/m/help/doc.m @@ -0,0 +1,111 @@ +## Copyright (C) 2005-2012 Søren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} doc @var{function_name} +## Display documentation for the function @var{function_name} +## directly from an on-line version of +## the printed manual, using the GNU Info browser. If invoked without +## any arguments, the manual is shown from the beginning. +## +## For example, the command @kbd{doc rand} starts the GNU Info browser +## at the @code{rand} node in the on-line version of the manual. +## +## Once the GNU Info browser is running, help for using it is available +## using the command @kbd{C-h}. +## @seealso{help} +## @end deftypefn + +## Author: Soren Hauberg +## Adapted-by: jwe + +function retval = doc (fname) + + if (nargin == 0 || nargin == 1) + + ftype = 0; + + if (nargin == 1) + ## Get the directory where the function lives. + ## FIXME -- maybe we should have a better way of doing this. + + if (ischar (fname)) + ftype = exist (fname); + else + error ("doc: expecting argument to be a character string"); + endif + else + fname = ""; + endif + + if (ftype == 2 || ftype == 3) + ffile = which (fname); + else + ffile = ""; + endif + + if (isempty (ffile)) + info_dir = octave_config_info ("infodir"); + else + info_dir = fileparts (ffile); + endif + + ## Determine if a file called doc.info exist in the same + ## directory as the function. + + info_file_name = fullfile (info_dir, "doc.info"); + + [stat_info, err] = stat (info_file_name); + + if (err < 0) + info_file_name = info_file (); + endif + + ## FIXME -- don't change the order of the arguments below because + ## the info-emacs-info script currently expects --directory DIR as + ## the third and fourth arguments. Someone should fix that. + + cmd = sprintf ("\"%s\" --file \"%s\" --directory \"%s\"", + info_program (), info_file_name, info_dir); + + have_fname = ! isempty (fname); + + if (have_fname) + status = system (sprintf ("%s --index-search %s", cmd, fname)); + endif + + if (! (have_fname && status == 0)) + status = system (cmd); + if (status == 127) + warning ("unable to find info program `%s'", info_program ()); + endif + endif + + if (nargout > 0) + retval = status; + endif + + else + print_usage (); + endif + +endfunction + +%!test if exist( info_file ()) != 2 && exist (sprintf ("%s.gz", info_file ())) != 2 +%! error ("Info file %s or %s.gz does not exist!", info_file (), info_file ()); +%! endif diff --git a/octave_packages/m/help/gen_doc_cache.m b/octave_packages/m/help/gen_doc_cache.m new file mode 100644 index 0000000..8e00010 --- /dev/null +++ b/octave_packages/m/help/gen_doc_cache.m @@ -0,0 +1,151 @@ +## Copyright (C) 2009-2012 S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gen_doc_cache (@var{out_file}, @var{directory}) +## Generate documentation caches for all functions in a given directory. +## +## A documentation cache is generated for all functions in @var{directory}. +## The +## resulting cache is saved in the file @var{out_file}. +## The cache is used to speed up @code{lookfor}. +## +## If no directory is given (or it is the empty matrix), a cache for builtin +## operators, etc. is generated. +## +## @seealso{lookfor, path} +## @end deftypefn + +function gen_doc_cache (out_file = "doc-cache", directory = []) + + ## Check input + if (!ischar (out_file)) + print_usage (); + endif + + ## Generate cache + if (isempty (directory)) + cache = gen_builtin_cache (); + elseif (ischar (directory)) + cache = gen_doc_cache_in_dir (directory); + else + error ("gen_doc_cache: second input argument must be a string"); + endif + + ## Save cache + if (! isempty (cache)) + save ("-text", out_file, "cache"); + endif +endfunction + +function [text, first_sentence, status] = handle_function (f, text, format) + first_sentence = ""; + ## Skip functions that start with __ as these shouldn't be searched by lookfor + if (length (f) > 2 && all (f (1:2) == "_")) + status = 1; + return; + endif + + ## Take action depending on help text format + switch (lower (format)) + case "plain text" + status = 0; + case "texinfo" + [text, status] = __makeinfo__ (text, "plain text"); + case "html" + [text, status] = strip_html_tags (text); + otherwise + status = 1; + endswitch + + ## Did we get the help text? + if (status != 0 || isempty (text)) + warning ("gen_doc_cache: unusable help text found in file '%s'", f); + return; + endif + + ## Get first sentence of help text + first_sentence = get_first_help_sentence (f); +endfunction + +function cache = create_cache (list) + cache = {}; + + ## For each function: + for n = 1:length (list) + f = list {n}; + + ## Get help text + [text, format] = get_help_text (f); + + [text, first_sentence, status] = handle_function (f, text, format); + + ## Did we get the help text? + if (status != 0) + continue; + endif + + ## Store the help text + cache (1, end+1) = f; + cache (2, end) = text; + cache (3, end) = first_sentence; + endfor +endfunction + +function cache = gen_doc_cache_in_dir (directory) + ## If 'directory' is not in the current path, add it so we search it + dir_in_path = false; + p = path (); + idx = find (p == pathsep ()); + prev_idx = 1; + for n = 1:length (idx) + f = p (prev_idx:idx (n)-1); + if (strcmp (f, directory)) + dir_in_path = true; + break; + endif + prev_idx = idx (n) + 1; + endfor + + if (!dir_in_path) + addpath (directory); + endif + + ## Get list of functions in directory and create cache + list = __list_functions__ (directory); + cache = create_cache (list); + + if (!dir_in_path) + rmpath (directory); + endif +endfunction + +function cache = gen_builtin_cache () + operators = __operators__ (); + keywords = __keywords__ (); + builtins = __builtins__ (); + list = {operators{:}, keywords{:}, builtins{:}}; + + cache = create_cache (list); +endfunction + + +%% No true tests desirable for this function. +%% Test input validation +%!error gen_doc_cache (1) + diff --git a/octave_packages/m/help/get_first_help_sentence.m b/octave_packages/m/help/get_first_help_sentence.m new file mode 100644 index 0000000..0b12399 --- /dev/null +++ b/octave_packages/m/help/get_first_help_sentence.m @@ -0,0 +1,165 @@ +## Copyright (C) 2009-2012 S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{text}, @var{status}] =} get_first_help_sentence (@var{name}) +## @deftypefnx {Function File} {[@var{text}, @var{status}] =} get_first_help_sentence (@var{name}, @var{max_len}) +## Return the first sentence of a function's help text. +## +## The first sentence is defined as the text after the function +## declaration until either the first period (".") or the first appearance of +## two consecutive newlines ("\n\n"). The text is truncated to a maximum +## length of @var{max_len}, which defaults to 80. +## +## The optional output argument @var{status} returns the status reported by +## @code{makeinfo}. If only one output argument is requested, and @var{status} +## is non-zero, a warning is displayed. +## +## As an example, the first sentence of this help text is +## +## @example +## @group +## get_first_help_sentence ("get_first_help_sentence") +## @print{} ans = Return the first sentence of a function's help text. +## @end group +## @end example +## @end deftypefn + +function [text, status] = get_first_help_sentence (name, max_len = 80) + ## Check input + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (!ischar (name)) + error ("get_first_help_sentence: NAME must be a string"); + endif + + if (!isnumeric (max_len) || max_len <= 0 || max_len != fix (max_len)) + error ("get_first_help_sentence: MAX_LEN must be positive integer"); + endif + + ## First, we get the raw help text + [help_text, format] = get_help_text (name); + + ## Then, we take action depending on the format + switch (lower (format)) + case "plain text" + [text, status] = first_sentence_plain_text (help_text, max_len); + case "texinfo" + [text, status] = first_sentence_texinfo (help_text, max_len); + case "html" + [text, status] = first_sentence_html (help_text, max_len); + case "not documented" + error ("get_first_help_sentence: `%s' is not documented\n", name); + case "not found" + error ("get_first_help_sentence: `%s' not found\n", name); + otherwise + error ("get_first_help_sentence: internal error: unsupported help text format: '%s'\n", format); + endswitch + + if (nargout <= 1 && status != 0) + warning ("get_first_help_sentence: couldn't run makeinfo on '%s'", name); + endif +endfunction + +## This function extracts the first sentence from a plain text help text +function [text, status] = first_sentence_plain_text (help_text, max_len) + ## Extract first line by searching for a period or a double line-end. + period_idx = find (help_text == '.', 1); + line_end_idx = strfind (help_text, "\n\n"); + text = help_text (1:min ([period_idx(:); line_end_idx(:); max_len; length(help_text)])); + status = 0; +endfunction + +## This function extracts the first sentence from a Texinfo help text. +## The function works by removing @def* from the texinfo text. After this, we +## render the text to plain text using makeinfo, and then extract the first line. +function [text, status] = first_sentence_texinfo (help_text, max_len) + ## Lines ending with "@\n" are continuation lines, so they should be concatenated + ## with the following line. + help_text = strrep (help_text, "@\n", " "); + + ## Find, and remove, lines that start with @def. This should remove things + ## such as @deftypefn, @deftypefnx, @defvar, etc. + keep = true (size (help_text)); + def_idx = strfind (help_text, "@def"); + if (!isempty (def_idx)) + endl_idx = find (help_text == "\n"); + for k = 1:length (def_idx) + endl = endl_idx (find (endl_idx > def_idx (k), 1)); + if (isempty (endl)) + keep (def_idx (k):end) = false; + else + keep (def_idx (k):endl) = false; + endif + endfor + + ## Remove the @end ... that corresponds to the @def we removed above + def1 = def_idx (1); + space_idx = find (help_text == " "); + space_idx = space_idx (find (space_idx > def1, 1)); + bracket_idx = find (help_text == "{" | help_text == "}"); + bracket_idx = bracket_idx (find (bracket_idx > def1, 1)); + if (isempty (space_idx) && isempty (bracket_idx)) + error ("get_first_help_sentence: couldn't parse texinfo"); + endif + sep_idx = min (space_idx, bracket_idx); + def_type = help_text (def1+1:sep_idx-1); + + end_idx = strfind (help_text, sprintf ("@end %s", def_type)); + if (isempty (end_idx)) + error ("get_first_help_sentence: couldn't parse texinfo"); + endif + endl = endl_idx (find (endl_idx > end_idx, 1)); + if (isempty (endl)) + keep (end_idx:end) = false; + else + keep (end_idx:endl) = false; + endif + + help_text = help_text (keep); + endif + + ## Run makeinfo to generate plain text + [help_text, status] = __makeinfo__ (help_text, "plain text"); + + ## Extract first line with plain text method. + text = first_sentence_plain_text (help_text, max_len); +endfunction + +## This function extracts the first sentence from a html help text. +## The function simply removes the tags and treats the text as plain text. +function [text, status] = first_sentence_html (help_text, max_len) + ## Strip tags + [help_text, status] = strip_html_tags (help_text); + + ## Extract first line with plain text method. + text = first_sentence_plain_text (help_text, max_len); +endfunction + +%!assert (strcmp (get_first_help_sentence('get_first_help_sentence'), "Return the first sentence of a function's help text.")); + +%% Test input validation +%!error get_first_help_sentence () +%!error get_first_help_sentence (1, 2, 3) +%!error get_first_help_sentence (1) +%!error get_first_help_sentence ('ls', 'a') +%!error get_first_help_sentence ('ls', 0) +%!error get_first_help_sentence ('ls', 80.1) + diff --git a/octave_packages/m/help/help.m b/octave_packages/m/help/help.m new file mode 100644 index 0000000..410bfcf --- /dev/null +++ b/octave_packages/m/help/help.m @@ -0,0 +1,185 @@ +## Copyright (C) 2009-2012 S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} help @var{name} +## @deftypefnx {Command} {} help @code{--list} +## Display the help text for @var{name}. For example, the command +## @kbd{help help} prints a short message describing the @code{help} +## command. +## +## Given the single argument @code{--list}, list all operators, +## keywords, built-in functions, and loadable functions available +## in the current session of Octave. +## +## If invoked without any arguments, @code{help} display instructions +## on how to access help from the command line. +## +## The help command can give you information about operators, but not the +## comma and semicolons that are used as command separators. To get help +## for those, you must type @kbd{help comma} or @kbd{help semicolon}. +## @seealso{doc, lookfor, which} +## @end deftypefn + +function retval = help (name) + + if (nargin == 0) + + puts ("\n\ + For help with individual commands and functions type\n\ +\n\ + help NAME\n\ +\n\ + (replace NAME with the name of the command or function you would\n\ + like to learn more about).\n\ +\n\ + For a more detailed introduction to GNU Octave, please consult the\n\ + manual. To read the manual from the prompt type\n\ +\n\ + doc\n\ +\n\ + GNU Octave is supported and developed by its user community.\n\ + For more information visit http://www.octave.org.\n\n"); + + elseif (nargin == 1 && ischar (name)) + + if (strcmp (name, "--list")) + tmp = do_list_functions (); + if (nargout == 0) + printf ("%s", tmp); + else + retval = tmp; + endif + return; + endif + + ## Get help text + [text, format] = get_help_text (name); + + ## Take action depending on help text format + switch (lower (format)) + case "plain text" + status = 0; + case "texinfo" + [text, status] = __makeinfo__ (text, "plain text"); + case "html" + [text, status] = strip_html_tags (text); + case "not documented" + error ("help: `%s' is not documented\n", name); + case "not found" + do_contents (name); + return; + otherwise + error ("help: internal error: unsupported help text format: '%s'\n", format); + endswitch + + ## Print text + if (status != 0) + warning ("help: Texinfo formatting filter exited abnormally; raw Texinfo source of help text follows...\n"); + endif + + if (nargout == 0) + which (name); + printf ("\n%s\n%s", text, __additional_help_message__ ()); + else + retval = text; + endif + + else + error ("help: invalid input\n"); + endif + +endfunction + +function retval = do_list_functions () + + operators = sprintf ("*** operators:\n\n%s\n\n", + list_in_columns (__operators__ ())); + + keywords = sprintf ("*** keywords:\n\n%s\n\n", + list_in_columns (__keywords__ ())); + + builtins = sprintf ("*** builtins:\n\n%s\n\n", + list_in_columns (__builtins__ ())); + + dirs = strsplit (path, pathsep); + flist = ""; + for i = 2:numel (dirs) + files = sort ({dir(fullfile (dirs{i}, "*.m")).name, ... + dir(fullfile (dirs{i}, "*.oct")).name, ... + dir(fullfile (dirs{i}, "*.mex")).name}); + + if (! isempty (files)) + flist = sprintf ("%s*** functions in %s:\n\n%s\n\n", + flist, dirs{i}, list_in_columns (files)); + endif + endfor + + retval = cstrcat (operators, keywords, builtins, flist); + +endfunction + +function do_contents (name) + + found = false; + + dlist = find_dir_in_path (name, "all"); + + for i = 1:numel (dlist) + fname = make_absolute_filename (fullfile (dlist{i}, "Contents.m")); + + [text, format] = get_help_text_from_file (fname); + + ## Take action depending on help text format + switch (lower (format)) + case "plain text" + status = 0; + case "texinfo" + [text, status] = __makeinfo__ (text, "plain text"); + case "html" + [text, status] = strip_html_tags (text); + endswitch + + if (! isempty (text)) + found = true; + ## Print text. + if (status != 0) + warning ("help: Texinfo formatting filter exited abnormally; raw Texinfo source of help text follows...\n"); + endif + printf ("%s:\n\n%s\n", fname, text); + endif + + endfor + + if (found) + puts (__additional_help_message__ ()); + else + msg = feval (missing_function_hook, name); + + if (isempty (msg)) + msg = sprintf ("`%s' not found", name); + endif + + error ("help: %s\n", msg); + endif + +endfunction + + +%!assert (! isempty (findstr (help ("ls"), "List directory contents"))) +%!error help (42) diff --git a/octave_packages/m/help/lookfor.m b/octave_packages/m/help/lookfor.m new file mode 100644 index 0000000..2b0f6d9 --- /dev/null +++ b/octave_packages/m/help/lookfor.m @@ -0,0 +1,191 @@ +## Copyright (C) 2009-2012 Søren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} lookfor @var{str} +## @deftypefnx {Command} {} lookfor -all @var{str} +## @deftypefnx {Function File} {[@var{func}, @var{helpstring}] =} lookfor (@var{str}) +## @deftypefnx {Function File} {[@var{func}, @var{helpstring}] =} lookfor ('-all', @var{str}) +## Search for the string @var{str} in all functions found in the current +## function search path. By default, @code{lookfor} searches for @var{str} +## in the first sentence of the help string of each function found. The entire +## help text of each function can be searched if the '-all' argument is +## supplied. All searches are case insensitive. +## +## Called with no output arguments, @code{lookfor} prints the list of +## matching functions to the terminal. Otherwise, the output arguments +## @var{func} and @var{helpstring} define the matching functions and the +## first sentence of each of their help strings. +## +## The ability of @code{lookfor} to correctly identify the first +## sentence of the help text is dependent on the format of the +## function's help. All Octave core functions are correctly +## formatted, but the same can not be guaranteed for external packages and +## user-supplied functions. Therefore, the use of the '-all' argument may +## be necessary to find related functions that are not a part of Octave. +## @seealso{help, doc, which} +## @end deftypefn + +function [out_fun, out_help_text] = lookfor (str, arg2) + + if (strcmpi (str, "-all")) + ## The difference between using '-all' and not, is which part of the caches + ## we search. The cache is organized such that the first column contains + ## the function name, the second column contains the full help text, and + ## the third column contains the first sentence of the help text. + str = arg2; + search_type = 2; # when using caches, search the second column + else + search_type = 3; # when using caches, search the third column + endif + str = lower (str); # Compare is case insensitive + + ## Search functions, operators, and keywords that come with Octave + cache_file = doc_cache_file (); + if (exist (cache_file, "file")) + [fun, help_text] = search_cache (str, cache_file, search_type); + had_core_cache = true; + else + fun = help_text = {}; + had_core_cache = false; + endif + + ## Search functions in new path dirs. + orig_path = strsplit (__pathorig__ (), pathsep ()); + + ## ditto for path. + new_path = strsplit (path (), pathsep ()); + + ## scratch out directories already covered by orig_path. + if (had_core_cache) + new_path = setdiff (new_path, orig_path); + endif + + for n = 1:numel (new_path) + elt = new_path{n}; + cache_file = fullfile (elt, "doc-cache"); + if (exist (cache_file, "file")) + ## We have a cache in the directory, then read it and search it! + [funs, hts] = search_cache (str, cache_file, search_type); + fun(end+1:end+length (funs)) = funs; + help_text(end+1:end+length (hts)) = hts; + else + ## We don't have a cache. Search files + funs_in_f = __list_functions__ (elt); + for m = 1:length (funs_in_f) + fn = funs_in_f{m}; + + ## Skip files that start with __ + if (length (fn) > 2 && strcmp (fn(1:2), "__")) + continue; + endif + + ## Extract first sentence + try + warn_state = warning (); + unwind_protect + warning ("off"); + first_sentence = get_first_help_sentence (fn, 1024); + status = 0; + unwind_protect_cleanup + warning (warn_state); + end_unwind_protect + catch + status = 1; + end_try_catch + + if (search_type == 2) # search entire help text + try + warn_state = warning (); + unwind_protect + warning ("off"); + [text, fmt] = get_help_text (fn); + status = 0; + unwind_protect_cleanup + warning (warn_state); + end_unwind_protect + catch + status = 1; + end_try_catch + + ## Take action depending on help text fmt + switch (lower (fmt)) + case "plain text" + status = 0; + case "texinfo" + [text, status] = __makeinfo__ (text, "plain text"); + case "html" + [text, status] = strip_html_tags (text); + otherwise + status = 1; + endswitch + + elseif (status == 0) # only search the first sentence of the help text + text = first_sentence; + endif + + ## Search the help text, if we can + if (status == 0 && ! isempty (strfind (lower (text), str))) + fun(end+1) = fn; + help_text(end+1) = first_sentence; + endif + endfor + endif + endfor + + if (nargout == 0) + ## Print the results (FIXME: it would be nice to break at word boundaries) + indent = 20; + term_width = (terminal_size ())(2); + desc_width = term_width - indent - 2; + indent_space = blanks (indent); + for k = 1:length (fun) + f = fun{k}; + f(end+1:indent-1) = " "; + puts ([f " "]); + lf = length (f); + desc = strtrim (strrep (help_text{k}, "\n", " ")); + ldesc = length (desc); + printf ("%s\n", desc(1:min (ldesc, desc_width - (lf - indent)))); + for start = (desc_width - (lf - indent) + 1):desc_width:ldesc + stop = min (start + desc_width, ldesc); + printf ("%s%s\n", indent_space, strtrim (desc (start:stop))); + endfor + endfor + + else + ## Return the results instead of displaying them + out_fun = fun; + out_help_text = help_text; + endif + +endfunction + +function [funs, help_texts] = search_cache (str, cache_file, search_type) + load (cache_file); + if (! isempty (cache)) + t1 = strfind (lower (cache (1, :)), str); + t2 = strfind (lower (cache (search_type, :)), str); + cache_idx = find (! (cellfun ("isempty", t1) & cellfun ("isempty", t2))); + funs = cache(1, cache_idx); + help_texts = cache(3, cache_idx); + else + funs = help_texts = {}; + endif +endfunction + diff --git a/octave_packages/m/help/print_usage.m b/octave_packages/m/help/print_usage.m new file mode 100644 index 0000000..3a1c521 --- /dev/null +++ b/octave_packages/m/help/print_usage.m @@ -0,0 +1,142 @@ +## Copyright (C) 2009-2012 S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} print_usage () +## @deftypefnx {Function File} {} print_usage (@var{name}) +## Print the usage message for a function. When called with no input arguments +## the @code{print_usage} function displays the usage message of the currently +## executing function. +## @seealso{help} +## @end deftypefn + +function print_usage (name) + x = dbstack (); + ## Handle input + if (nargin == 0) + ## Determine the name of the calling function + if (numel (x) > 1) + name = x (2).name; + else + error ("print_usage: invalid function\n"); + endif + fullpath = evalin ("caller", "mfilename (""fullpath"")"); + if (strcmp (fullpath(end-length(name)+1:end), name)) + fullname = [fullpath, ".m"]; + endif + elseif (!ischar (name)) + error ("print_usage: input argument must be a string"); + else + fullname = name; + endif + + ## Determine if we're called from top level. + at_toplev = length (x) < 2 || (length (x) == 2 && strcmp (x(2).name, name)); + + ## Do the actual work + [text, format] = get_help_text (fullname); + max_len = 80; + switch (lower (format)) + case "plain text" + [usage_string, status] = get_usage_plain_text (text, max_len); + case "texinfo" + [usage_string, status] = get_usage_texinfo (text, max_len); + case "html" + [usage_string, status] = get_usage_html (text, max_len); + case "not documented" + error ("print_usage: `%s' is not documented\n", name); + case "not found" + error ("print_usage: `%s' not found\n", name); + otherwise + error ("print_usage: internal error: unsupported help text format: '%s'\n", format); + endswitch + + ## Raise the final error + if (status != 0) + warning ("print_usage: Texinfo formatting filter exited abnormally"); + warning ("print_usage: raw Texinfo source of help text follows...\n"); + endif + + if (at_toplev) + error ("Invalid call to %s. Correct usage is:\n\n%s\n%s", + name, usage_string, __additional_help_message__ ()); + else + msg = sprintf ("Invalid call to %s. Correct usage is:\n\n%s", + name, usage_string); + ## Ensure that the error doesn't end up with a newline, as that disables + ## backtraces. + if (msg(end) == "\n") + msg(end) = " "; + endif + + error (msg); + endif + +endfunction + +function [retval, status] = get_usage_plain_text (help_text, max_len) + ## Extract first line by searching for a double line-end. + line_end_idx = strfind (help_text, "\n\n"); + retval = help_text (1:min ([line_end_idx , max_len, length(help_text)])); + status = 0; +endfunction + +function [retval, status] = get_usage_texinfo (help_text, max_len) + ## Lines ending with "@\n" are continuation lines, so they should be + ## concatenated with the following line. + help_text = strrep (help_text, "@\n", " "); + + ## Find, and keep, lines that start with @def or @end def. This should include things + ## such as @deftypefn, @deftypefnx, @defvar, etc. and their corresponding @end's + def_idx = strfind (help_text, "@def"); + if (!isempty (def_idx)) + buffer = ""; + endl_idx = find (help_text == "\n"); + for k = 1:length (def_idx) + endl = endl_idx (find (endl_idx > def_idx (k), 1)); + if (isempty (endl)) + buffer = strcat (buffer, help_text (def_idx (k):end), "\n"); + else + buffer = strcat (buffer, help_text (def_idx (k):endl)); + endif + endfor + + end_def_idx = strfind (help_text, "@end def"); + if (!isempty (end_def_idx)) + buffer = strcat (buffer, help_text (end_def_idx:end)); + endif + else + [retval, status] = get_usage_plain_text (help_text, max_len); + endif + + ## Run makeinfo to generate plain text + [retval, status] = __makeinfo__ (buffer, "plain text"); +endfunction + +function [retval, status] = get_usage_html (help_text, max_len) + ## Strip tags + [help_text, status] = strip_html_tags (help_text); + + ## Extract first line with plain text method. + retval = get_usage_plain_text (help_text, max_len); +endfunction + + +## Stop reporting function as missing tests. No good tests possible. +%!assert (1) + diff --git a/octave_packages/m/help/private/__additional_help_message__.m b/octave_packages/m/help/private/__additional_help_message__.m new file mode 100644 index 0000000..c4cf641 --- /dev/null +++ b/octave_packages/m/help/private/__additional_help_message__.m @@ -0,0 +1,39 @@ +## Copyright (C) 2009-2012 Søren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __additional_help_message__ () +## Undocumented internal function. +## @end deftypefn + +function msg = __additional_help_message__ () + + if (suppress_verbose_help_message ()) + msg = ""; + else + msg = "\ +Additional help for built-in functions and operators is\n\ +available in the on-line version of the manual. Use the command\n\ +`doc ' to search the manual index.\n\ +\n\ +Help and information about Octave is also available on the WWW\n\ +at http://www.octave.org and via the help@octave.org\n\ +mailing list.\n"; + endif + +endfunction diff --git a/octave_packages/m/help/private/__strip_html_tags__.m b/octave_packages/m/help/private/__strip_html_tags__.m new file mode 100644 index 0000000..a779174 --- /dev/null +++ b/octave_packages/m/help/private/__strip_html_tags__.m @@ -0,0 +1,81 @@ +## Copyright (C) 2009-2012 Søren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{text}, @var{status}] =} __strip_html_tags__ (@var{html_text}) +## Undocumented internal function. +## @end deftypefn + +## Remove HTML tags from text. This is used as a simple HTML-to-text +## function. + +function [text, status] = __strip_html_tags__ (html_text) + start = find (html_text == "<"); + stop = find (html_text == ">"); + if (length (start) == length (stop)) + text = html_text; + for n = length(start):-1:1 + text (start (n):stop (n)) = []; + endfor + text = strip_superfluous_endlines (text); + status = 0; + else + warning ("help: invalid HTML data -- raw HTML source follows..."); + disp (html_text); + text = ""; + status = 1; + endif +endfunction + +## This function removes end-lines (\n) that makes printing look bad +function text = strip_superfluous_endlines (text) + ## Find groups of end-lines + els = find (text == "\n"); + dels = diff (els); + groups = [els(1), 1]; # list containing [start, length] of each group + for k = 1:length (dels) + if (dels (k) == 1) + groups (end, 2) ++; + else + groups (end+1, 1:2) = [els(k+1), 1]; + endif + endfor + + keep = true (size (text)); + + ## Remove end-lines in the beginning + if (groups (1, 1) == 1) + keep (1:groups (1, 2)) = false; + endif + + ## Remove end-lines from the end + if (sum (groups (end, :)) - 1 == length (text)) + keep (groups (end, 1):end) = false; + endif + + ## Remove groups of end-lines with more than 3 end-lines next to each other + idx = find (groups (:, 2) >= 3); + for k = 1:length (idx) + start = groups (idx (k), 1); + stop = start + groups (idx (k), 2) - 1; + keep (start+2:stop) = false; + endfor + + ## Actually remove the elements + text = text (keep); +endfunction diff --git a/octave_packages/m/help/type.m b/octave_packages/m/help/type.m new file mode 100644 index 0000000..7a3c465 --- /dev/null +++ b/octave_packages/m/help/type.m @@ -0,0 +1,124 @@ +## Copyright (C) 2009-2012 S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} type @var{name} @dots{} +## @deftypefnx {Command} {} type -q @var{name} @dots{} +## @deftypefnx {Function File} {dfns =} type ("@var{name}", @dots{}) +## Display the definition of each @var{name} that refers to a function. +## +## Normally also displays whether each @var{name} is user-defined or built-in; +## the @option{-q} option suppresses this behavior. +## +## If an output argument is requested nothing is displayed. Instead, a cell +## array of strings is returned, where each element corresponds to the +## definition of each requested function. +## @end deftypefn + +function retval = type (varargin) + ## Parse input + if (nargin == 0) + error ("type: not enough input arguments"); + endif + + if (!iscellstr (varargin)) + error ("type: input arguments must be strings"); + endif + + quiet = false; + idx = strcmpi (varargin, "-q") | strcmpi (varargin, "-quiet"); + if (any (idx)) + quiet = true; + varargin (idx) = []; + endif + + if (nargout > 0) + retval = cell (size (varargin)); + endif + + for n = 1:length (varargin) + name = varargin {n}; + + ## Find function and get its code + text = ""; + cmd = sprintf ("exist ('%s')", name); + e = evalin ("caller", cmd); + if (e == 1) + ## Variable + cmd = sprintf ("disp (%s);", name); + desc = evalin ("caller", cmd); + if (quiet) + text = desc; + else + text = sprintf ("%s is a variable\n%s", name, desc); + endif + elseif (e == 2) + ## m-file or ordinary file + file = which (name); + if (isempty (file)) + ## 'name' is an ordinary file, and not a function name. + ## FIXME: Should we just print it anyway? + error ("type: `%s' undefined\n", name); + endif + + ## Read the file + fid = fopen (file, "r"); + if (fid < 0) + error ("type: couldn't open `%s' for reading", file); + endif + contents = char (fread (fid).'); + fclose (fid); + + if (quiet) + text = contents; + else + text = sprintf ("%s is the user-defined function defined from: %s\n\n%s", + name, file, contents); + endif + elseif (e == 3) + text = sprintf ("%s is a dynamically-linked function", name); + elseif (e == 5) + text = sprintf ("%s is a built-in function", name); + elseif (any (strcmp (__operators__ (), name))) + text = sprintf ("%s is an operator", name); + elseif (any (strcmp (__keywords__ (), name))) + text = sprintf ("%s is a keyword", name); + else + error ("type: `%s' undefined\n", name); + endif + + ## Should we return the text or print if + if (nargout == 0) + disp (text); + else + retval {n} = text; + endif + endfor +endfunction + +%!test +%! var = 1; +%! typestr = type ("var"); +%! typestr = typestr{1}(1:17); +%! assert (typestr, "var is a variable"); + +%!assert (type ('dot'){1}, "dot is a dynamically-linked function") +%!assert (type ('cat'){1}, "cat is a built-in function") +%!assert (type ('+'){1}, "+ is an operator") +%!assert (type ('end'){1}, "end is a keyword") +%!error (type ('NO_NAME')) diff --git a/octave_packages/m/help/unimplemented.m b/octave_packages/m/help/unimplemented.m new file mode 100644 index 0000000..080a6be --- /dev/null +++ b/octave_packages/m/help/unimplemented.m @@ -0,0 +1,435 @@ +## Copyright (C) 2010-2012 John W. Eaton +## Copyright (C) 2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unimplemented () +## Undocumented internal function. +## @end deftypefn + +function txt = unimplemented (fcn) + + is_matlab_function = true; + + ## Some smarter cases, add more as needed. + switch (fcn) + + case "importdata" + txt = ["importdata is not implemented. Similar functionality is ",... + "available through @code{load}, @code{dlmread}, @code{csvread}, ",... + "or @code{textscan}."]; + + case "quad2d" + txt = ["quad2d is not implemented. Consider using dblquad."]; + + case "gsvd" + txt = ["gsvd is not currently part of core Octave. See the ", + "linear-algebra package at @url{http://octave.sf.net/linear-algebra/}."]; + + case "linprog" + txt = ["Octave does not currently provide linprog. ",... + "Linear programming problems may be solved using @code{glpk}. ",... + "Try @code{help glpk} for more info."]; + + case {"ode113", "ode15i", "ode15s", "ode23", "ode23s", "ode23t", "ode45", "odeget", "odeset"} + txt = ["Octave provides lsode for solving differential equations. ",... + "For more information try @code{help lsode}. ",... + "Matlab-compatible ODE functions are provided by the odepkg package. ",... + "See @url{http://octave.sf.net/odepkg/}."]; + + otherwise + if (ismember (fcn, missing_functions ())) + txt = sprintf ("the `%s' function is not yet implemented in Octave", fcn); + else + is_matlab_function = false; + txt = ""; + endif + endswitch + + if (is_matlab_function) + txt = [txt, "\n\n@noindent\nPlease read ",... + "@url{http://www.octave.org/missing.html} to learn how ",... + "you can contribute missing functionality."]; + txt = __makeinfo__ (txt); + endif + + if (nargout == 0) + warning ("Octave:missing-function", "%s", txt); + endif + +endfunction + +function list = missing_functions () + persistent list = { + "DelaunayTri", + "MException", + "RandStream", + "TriRep", + "TriScatteredInterp", + "align", + "alim", + "alpha", + "alphamap", + "annotation", + "audiodevinfo", + "audioplayer", + "audiorecorder", + "aufinfo", + "auread", + "auwrite", + "avifile", + "aviinfo", + "aviread", + "bar3", + "bar3h", + "bench", + "betaincinv", + "bicgstabl", + "brush", + "builddocsearchdb", + "bvp4c", + "bvp5c", + "bvpget", + "bvpinit", + "bvpset", + "bvpxtend", + "callSoapService", + "calllib", + "camdolly", + "cameratoolbar", + "camlight", + "camlookat", + "camorbit", + "campan", + "campos", + "camproj", + "camroll", + "camtarget", + "camup", + "camva", + "camzoom", + "cdf2rdf", + "cdfepoch", + "cdfinfo", + "cdfread", + "cdfwrite", + "cellplot", + "checkin", + "checkout", + "cholinc", + "clearvars", + "clipboard", + "cmopts", + "cmpermute", + "cmunique", + "colordef", + "colormapeditor", + "commandhistory", + "commandwindow", + "condeig", + "coneplot", + "contourslice", + "copyobj", + "createClassFromWsdl", + "createSoapMessage", + "customverctrl", + "daqread", + "datacursormode", + "datatipinfo", + "dbmex", + "dde23", + "ddeget", + "ddesd", + "ddeset", + "decic", + "depdir", + "depfun", + "deval", + "dialog", + "dither", + "docopt", + "docsearch", + "dragrect", + "dynamicprops", + "echodemo", + "ellipj", + "ellipke", + "erfcinv", + "errordlg", + "evalc", + "exifread", + "expint", + "export2wsdlg", + "figurepalette", + "filebrowser", + "fill3", + "findfigs", + "fitsinfo", + "fitsread", + "flow", + "fminsearch", + "frame2im", + "freqspace", + "funm", + "gallery", + "gammaincinv", + "gco", + "getframe", + "getpixelposition", + "gmres", + "grabcode", + "graymon", + "gsvd", + "guidata", + "guide", + "guihandles", + "handle", + "hdf", + "hdf5", + "hdf5info", + "hdf5read", + "hdf5write", + "hdfinfo", + "hdfread", + "hdftool", + "helpbrowser", + "helpdesk", + "helpdlg", + "helpwin", + "hgexport", + "hgload", + "hgsave", + "hgsetget", + "hgtransform", + "hostid", + "ilu", + "im2frame", + "im2java", + "imapprox", + "imformats", + "import", + "importdata", + "inmem", + "inputParser", + "inputdlg", + "inspect", + "instrfind", + "instrfindall", + "interpstreamspeed", + "iscom", + "isinterface", + "isjava", + "isocaps", + "isstudent", + "javaArray", + "javaMethod", + "javaMethodEDT", + "javaObject", + "javaObjectEDT", + "javaaddpath", + "javachk", + "javaclasspath", + "javarmpath", + "ldl", + "libfunctions", + "libfunctionsview", + "libisloaded", + "libpointer", + "libstruct", + "light", + "lightangle", + "lighting", + "linkaxes", + "linkdata", + "linsolve", + "listdlg", + "listfonts", + "loadlibrary", + "lscov", + "lsqr", + "makehgtform", + "material", + "matlabrc", + "maxNumCompThreads", + "memmapfile", + "memory", + "metaclass", + "methodsview", + "minres", + "mlint", + "mlintrpt", + "mmfileinfo", + "mmreader", + "movegui", + "movie", + "movie2avi", + "msgbox", + "multibandread", + "multibandwrite", + "native2unicode", + "noanimate", + "ode113", + "ode15i", + "ode15s", + "ode23", + "ode23s", + "ode23t", + "ode23tb", + "ode45", + "odefile", + "odeget", + "odeset", + "odextend", + "open", + "openfig", + "opengl", + "openvar", + "ordeig", + "ordqz", + "ordschur", + "padecoef", + "pagesetupdlg", + "pan", + "parseSoapResponse", + "path2rc", + "pathtool", + "pcode", + "pdepe", + "pdeval", + "playshow", + "plotbrowser", + "plotedit", + "plottools", + "polyeig", + "prefdir", + "preferences", + "printdlg", + "printopt", + "printpreview", + "profile", + "profsave", + "propedit", + "propertyeditor", + "publish", + "qmr", + "quad2d", + "questdlg", + "rbbox", + "reducepatch", + "reducevolume", + "resample", + "rgbplot", + "root", + "rotate", + "rotate3d", + "selectmoveresize", + "sendmail", + "serial", + "setpixelposition", + "showplottool", + "shrinkfaces", + "smooth3", + "snapnow", + "sound", + "soundsc", + "ss2tf", + "stream2", + "stream3", + "streamline", + "streamparticles", + "streamribbon", + "streamslice", + "streamtube", + "strings", + "subvolume", + "superclasses", + "support", + "surf2patch", + "symmlq", + "syntax", + "tetramesh", + "texlabel", + "textwrap", + "tfqmr", + "timer", + "timerfind", + "timerfindall", + "timeseries", + "toolboxdir", + "tscollection", + "tstool", + "uibuttongroup", + "uicontextmenu", + "uicontrol", + "uigetpref", + "uiimport", + "uiopen", + "uipanel", + "uipushtool", + "uiresume", + "uisave", + "uisetcolor", + "uisetfont", + "uisetpref", + "uistack", + "uitable", + "uitoggletool", + "uitoolbar", + "uiwait", + "undocheckout", + "unicode2native", + "unloadlibrary", + "unmesh", + "userpath", + "validateattributes", + "verLessThan", + "viewmtx", + "visdiff", + "volumebounds", + "waitfor", + "warndlg", + "waterfall", + "wavfinfo", + "wavplay", + "wavrecord", + "web", + "whatsnew", + "wk1finfo", + "wk1read", + "wk1write", + "workspace", + "xlsfinfo", + "xlsread", + "xlswrite", + "xmlread", + "xmlwrite", + "xslt", + "zoom", + }; +endfunction + + +%!test +%! str = unimplemented ("no_name_function"); +%! assert (isempty (str)); +%! str = unimplemented ("quad2d"); +%! assert (str(1:51), "quad2d is not implemented. Consider using dblquad."); +%! str = unimplemented ("MException"); +%! assert (str(1:58), "the `MException' function is not yet implemented in Octave"); + + diff --git a/octave_packages/m/help/which.m b/octave_packages/m/help/which.m new file mode 100644 index 0000000..4c7d673 --- /dev/null +++ b/octave_packages/m/help/which.m @@ -0,0 +1,65 @@ +## Copyright (C) 2009-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} which name @dots{} +## Display the type of each @var{name}. If @var{name} is defined from a +## function file, the full name of the file is also displayed. +## @seealso{help, lookfor} +## @end deftypefn + +function varargout = which (varargin) + + if (nargin > 0 && iscellstr (varargin)) + m = __which__ (varargin{:}); + + if (nargout == 0) + for i = 1:nargin + if (isempty (m(i).file)) + if (! isempty (m(i).type)) + printf ("`%s' is a %s\n", + m(i).name, m(i).type); + endif + else + if (isempty (m(i).type)) + printf ("`%s' is the file %s\n", + m(i).name, m(i).file); + else + printf ("`%s' is a %s from the file %s\n", + m(i).name, m(i).type, m(i).file); + endif + endif + endfor + else + varargout = {m.file}; + endif + else + print_usage (); + endif + +endfunction + + +%!test +%! str = which ("ls"); +%! assert (str(end-17:end), strcat ("miscellaneous", filesep(), "ls.m")); +%!test +%! str = which ("dot"); +%! assert (str(end-6:end), "dot.oct"); + +%!assert (which ("NO_NAME"), ""); diff --git a/octave_packages/m/image/autumn.m b/octave_packages/m/image/autumn.m new file mode 100644 index 0000000..9f7dc32 --- /dev/null +++ b/octave_packages/m/image/autumn.m @@ -0,0 +1,61 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} autumn () +## @deftypefnx {Function File} {@var{map} =} autumn (@var{n}) +## Create color colormap. This colormap ranges from red through orange +## to yellow. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = autumn (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("autumn: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [1, 0, 0]; + elseif (n > 1) + r = ones (n, 1); + g = (0:n - 1)' ./ (n - 1); + b = zeros (n, 1); + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'autumn' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (autumn (64)) + diff --git a/octave_packages/m/image/bone.m b/octave_packages/m/image/bone.m new file mode 100644 index 0000000..a004d19 --- /dev/null +++ b/octave_packages/m/image/bone.m @@ -0,0 +1,64 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} bone () +## @deftypefnx {Function File} {@var{map} =} bone (@var{n}) +## Create color colormap. This colormap varies from black to white with +## gray-blue shades. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = bone (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("bone: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [0, 0, 0]; + elseif (n > 1) + x = linspace (0, 1, n)'; + + r = (x < 3/4) .* (7/8 * x) + (x >= 3/4) .* (11/8 * x - 3/8); + g = (x < 3/8) .* (7/8 * x)\ + + (x >= 3/8 & x < 3/4) .* (29/24 * x - 1/8)\ + + (x >= 3/4) .* (7/8 * x + 1/8); + b = (x < 3/8) .* (29/24 * x) + (x >= 3/8) .* (7/8 * x + 1/8); + map = [r, g, b]; + else + map = []; + endif +endfunction + +%!demo +%! ## Show the 'bone' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (bone (64)) + diff --git a/octave_packages/m/image/brighten.m b/octave_packages/m/image/brighten.m new file mode 100644 index 0000000..46d95e9 --- /dev/null +++ b/octave_packages/m/image/brighten.m @@ -0,0 +1,76 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map_out} =} brighten (@var{map}, @var{beta}) +## @deftypefnx {Function File} {@var{map_out} =} brighten (@var{h}, @var{beta}) +## @deftypefnx {Function File} {@var{map_out} =} brighten (@var{beta}) +## Darken or brighten the given colormap. If the @var{map} argument +## is omitted, the function is applied to the current colormap. The first +## argument can also be a valid graphics handle @var{h}, in which case +## @code{brighten} is applied to the colormap associated with this handle. +## +## Should the resulting colormap @var{map_out} not be assigned, it will be +## written to the current colormap. +## +## The argument @var{beta} should be a scalar between -1 and 1, +## where a negative value darkens and a positive value brightens +## the colormap. +## @seealso{colormap} +## @end deftypefn + +function rmap = brighten (arg1, beta) + h = -1; + if (nargin == 1) + beta = arg1; + m = colormap; + h = gcf (); + elseif (nargin == 2) + if (ishandle (arg1)) + h = arg1; + m = get (h, "colormap"); + elseif (ismatrix (arg1) && columns (arg1) == 3) + m = arg1; + else + error ("brighten: first argument must be an Nx3 matrix or a handle"); + endif + else + print_usage (); + endif + + if (! isscalar (beta) || beta <= -1 || beta >= 1) + error ("brighten: BETA must be a scalar in the range (-1,1)"); + endif + + if (beta > 0) + gamma = 1 - beta; + else + gamma = 1 / (1 + beta); + endif + + if (nargout == 0) + if (ishandle (h)) + set (h, "colormap", m .^ gamma); + else + colormap (m .^ gamma); + endif + else + rmap = m .^ gamma; + endif + +endfunction diff --git a/octave_packages/m/image/colormap.m b/octave_packages/m/image/colormap.m new file mode 100644 index 0000000..51c1dbe --- /dev/null +++ b/octave_packages/m/image/colormap.m @@ -0,0 +1,74 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} colormap (@var{map}) +## @deftypefnx {Function File} {} colormap ("default") +## Set the current colormap. +## +## @code{colormap (@var{map})} sets the current colormap to @var{map}. The +## color map should be an @var{n} row by 3 column matrix. The columns +## contain red, green, and blue intensities respectively. All entries +## should be between 0 and 1 inclusive. The new colormap is returned. +## +## @code{colormap ("default")} restores the default colormap (the +## @code{jet} map with 64 entries). The default colormap is returned. +## +## With no arguments, @code{colormap} returns the current color map. +## @seealso{jet} +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function cmap = colormap (map) + + if (nargin > 1) + print_usage (); + endif + + if (nargin == 1) + + if (ischar (map)) + if (strcmp (map, "default")) + map = jet (64); + else + map = feval (map); + endif + endif + + if (! isempty (map)) + if (columns (map) != 3) + error ("colormap: MAP must have 3 columns: [R,G,B]"); + endif + if (min (min (map)) < 0 || max (max (map)) > 1) + error ("colormap: MAP must have values in [0,1]"); + endif + ## Set the new color map + set (gcf (), "colormap", map); + endif + + endif + + ## Return current color map. + if (nargout > 0 || (nargout == 0 && nargin == 0)) + cmap = get (gcf (), "colormap"); + endif + +endfunction diff --git a/octave_packages/m/image/contrast.m b/octave_packages/m/image/contrast.m new file mode 100644 index 0000000..79b0794 --- /dev/null +++ b/octave_packages/m/image/contrast.m @@ -0,0 +1,50 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} contrast (@var{x}, @var{n}) +## Return a gray colormap that maximizes the contrast in an image. The +## returned colormap will have @var{n} rows. If @var{n} is not defined +## then the size of the current colormap is used instead. +## @seealso{colormap} +## @end deftypefn + +function map = contrast (x, n) + + if (nargin == 1) + n = rows (colormap); + elseif (nargin == 2) + if (! isscalar (n)) + error ("contrast: N must be a scalar"); + endif + else + print_usage (); + endif + + x = x(:); + minx = min (x); + map = find (diff (sort ([round(n * ((x - minx) ./ (max(x) - minx))); [0:n]']))); + minm = min (map); + map = (map - minm) ./ (max (map) - minm); + map = [map, map, map]; +endfunction + +%!assert (contrast(1:100,10),[([0:9]/9)',([0:9]/9)',([0:9]/9)'],1e-10) +%!demo +%! image (reshape (1:100, 10, 10)) +%! colormap (contrast (1:100,10)) diff --git a/octave_packages/m/image/cool.m b/octave_packages/m/image/cool.m new file mode 100644 index 0000000..e1862fe --- /dev/null +++ b/octave_packages/m/image/cool.m @@ -0,0 +1,60 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} cool () +## @deftypefnx {Function File} {@var{map} =} cool (@var{n}) +## Create color colormap. The colormap varies from cyan to magenta. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = cool (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("cool: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [0, 1, 1]; + elseif (n > 1) + r = (0:n - 1)' ./ (n - 1); + g = 1 - r; + b = ones (n, 1); + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'cool' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (cool (64)) + diff --git a/octave_packages/m/image/copper.m b/octave_packages/m/image/copper.m new file mode 100644 index 0000000..05d9900 --- /dev/null +++ b/octave_packages/m/image/copper.m @@ -0,0 +1,62 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} copper () +## @deftypefnx {Function File} {@var{map} =} copper (@var{n}) +## Create color colormap. This colormap varies from black to +## a light copper tone. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = copper (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("copper: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [0, 0, 0]; + elseif (n > 1) + x = linspace (0, 1, n)'; + r = (x < 4/5) .* (5/4 * x) + (x >= 4/5); + g = 4/5 * x; + b = 1/2 * x; + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'copper' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (copper (64)) + diff --git a/octave_packages/m/image/flag.m b/octave_packages/m/image/flag.m new file mode 100644 index 0000000..e8f34e2 --- /dev/null +++ b/octave_packages/m/image/flag.m @@ -0,0 +1,59 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} flag () +## @deftypefnx {Function File} {@var{map} =} flag (@var{n}) +## Create color colormap. This colormap cycles through red, white, blue +## and black with each index change. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = flag (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("flag: argument must be a scalar"); + endif + else + print_usage (); + endif + + p = [1, 0, 0; 1, 1, 1; 0, 0, 1; 0, 0, 0]; + if (rem(n,4) == 0) + map = kron (ones (n / 4, 1), p); + else + m1 = kron (ones (fix (n / 4), 1), p); + m2 = p(1:rem (n, 4), :); + map = [m1; m2]; + endif + +endfunction + +%!demo +%! ## Show the 'flag' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (flag (64)) + diff --git a/octave_packages/m/image/gmap40.m b/octave_packages/m/image/gmap40.m new file mode 100644 index 0000000..3fd1cd2 --- /dev/null +++ b/octave_packages/m/image/gmap40.m @@ -0,0 +1,57 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} gmap40 () +## @deftypefnx {Function File} {@var{map} =} gmap40 (@var{n}) +## Create color colormap. The colormap consists of red, green, blue, yellow, +## magenta and cyan. This colormap is specifically designed for users of +## gnuplot 4.0 where these 6 colors are the allowable ones for patch objects. +## The argument @var{n} must be a scalar. +## If unspecified, a length of 6 is assumed. Larger values +## of @var{n} result in a repetition of the above colors. +## @seealso{colormap} +## @end deftypefn + +function map = gmap40 (n) + + if (nargin == 0) + n = 6; + elseif (nargin == 1) + if (! isscalar (n)) + error ("gmap40: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n >= 1) + map = repmat ([1, 0, 0; 0, 1, 0; 0, 0, 1; 1, 1, 0; 1, 0, 1; 0, 1, 1], + ceil (n / 6), 1) (1:n, :); + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'gmap40' colormap as an image +%! image (1:6, linspace (0, 1, 6), repmat (1:6, 6, 1)') +%! axis ([1, 6, 0, 1], "ticy", "xy") +%! colormap (gmap40 (6)) + diff --git a/octave_packages/m/image/gray.m b/octave_packages/m/image/gray.m new file mode 100644 index 0000000..055b124 --- /dev/null +++ b/octave_packages/m/image/gray.m @@ -0,0 +1,55 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} gray () +## @deftypefnx {Function File} {@var{map} =} gray (@var{n}) +## Create gray colormap. This colormap varies from black to white with +## shades of gray. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function map = gray (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("gray: argument must be a scalar"); + endif + else + print_usage (); + endif + + gr = [0:(n-1)]'; + + map = [ gr, gr, gr ] / (n - 1); + +endfunction + +%!demo +%! ## Show the 'gray' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (gray (64)) + diff --git a/octave_packages/m/image/gray2ind.m b/octave_packages/m/image/gray2ind.m new file mode 100644 index 0000000..18ec1a8 --- /dev/null +++ b/octave_packages/m/image/gray2ind.m @@ -0,0 +1,61 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{img}, @var{map}] =} gray2ind (@var{I}, @var{n}) +## Convert a gray scale intensity image to an Octave indexed image. +## The indexed image will consist of @var{n} different intensity values. If not +## given @var{n} will default to 64. +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function [X, map] = gray2ind (I, n = 64) + ## Check input + if (nargin < 1 || nargin > 2) + print_usage (); + endif + C = class(I); + if (! ismatrix (I) || ndims (I) != 2) + error ("gray2ind: first input argument must be a gray scale image"); + endif + if (! isscalar (n) || n < 0) + error ("gray2ind: second input argument must be a positive integer"); + endif + ints = {"uint8", "uint16", "int8", "int16"}; + floats = {"double", "single"}; + if (! ismember (C, {ints{:}, floats{:}})) + error ("gray2ind: invalid data type '%s'", C); + endif + if (ismember (C, floats) && (min (I(:)) < 0 || max (I(:)) > 1)) + error ("gray2ind: floating point images may only contain values between 0 and 1"); + endif + + ## Convert data + map = gray (n); + ## If @var{I} is an integer matrix convert it to a double matrix with values in [0, 1] + if (ismember (C, ints)) + low = double (intmin (C)); + high = double (intmax (C)); + I = (double (I) - low) / (high - low); + endif + X = round (I*(n-1)) + 1; + +endfunction diff --git a/octave_packages/m/image/hot.m b/octave_packages/m/image/hot.m new file mode 100644 index 0000000..1bd0c8a --- /dev/null +++ b/octave_packages/m/image/hot.m @@ -0,0 +1,62 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} hot () +## @deftypefnx {Function File} {@var{map} =} hot (@var{n}) +## Create color colormap. This colormap ranges from black through dark red, +## red, orange, yellow, to white. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = hot (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("hot: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [0, 0, 0]; + elseif (n > 1) + x = linspace (0, 1, n)'; + r = (x < 2/5) .* (5/2 * x) + (x >= 2/5); + g = (x >= 2/5 & x < 4/5) .* (5/2 * x - 1) + (x >= 4/5); + b = (x >= 4/5) .* (5*x - 4); + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'hot' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (hot (64)) + diff --git a/octave_packages/m/image/hsv.m b/octave_packages/m/image/hsv.m new file mode 100644 index 0000000..94cd09a --- /dev/null +++ b/octave_packages/m/image/hsv.m @@ -0,0 +1,63 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hsv (@var{n}) +## Create color colormap. This colormap begins with red, changes through +## yellow, green, cyan, blue, and magenta, before returning to red. +## It is useful for displaying periodic functions. It is obtained by linearly +## varying the hue through all possible values while keeping constant maximum +## saturation and value and is equivalent to +## @code{hsv2rgb ([linspace(0,1,N)', ones(N,2)])}. +## +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = hsv (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("hsv: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [1, 0, 0]; + elseif (n > 1) + h = linspace (0, 1, n)'; + map = hsv2rgb ([h, ones(n, 1), ones(n, 1)]); + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'hsv' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (hsv (64)) + diff --git a/octave_packages/m/image/hsv2rgb.m b/octave_packages/m/image/hsv2rgb.m new file mode 100644 index 0000000..e0aa84d --- /dev/null +++ b/octave_packages/m/image/hsv2rgb.m @@ -0,0 +1,87 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{rgb_map} =} hsv2rgb (@var{hsv_map}) +## Transform a colormap or image from the HSV space to the RGB space. +## @seealso{rgb2hsv} +## @end deftypefn + +## Author: Kai Habel +## Adapted-by: jwe + +function rgb_map = hsv2rgb (hsv_map) + +## Each color value x = (r,g,b) is calculated with +## x = (1-sat)*val+sat*val*f_x(hue) +## where f_x(hue) is a piecewise defined function for +## each color with f_r(hue-2/3) = f_g(hue) = f_b(hue-1/3). + + if (nargin != 1) + print_usage (); + endif + + ## If we have an image convert it into a color map. + if (ismatrix (hsv_map) && ndims (hsv_map) == 3) + is_image = true; + Sz = size (hsv_map); + hsv_map = [hsv_map(:,:,1)(:), hsv_map(:,:,2)(:), hsv_map(:,:,3)(:)]; + ## Convert to a double image. + if (isinteger (hsv_map)) + C = class (hsv_map); + low = double (intmin (C)); + high = double (intmax (C)); + hsv_map = (double (hsv_map) - low) / (high - low); + endif + else + is_image = false; + endif + + if (! ismatrix (hsv_map) || columns (hsv_map) != 3) + error ("hsv2rgb: argument must be a matrix of size nx3"); + endif + + ## set values <0 to 0 and >1 to 1 + hsv_map = (hsv_map >= 0 & hsv_map <= 1) .* hsv_map \ + + (hsv_map < 0) .* 0 + (hsv_map > 1); + + ## fill rgb map with v*(1-s) + rgb_map = kron ([1, 1, 1], hsv_map(:,3) .* (1 - hsv_map(:,2))); + + ## red(hue-2/3)=green(hue)=blue(hue-1/3) + ## apply modulo 1 for red and blue + t = hsv_map(:,1); + tp = t'; + hue = [(tp - 2/3 - floor (t - 2/3)'); + tp; + (tp - 1/3 - floor (t - 1/3)')]'; + + ## factor s*v -> f + f = kron ([1, 1, 1], hsv_map(:,2)) .* kron ([1, 1, 1], hsv_map(:,3)); + + ## add s*v* hue-function to rgb map + rgb_map = rgb_map + f .* (6 * (hue < 1/6) .* hue + + (hue >= 1/6 & hue < 1/2) + + (hue >= 1/2 & hue < 2/3) .* (4 - 6 * hue)); + + ## If input was an image, convert it back into one. + if (is_image) + rgb_map = reshape (rgb_map, Sz); + endif + +endfunction diff --git a/octave_packages/m/image/image.m b/octave_packages/m/image/image.m new file mode 100644 index 0000000..1dab86a --- /dev/null +++ b/octave_packages/m/image/image.m @@ -0,0 +1,238 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} image (@var{img}) +## @deftypefnx {Function File} {} image (@var{x}, @var{y}, @var{img}) +## @deftypefnx {Function File} {@var{h} =} image (@dots{}) +## Display a matrix as a color image. The elements of @var{img} are indices +## into the current colormap, and the colormap will be scaled so that the +## extremes of @var{img} are mapped to the extremes of the colormap. +## +## The axis values corresponding to the matrix elements are specified in +## @var{x} and @var{y}. If you're not using gnuplot 4.2 or later, these +## variables are ignored. +## +## Implementation Note: The origin (0, 0) for images is located in the +## upper left. For ordinary plots, the origin is located in the lower +## left. Octave handles this inversion by plotting the data normally, +## and then reversing the direction of the y-axis by setting the +## @code{ydir} property to @code{"reverse"}. This has implications whenever +## an image and an ordinary plot need to be overlaid. The recommended +## solution is to display the image and then plot the reversed ydata +## using, for example, @code{flipud (ydata,1)}. +## +## The optional return value @var{h} is a graphics handle to the image. +## @seealso{imshow, imagesc, colormap} +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function retval = image (varargin) + + [ax, varargin, nargin] = __plt_get_axis_arg__ ("image", varargin{:}); + + firstnonnumeric = Inf; + for i = 1 : nargin + if (! isnumeric (varargin{i})) + firstnonnumeric = i; + break; + endif + endfor + + if (nargin == 0 || firstnonnumeric == 1) + img = imread ("default.img"); + x = y = []; + elseif (nargin == 1 || firstnonnumeric == 2) + img = varargin{1}; + x = y = []; + elseif (nargin == 2 || firstnonnumeric == 3) + print_usage (); + else + x = varargin{1}; + y = varargin{2}; + img = varargin{3}; + firstnonnumeric = 4; + endif + + oldax = gca (); + unwind_protect + axes (ax); + h = __img__ (x, y, img, varargin {firstnonnumeric:end}); + set (ax, "layer", "top"); + unwind_protect_cleanup + axes (oldax); + end_unwind_protect + + if (nargout > 0) + retval = h; + endif + +endfunction + +## Generic image creation. +## +## The axis values corresponding to the matrix elements are specified in +## @var{x} and @var{y}. If you're not using gnuplot 4.2 or later, these +## variables are ignored. + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function h = __img__ (x, y, img, varargin) + + newplot (); + + if (isempty (img)) + error ("__img__: matrix is empty"); + endif + + if (isempty (x)) + x = [1, columns(img)]; + endif + + if (isempty (y)) + y = [1, rows(img)]; + endif + + xdata = [x(1), x(end)]; + ydata = [y(1), y(end)]; + + dx = diff (x); + dy = diff (y); + dx = std (dx) / mean (abs (dx)); + dy = std (dy) / mean (abs (dy)); + tol = 100*eps; + if (any (dx > tol) || any (dy > tol)) + warning ("Image does not map to non-linearly spaced coordinates") + endif + + ca = gca (); + + tmp = __go_image__ (ca, "cdata", img, "xdata", xdata, "ydata", ydata, + "cdatamapping", "direct", varargin {:}); + + px = __image_pixel_size__ (tmp); + + if (xdata(2) < xdata(1)) + xdata = xdata(2:-1:1); + elseif (xdata(2) == xdata(1)) + xdata = xdata(1) + [0, size(img,2)-1]; + endif + if (ydata(2) < ydata(1)) + ydata = ydata(2:-1:1); + elseif (ydata(2) == ydata(1)) + ydata = ydata(1) + [0, size(img,1)-1]; + endif + xlim = xdata + [-px(1), px(1)]; + ylim = ydata + [-px(2), px(2)]; + + ## FIXME -- how can we do this and also get the {x,y}limmode + ## properties to remain "auto"? I suppose this adjustment should + ## happen automatically in axes::update_axis_limits instead of + ## explicitly setting the values here. But then what information is + ## available to axes::update_axis_limits to determine that the + ## adjustment is necessary? + set (ca, "xlim", xlim, "ylim", ylim); + + if (ndims (img) == 3) + if (isinteger (img)) + c = class (img); + mn = intmin (c); + mx = intmax (c); + set (ca, "clim", double ([mn, mx])); + endif + endif + + set (ca, "view", [0, 90]); + + if (strcmp (get (ca, "nextplot"), "replace")) + # Always reverse y-axis for images, unless hold is on + set (ca, "ydir", "reverse"); + endif + + if (nargout > 0) + h = tmp; + endif + +endfunction + +%!demo +%! clf +%! img = 1 ./ hilb (11); +%! x = -5:5; +%! y = x; +%! subplot (2,2,1) +%! h = image (abs(x), abs(y), img); +%! set (h, "cdatamapping", "scaled") +%! ylabel ("limits = [4.5, 15.5]") +%! title ('image (abs(x), abs(y), img)') +%! subplot (2,2,2) +%! h = image (-x, y, img); +%! set (h, "cdatamapping", "scaled") +%! title ('image (-x, y, img)') +%! subplot (2,2,3) +%! h = image (x, -y, img); +%! set (h, "cdatamapping", "scaled") +%! title ('image (x, -y, img)') +%! ylabel ("limits = [-5.5, 5.5]") +%! subplot (2,2,4) +%! h = image (-x, -y, img); +%! set (h, "cdatamapping", "scaled") +%! title ('image (-x, -y, img)') + +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! imagesc (g, g, sin (h)); +%! hold on +%! imagesc (g, g+12, cos (h/2)); +%! axis ([0 10 0 22]) +%! hold off +%! title ("two consecutive images") + +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! imagesc (g, g, sin (h)); +%! hold all +%! plot (g, 11.0 * ones (size (g))) +%! imagesc (g, g+12, cos (h/2)); +%! axis ([0 10 0 22]) +%! hold off +%! title ("image, line, image") + +%!demo +%! clf +%! g = 0.1:0.1:10; +%! h = g'*g; +%! plot (g, 10.5 * ones (size (g))) +%! hold all +%! imagesc (g, g, sin (h)); +%! plot (g, 11.0 * ones (size (g))) +%! imagesc (g, g+12, cos (h/2)); +%! plot (g, 11.5 * ones (size (g))) +%! axis ([0 10 0 22]) +%! hold off +%! title ("line, image, line, image, line") + diff --git a/octave_packages/m/image/imagesc.m b/octave_packages/m/image/imagesc.m new file mode 100644 index 0000000..79758d4 --- /dev/null +++ b/octave_packages/m/image/imagesc.m @@ -0,0 +1,121 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} imagesc (@var{A}) +## @deftypefnx {Function File} {} imagesc (@var{x}, @var{y}, @var{A}) +## @deftypefnx {Function File} {} imagesc (@dots{}, @var{limits}) +## @deftypefnx {Function File} {} imagesc (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} imagesc (@dots{}) +## Display a scaled version of the matrix @var{A} as a color image. The +## colormap is scaled so that the entries of the matrix occupy the entire +## colormap. If @var{limits} = [@var{lo}, @var{hi}] are given, then that +## range is set to the 'clim' of the current axes. +## +## The axis values corresponding to the matrix elements are specified in +## @var{x} and @var{y}, either as pairs giving the minimum and maximum +## values for the respective axes, or as values for each row and column +## of the matrix @var{A}. +## +## The optional return value @var{h} is a graphics handle to the image. +## @seealso{image, imshow, caxis} +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function retval = imagesc (varargin) + + if (nargin < 1) + print_usage (); + elseif (isscalar (varargin{1}) && ishandle (varargin{1})) + h = varargin{1}; + if (! strcmp (get (h, "type"), "axes")) + error ("imagesc: expecting first argument to be an axes object"); + endif + oldh = gca (); + unwind_protect + axes (h); + tmp = __imagesc__ (h, varargin{2:end}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + else + tmp = __imagesc__ (gca (), varargin{:}); + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + +function ret = __imagesc__ (ax, x, y, A, limits, DEPRECATEDZOOM) + + ## Deprecated zoom. Remove this hunk of code if old zoom argument + ## is outmoded. + if ((nargin == 3 && isscalar (y)) + || (nargin == 4 && (isscalar (y) || isscalar (A))) + || (nargin == 5 && isscalar (limits)) + || nargin == 6) + warning ("image: zoom argument ignored -- use GUI features"); + endif + if (nargin == 6) + if (isscalar (limits)) + limits = DEPRECATEDZOOM; + endif + nargin = 5; + endif + if (nargin == 5 && isscalar (limits)) + nargin = 4; + endif + if (nargin == 4 && (isscalar (y) || isscalar (A))) + if (isscalar (y)) + y = A; + endif + nargin = 3; + endif + if (nargin == 3 && isscalar (y)) + nargin = 2; + endif + + if (nargin < 2 || nargin > 5) + print_usage (); + elseif (nargin == 2) + A = x; + x = y = limits = []; + elseif (nargin == 3) + A = x; + limits = y; + x = y = []; + elseif (nargin == 4 && ! isscalar (x) && ! isscalar (y) && ! isscalar (A)) + limits = []; + endif + + ret = image (ax, x, y, A); + set (ret, "cdatamapping", "scaled"); + + ## use given limits or guess them from the matrix + if (length (limits) == 2 && limits(2) >= limits(1)) + set (ax, "clim", limits); + elseif (! isempty (limits)) + error ("imagesc: expected data LIMITS to be [lo, hi]"); + endif + +endfunction diff --git a/octave_packages/m/image/imfinfo.m b/octave_packages/m/image/imfinfo.m new file mode 100644 index 0000000..3741118 --- /dev/null +++ b/octave_packages/m/image/imfinfo.m @@ -0,0 +1,157 @@ +## Copyright (C) 2008-2012 Soren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{info} =} imfinfo (@var{filename}) +## @deftypefnx {Function File} {@var{info} =} imfinfo (@var{url}) +## Read image information from a file. +## +## @code{imfinfo} returns a structure containing information about the image +## stored in the file @var{filename}. The output structure contains the +## following fields. +## +## @table @samp +## @item Filename +## The full name of the image file. +## +## @item FileSize +## Number of bytes of the image on disk +## +## @item FileModDate +## Date of last modification to the file. +## +## @item Height +## Image height in pixels. +## +## @item Width +## Image Width in pixels. +## +## @item BitDepth +## Number of bits per channel per pixel. +## +## @item Format +## Image format (e.g., @code{"jpeg"}). +## +## @item LongFormat +## Long form image format description. +## +## @item XResolution +## X resolution of the image. +## +## @item YResolution +## Y resolution of the image. +## +## @item TotalColors +## Number of unique colors in the image. +## +## @item TileName +## Tile name. +## +## @item AnimationDelay +## Time in 1/100ths of a second (0 to 65535) which must expire before displaying +## the next image in an animated sequence. +## +## @item AnimationIterations +## Number of iterations to loop an animation (e.g., Netscape loop extension) +## for. +## +## @item ByteOrder +## Endian option for formats that support it. Is either @code{"little-endian"}, +## @code{"big-endian"}, or @code{"undefined"}. +## +## @item Gamma +## Gamma level of the image. The same color image displayed on two different +## workstations may look different due to differences in the display monitor. +## +## @item Matte +## @code{true} if the image has transparency. +## +## @item ModulusDepth +## Image modulus depth (minimum number of bits required to support +## red/green/blue +## components without loss of accuracy). +## +## @item Quality +## JPEG/MIFF/PNG compression level. +## +## @item QuantizeColors +## Preferred number of colors in the image. +## +## @item ResolutionUnits +## Units of image resolution. Is either @code{"pixels per inch"}, +## @code{"pixels per centimeter"}, or @code{"undefined"}. +## +## @item ColorType +## Image type. Is either @code{"grayscale"}, @code{"indexed"}, +## @code{"truecolor"}, +## or @code{"undefined"}. +## +## @item View +## FlashPix viewing parameters. +## @end table +## +## @seealso{imread, imwrite} +## @end deftypefn + +function info = imfinfo (filename) + + if (nargin < 1) + print_usage (); + endif + + if (!ischar (filename)) + error ("imfinfo: FILENAME must be a string"); + endif + + filename = tilde_expand (filename); + + delete_file = false; + + unwind_protect + + fn = file_in_path (IMAGE_PATH, filename); + + if (isempty (fn)) + + ## Couldn't find file. See if it's an URL. + + tmp = tmpnam (); + + [fn, status, msg] = urlwrite (filename, tmp); + + if (! status) + error ("imfinfo: cannot find %s", filename); + endif + + if (! isempty (fn)) + delete_file = true; + endif + + endif + + info = __magick_finfo__ (fn); + + unwind_protect_cleanup + + if (delete_file) + unlink (fn); + endif + + end_unwind_protect + +endfunction diff --git a/octave_packages/m/image/imread.m b/octave_packages/m/image/imread.m new file mode 100644 index 0000000..701224b --- /dev/null +++ b/octave_packages/m/image/imread.m @@ -0,0 +1,117 @@ +## Copyright (C) 2008-2012 Thomas L. Scofield +## Copyright (C) 2008 Kristian Rumberg +## Copyright (C) 2006 Thomas Weber +## Copyright (C) 2005 Stefan van der Walt +## Copyright (C) 2002 Andy Adler +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{img}, @var{map}, @var{alpha}] =} imread (@var{filename}) +## Read images from various file formats. +## +## The size and numeric class of the output depends on the +## format of the image. A color image is returned as an +## @nospell{MxNx3} matrix. Gray-level and black-and-white images are +## of size @nospell{MxN}. +## The color depth of the image determines the numeric +## class of the output: "uint8" or "uint16" for gray +## and color, and "logical" for black and white. +## +## @seealso{imwrite, imfinfo} +## @end deftypefn + +function varargout = imread (filename, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (! ischar (filename)) + error ("imread: FILENAME must be a string"); + endif + + filename = tilde_expand (filename); + + fn = file_in_path (IMAGE_PATH, filename); + + if (isempty (fn)) + error ("imread: cannot find %s", filename); + endif + + try + [varargout{1:nargout}] = __magick_read__ (fn, varargin{:}); + catch + + magick_error = lasterr (); + + img_field = false; + x_field = false; + map_field = false; + + try + vars = load (fn); + if (isstruct (vars)) + img_field = isfield (vars, "img"); + x_field = isfield (vars, "X"); + map_field = isfield (vars, "map"); + endif + catch + error ("imread: invalid image file: %s", magick_error); + end_try_catch + + if (map_field && (img_field || x_field)) + varargout{2} = vars.map; + if (img_field) + varargout{1} = vars.img; + else + varargout{1} = vars.X; + endif + else + error ("imread: invalid Octave image file format"); + endif + + end_try_catch + +endfunction + +%!testif HAVE_MAGICK +%! vpng = [ ... +%! 137, 80, 78, 71, 13, 10, 26, 10, 0, 0, ... +%! 0, 13, 73, 72, 68, 82, 0, 0, 0, 3, ... +%! 0, 0, 0, 3, 8, 2, 0, 0, 0, 217, ... +%! 74, 34, 232, 0, 0, 0, 1, 115, 82, 71, ... +%! 66, 0, 174, 206, 28, 233, 0, 0, 0, 4, ... +%! 103, 65, 77, 65, 0, 0, 177, 143, 11, 252, ... +%! 97, 5, 0, 0, 0, 32, 99, 72, 82, 77, ... +%! 0, 0, 122, 38, 0, 0, 128, 132, 0, 0, ... +%! 250, 0, 0, 0, 128, 232, 0, 0, 117, 48, ... +%! 0, 0, 234, 96, 0, 0, 58, 152, 0, 0, ... +%! 23, 112, 156, 186, 81, 60, 0, 0, 0, 25, ... +%! 73, 68, 65, 84, 24, 87, 99, 96, 96, 96, ... +%! 248, 255, 255, 63, 144, 4, 81, 111, 101, 84, ... +%! 16, 28, 160, 16, 0, 197, 214, 13, 34, 74, ... +%! 117, 213, 17, 0, 0, 0, 0, 73, 69, 78, ... +%! 68, 174, 66, 96, 130]; +%! fid = fopen('test.png', 'wb'); +%! fwrite(fid, vpng); +%! fclose(fid); +%! A = imread('test.png'); +%! delete('test.png'); +%! assert(A(:,:,1), uint8 ([0, 255, 0; 255, 237, 255; 0, 255, 0])); +%! assert(A(:,:,2), uint8 ([0, 255, 0; 255, 28, 255; 0, 255, 0])); +%! assert(A(:,:,3), uint8 ([0, 255, 0; 255, 36, 255; 0, 255, 0])); diff --git a/octave_packages/m/image/imshow.m b/octave_packages/m/image/imshow.m new file mode 100644 index 0000000..aafd25c --- /dev/null +++ b/octave_packages/m/image/imshow.m @@ -0,0 +1,210 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} imshow (@var{im}) +## @deftypefnx {Function File} {} imshow (@var{im}, @var{limits}) +## @deftypefnx {Function File} {} imshow (@var{im}, @var{map}) +## @deftypefnx {Function File} {} imshow (@var{rgb}, @dots{}) +## @deftypefnx {Function File} {} imshow (@var{filename}) +## @deftypefnx {Function File} {} imshow (@dots{}, @var{string_param1}, @var{value1}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} imshow (@dots{}) +## Display the image @var{im}, where @var{im} can be a 2-dimensional +## (gray-scale image) or a 3-dimensional (RGB image) matrix. +## +## If @var{limits} is a 2-element vector @code{[@var{low}, @var{high}]}, +## the image is shown using a display range between @var{low} and +## @var{high}. If an empty matrix is passed for @var{limits}, the +## display range is computed as the range between the minimal and the +## maximal value in the image. +## +## If @var{map} is a valid color map, the image will be shown as an indexed +## image using the supplied color map. +## +## If a file name is given instead of an image, the file will be read and +## shown. +## +## If given, the parameter @var{string_param1} has value +## @var{value1}. @var{string_param1} can be any of the following: +## @table @asis +## @item "displayrange" +## @var{value1} is the display range as described above. +## @end table +## +## The optional return value @var{h} is a graphics handle to the image. +## @seealso{image, imagesc, colormap, gray2ind, rgb2ind} +## @end deftypefn + +## Author: Stefan van der Walt +## Author: Soren Hauberg +## Adapted-By: jwe + +function h = imshow (im, varargin) + + if (nargin == 0) + print_usage (); + endif + + display_range = NA; + true_color = false; + indexed = false; + + ## Get the image. + if (ischar (im)) + [im, map] = imread (im); + indexed = true; + colormap (map); + endif + + nd = ndims (im); + + if (! ((isnumeric (im) || islogical (im)) && (nd == 2 || nd == 3))) + error ("imshow: IM must be an image or the filename of an image"); + endif + + if (nd == 2) + if (! indexed) + colormap (gray ()); + endif + elseif (size (im, 3) == 3) + if (ismember (class (im), {"uint8", "uint16", "double", "single"})) + true_color = true; + else + error ("imshow: color image must be uint8, uint16, double, or single"); + endif + else + error ("imshow: expecting MxN or MxNx3 matrix for image"); + endif + + narg = 1; + while (narg <= numel (varargin)) + arg = varargin{narg++}; + if (isnumeric (arg)) + if (numel (arg) == 2 || isempty (arg)) + display_range = arg; + elseif (columns (arg) == 3) + indexed = true; + colormap (arg); + elseif (! isempty (arg)) + error ("imshow: argument number %d is invalid", narg+1); + endif + elseif (ischar (arg)) + switch (arg) + case "displayrange"; + display_range = varargin{narg++}; + case {"truesize", "initialmagnification"} + warning ("image: zoom argument ignored -- use GUI features"); + otherwise + warning ("imshow: unrecognized property %s", arg); + narg++; + endswitch + else + error ("imshow: argument number %d is invalid", narg+1); + endif + endwhile + + ## Check for complex images. + if (iscomplex (im)) + warning ("imshow: only showing real part of complex image"); + im = real (im); + endif + + ## Set default display range if display_range not set yet. + if (isempty (display_range)) + display_range = [min(im(:)), max(im(:))]; + elseif (isna (display_range)) + t = class (im); + switch (t) + case {"double", "single", "logical"} + display_range = [0, 1]; + case {"int8", "int16", "int32", "uint8", "uint16", "uint32"} + display_range = [intmin(t), intmax(t)]; + otherwise + error ("imshow: invalid data type for image"); + endswitch + endif + + nans = isnan (im(:)); + if (any (nans)) + warning ("Octave:imshow-NaN", + "imshow: pixels with NaN or NA values are set to minimum pixel value"); + im(nans) = display_range(1); + endif + + ## This is for compatibility. + if (! (indexed || (true_color && isinteger (im))) || islogical (im)) + im = double (im); + endif + + ## Clamp the image to the range boundaries + if (! (true_color || indexed || islogical (im))) + low = display_range(1); + high = display_range(2); + im(im < low) = low; + im(im > high) = high; + endif + + if (true_color || indexed) + tmp = image ([], [], im); + else + tmp = image (im); + set (tmp, "cdatamapping", "scaled"); + ## The backend is responsible for scaling to clim if necessary. + set (gca (), "clim", display_range); + endif + set (gca (), "visible", "off", "ydir", "reverse"); + axis ("image"); + + if (nargout > 0) + h = tmp; + endif + +endfunction + +%!error imshow () # no arguments +%!error imshow ({"cell"}) # No image or filename given +%!error imshow (ones(4,4,4)) # Too many dimensions in image + +%!demo +%! imshow ("default.img"); + +%!demo +%! imshow ("default.img"); +%! colormap ("autumn"); + +%!demo +%! [I, M] = imread ("default.img"); +%! imshow (I, M); + +%!demo +%! [I, M] = imread ("default.img"); +%! [R, G, B] = ind2rgb (I, M); +%! imshow (cat(3, R, G*0.5, B*0.8)); + +%!demo +%! imshow (rand (100, 100)); + +%!demo +%! imshow (rand (100, 100, 3)); + +%!demo +%! imshow (100*rand (100, 100, 3)); + +%!demo +%! imshow (rand (100, 100)); +%! colormap (jet); diff --git a/octave_packages/m/image/imwrite.m b/octave_packages/m/image/imwrite.m new file mode 100644 index 0000000..74ee44a --- /dev/null +++ b/octave_packages/m/image/imwrite.m @@ -0,0 +1,200 @@ +## Copyright (C) 2008-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} imwrite (@var{img}, @var{filename}) +## @deftypefnx {Function File} {} imwrite (@var{img}, @var{filename}, @var{fmt}) +## @deftypefnx {Function File} {} imwrite (@var{img}, @var{filename}, @var{fmt}, @var{p1}, @var{v1}, @dots{}) +## @deftypefnx {Function File} {} imwrite (@var{img}, @var{map}, @var{filename}, @dots{}) +## Write images in various file formats. +## +## If @var{fmt} is not supplied, the file extension of @var{filename} is used +## to determine the format. +## +## The parameter-value pairs (@var{p1}, @var{v1}, @dots{}) are optional. +## Currently the following options are supported for @t{JPEG} images: +## +## @table @samp +## @item Quality +## Set the quality of the compression. The value should be an +## integer between 0 and 100, with larger values indicating higher visual +## quality and lower compression. +## @end table +## +## @strong{Supported Formats} +## @multitable @columnfractions .33 .66 +## @headitem Extension @tab Format +## @item bmp @tab Windows Bitmap +## @item gif @tab Graphics Interchange Format +## @item jpg and jpeg @tab Joint Photographic Experts Group +## @item pbm @tab Portable Bitmap +## @item pcx @tab +## @item pgm @tab Portable Graymap +## @item png @tab Portable Network Graphics +## @item pnm @tab Portable Anymap +## @item ppm @tab Portable Pixmap +## @item ras @tab Sun Raster +## @item tif and tiff @tab Tagged Image File Format +## @item xwd @tab X11 Dump +## @end multitable +## +## @strong{Unsupported Formats} +## @multitable @columnfractions .33 .66 +## @headitem Extension @tab Format +## @item hdf @tab Hierarchical Data Format V4 +## @item @nospell{jp2} and jpx @tab Joint Photographic Experts Group 2000 +## @end multitable +## +## @seealso{imread, imfinfo} +## @end deftypefn + +function imwrite (img, varargin) + + persistent imwrite_possible_formats = { + "bmp"; "gif"; "jp2"; "jpg"; "jpx"; "jpeg"; "hdf"; "pbm"; "pcx"; + "pgm"; "png"; "pnm"; "ppm"; "ras"; "tif"; "tiff"; "xwd" }; + + persistent accepted_formats = __magick_format_list__ (imwrite_possible_formats); + + if (nargin < 2 || ! (isnumeric (img) || islogical (img))) + print_usage (); + endif + + map = []; + fmt = ""; + + offset = 1; + if (isnumeric (varargin{1})) + map = varargin{1}; + if (isempty (map)) + error ("imwrite: colormap must not be empty"); + endif + offset = 2; + endif + if (offset <= length (varargin) && ischar (varargin{offset})) + filename = varargin{offset}; + offset++; + if (rem (length (varargin) - offset, 2) == 0 && ischar (varargin{offset})) + fmt = varargin{offset}; + offset++; + endif + else + print_usage (); + endif + if (offset < length (varargin)) + has_param_list = 1; + for ii = offset:2:(length (varargin) - 1) + options.(varargin{ii}) = varargin{ii + 1}; + endfor + else + has_param_list = 0; + endif + + filename = tilde_expand (filename); + + if (isempty (fmt)) + [d, n, fmt] = fileparts (filename); + if (! isempty (fmt)) + fmt = fmt(2:end); + endif + endif + + if (isempty (img)) + error ("imwrite: invalid empty image"); + endif + + if (issparse (img) || issparse (map)) + error ("imwrite: sparse images not supported"); + endif + + if (! strcmp (fmt, accepted_formats)) + error ("imwrite: %s: unsupported or invalid image format", fmt); + endif + + img_class = class (img); + map_class = class (map); + nd = ndims (img); + + if (isempty (map)) + if (any (strcmp (img_class, {"logical", "uint8", "uint16", "double"}))) + if ((nd == 2 || nd == 3) && strcmp (img_class, "double")) + img = uint8 (img * 255); + endif + ## FIXME -- should we handle color images w/ alpha channel here? + if (nd == 3 && size (img, 3) < 3) + error ("imwrite: invalid dimensions for truecolor image"); + endif + if (nd > 5) + error ("imwrite: invalid %d-dimensional image data", nd); + endif + else + error ("imwrite: %s: invalid class for truecolor image", img_class); + endif + if (has_param_list) + __magick_write__ (filename, fmt, img, options); + else + __magick_write__ (filename, fmt, img); + endif + else + if (any (strcmp (img_class, {"uint8", "uint16", "double"}))) + if (strcmp (img_class, "double")) + img = uint8 (img - 1); + endif + if (nd != 2 && nd != 4) + error ("imwrite: invalid size for indexed image"); + endif + else + error ("imwrite: %s: invalid class for indexed image data", img_class); + endif + if (isa (map, "double")) + if (ndims (map) != 2 || size (map, 2) != 3) + error ("imwrite: invalid size for colormap"); + endif + else + error ("imwrite: %s invalid class for indexed image colormap", + class (map)); + endif + + ## FIXME -- we should really be writing indexed images here but + ## __magick_write__ needs to be fixed to handle them. + + [r, g, b] = ind2rgb (img, map); + tmp = uint8 (cat (3, r, g, b) * 255); + + if (has_param_list) + __magick_write__ (filename, fmt, tmp, options); + ## __magick_write__ (filename, fmt, img, map, options); + else + __magick_write__ (filename, fmt, tmp); + ## __magick_write__ (filename, fmt, img, map); + endif + endif + +endfunction + +%% Test input validation +%!error imwrite () # Wrong # of args +%!error imwrite (1) # Wrong # of args +%!error imwrite ({"cell"}, "filename.jpg") # Wrong class for img +%!error imwrite (1, [], "filename.jpg") # Empty image map +%!error imwrite (1, 2, 3) # No filename specified +%!error imwrite (1, "filename") # No fmt specified +%!error imwrite (1, "filename", "junk") # Invalid fmt specified +%!error imwrite ([], "filename.jpg") # Empty img matrix +%!error imwrite (spones(2), "filename.jpg") # Invalid sparse img + diff --git a/octave_packages/m/image/ind2gray.m b/octave_packages/m/image/ind2gray.m new file mode 100644 index 0000000..c33c69d --- /dev/null +++ b/octave_packages/m/image/ind2gray.m @@ -0,0 +1,49 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ind2gray (@var{x}, @var{map}) +## Convert an Octave indexed image to a gray scale intensity image. +## If @var{map} is omitted, the current colormap is used to determine the +## intensities. +## @seealso{gray2ind, rgb2ntsc, image, colormap} +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function y = ind2gray (x, map) + + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (nargin == 1) + map = colormap (); + endif + + [rows, cols] = size (x); + + ## Convert colormap to intensity values (the first column of the + ## result of the call to rgb2ntsc) and then replace indices in + ## the input matrix with indexed values in the output matrix (indexed + ## values are the result of indexing the intensity values by the + ## elements of x(:)). + + y = reshape (((rgb2ntsc (map))(:,1))(x(:)), rows, cols); + +endfunction diff --git a/octave_packages/m/image/ind2rgb.m b/octave_packages/m/image/ind2rgb.m new file mode 100644 index 0000000..5f7afa7 --- /dev/null +++ b/octave_packages/m/image/ind2rgb.m @@ -0,0 +1,72 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{rgb} =} ind2rgb (@var{x}, @var{map}) +## @deftypefnx {Function File} {[@var{R}, @var{R}, @var{R}] =} ind2rgb (@var{x}, @var{map}) +## Convert an indexed image to red, green, and blue color components. +## If the colormap doesn't contain enough colors, pad it with the +## last color in the map. +## If @var{map} is omitted, the current colormap is used for the conversion. +## @seealso{rgb2ind, image, imshow, ind2gray, gray2ind} +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function [R, G, B] = ind2rgb (x, map) + + ## Do we have the right number of inputs? + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (nargin == 1) + map = colormap (); + endif + + ## Check if X is an indexed image. + if (ndims (x) != 2 || any (x(:) != fix (x(:))) || min (x(:)) < 1) + error ("ind2rgb: X must be an indexed image"); + endif + + ## Check the color map. + if (ndims (map) != 2 || columns (map) != 3) + error ("ind2rgb: MAP must be a valid colormap"); + endif + + ## Do we have enough colors in the color map? + maxidx = max (x(:)); + rm = rows (map); + if (rm < maxidx) + ## Pad with the last color in the map. + pad = repmat (map(end,:), maxidx-rm, 1); + map(end+1:maxidx, :) = pad; + endif + + ## Compute result + [hi, wi] = size (x); + R = reshape (map (x(:), 1), hi, wi); + G = reshape (map (x(:), 2), hi, wi); + B = reshape (map (x(:), 3), hi, wi); + + ## Use 3D array if only one output is requested. + if (nargout <= 1) + R(:,:,3) = B; + R(:,:,2) = G; + endif +endfunction diff --git a/octave_packages/m/image/jet.m b/octave_packages/m/image/jet.m new file mode 100644 index 0000000..a66e9f7 --- /dev/null +++ b/octave_packages/m/image/jet.m @@ -0,0 +1,65 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} jet () +## @deftypefnx {Function File} {@var{map} =} jet (@var{n}) +## Create color colormap. This colormap ranges from dark blue through blue, +## cyan, green, yellow, red, to dark red. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = jet (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("jet: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [0, 0, 0.5]; + elseif (n > 1) + x = linspace(0, 1, n)'; + r = (x >= 3/8 & x < 5/8) .* (4 * x - 3/2)\ + + (x >= 5/8 & x < 7/8) + (x >= 7/8) .* (-4 * x + 9/2); + g = (x >= 1/8 & x < 3/8) .* (4 * x - 1/2)\ + + (x >= 3/8 & x < 5/8) + (x >= 5/8 & x < 7/8) .* (-4 * x + 7/2); + b = (x < 1/8) .* (4 * x + 1/2) + (x >= 1/8 & x < 3/8)\ + + (x >= 3/8 & x < 5/8) .* (-4 * x + 5/2); + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'jet' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (jet (64)) + diff --git a/octave_packages/m/image/ntsc2rgb.m b/octave_packages/m/image/ntsc2rgb.m new file mode 100644 index 0000000..47e8fb5 --- /dev/null +++ b/octave_packages/m/image/ntsc2rgb.m @@ -0,0 +1,67 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ntsc2rgb (@var{yiq}) +## Transform a colormap or image from NTSC to RGB. +## @seealso{rgb2ntsc} +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function rgb = ntsc2rgb (yiq) + + if (nargin != 1) + print_usage (); + endif + + ## If we have an image convert it into a color map. + if (ismatrix (yiq) && ndims (yiq) == 3) + is_image = true; + Sz = size (yiq); + yiq = [yiq(:,:,1)(:), yiq(:,:,2)(:), yiq(:,:,3)(:)]; + ## Convert to a double image. + if (isinteger (yiq)) + C = class (yiq); + low = double (intmin (C)); + high = double (intmax (C)); + yiq = (double (yiq) - low) / (high - low); + endif + else + is_image = false; + endif + + if (! ismatrix (yiq) || columns (yiq) != 3) + error ("ntsc2rgb: argument must be a matrix of size Nx3 or NxMx3"); + endif + + ## Convert data + trans = [ 1.0, 1.0, 1.0; + 0.95617, -0.27269, -1.10374; + 0.62143, -0.64681, 1.70062 ]; + + rgb = yiq * trans; + + ## If input was an image, convert it back into one. + if (is_image) + rgb = reshape (rgb, Sz); + endif + +endfunction diff --git a/octave_packages/m/image/ocean.m b/octave_packages/m/image/ocean.m new file mode 100644 index 0000000..a90eb2a --- /dev/null +++ b/octave_packages/m/image/ocean.m @@ -0,0 +1,65 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} ocean () +## @deftypefnx {Function File} {@var{map} =} ocean (@var{n}) +## Create color colormap. This colormap varies from black to white with shades +## of blue. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function map = ocean (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("ocean: argument must be a scalar"); + endif + else + print_usage (); + endif + + cutin = fix (n/3); + + dr = (n - 1) / cutin; + + r = prepad ([0:dr:(n-1)], n)'; + + dg = (n - 1) / (2 * cutin); + + g = prepad([0:dg:(n-1)], n)'; + + b = [0:(n-1)]'; + + map = [ r, g, b ] / (n - 1); + +endfunction + +%!demo +%! ## Show the 'ocean' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (ocean (64)) + diff --git a/octave_packages/m/image/pink.m b/octave_packages/m/image/pink.m new file mode 100644 index 0000000..09a988a --- /dev/null +++ b/octave_packages/m/image/pink.m @@ -0,0 +1,65 @@ +## Copyright (C) 2000-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} pink () +## @deftypefnx {Function File} {@var{map} =} pink (@var{n}) +## Create color colormap. This colormap varies from black to white with +## shades of gray-pink. It gives a sepia tone when used on grayscale images. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = pink (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("pink: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [0, 0, 0]; + elseif (n > 1) + x = linspace (0, 1, n)'; + r = (x < 3/8) .* (14/9 * x) + (x >= 3/8) .* (2/3 * x + 1/3); + g = (x < 3/8) .* (2/3 * x)\ + + (x >= 3/8 & x < 3/4) .* (14/9 * x - 1/3)\ + + (x >= 3/4) .* (2/3 * x + 1/3); + b = (x < 3/4) .* (2/3 * x) + (x >= 3/4) .* (2 * x - 1); + + map = sqrt ([r, g, b]); + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'pink' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (pink (64)) + diff --git a/octave_packages/m/image/prism.m b/octave_packages/m/image/prism.m new file mode 100644 index 0000000..83de51f --- /dev/null +++ b/octave_packages/m/image/prism.m @@ -0,0 +1,58 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} prism () +## @deftypefnx {Function File} {@var{map} =} prism (@var{n}) +## Create color colormap. This colormap cycles through red, orange, yellow, +## green, blue and violet with each index change. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = prism (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("prism: argument must be a scalar"); + endif + else + print_usage (); + endif + + p = [1, 0, 0; 1, 1/2, 0; 1, 1, 0; 0, 1, 0; 0, 0, 1; 2/3, 0, 1]; + + if (rem (n, 6) == 0) + map = kron(ones (fix (n / 6), 1), p); + else + map = [kron(ones (fix (n / 6), 1), p); p(1:rem (n, 6), :)]; + endif + +endfunction + +%!demo +%! ## Show the 'prism' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (prism (64)) + diff --git a/octave_packages/m/image/rainbow.m b/octave_packages/m/image/rainbow.m new file mode 100644 index 0000000..b49c2d7 --- /dev/null +++ b/octave_packages/m/image/rainbow.m @@ -0,0 +1,67 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} rainbow () +## @deftypefnx {Function File} {@var{map} =} rainbow (@var{n}) +## Create color colormap. This colormap ranges from red through orange, +## yellow, green, blue, to violet. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +## this colormap is not part of matlab, it is like the prism +## colormap map but with a continuous map + +function map = rainbow (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("rainbow: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [1, 0, 0]; + elseif (n > 1) + x = linspace (0, 1, n)'; + r = (x < 2/5) + (x >= 2/5 & x < 3/5) .* (-5 * x + 3)\ + + (x >= 4/5) .* (10/3 * x - 8/3); + g = (x < 2/5) .* (5/2 * x) + (x >= 2/5 & x < 3/5)\ + + (x >= 3/5 & x < 4/5) .* (-5 * x + 4); + b = (x >= 3/5 & x < 4/5) .* (5 * x - 3) + (x >= 4/5); + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'rainbow' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (rainbow (64)) + diff --git a/octave_packages/m/image/rgb2hsv.m b/octave_packages/m/image/rgb2hsv.m new file mode 100644 index 0000000..22bfe1d --- /dev/null +++ b/octave_packages/m/image/rgb2hsv.m @@ -0,0 +1,102 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hsv_map} =} rgb2hsv (@var{rgb}) +## Transform a colormap or image from the RGB space to the HSV space. +## +## A color in the RGB space consists of the red, green and blue intensities. +## +## In the HSV space each color is represented by their hue, saturation +## and value (brightness). Value gives the amount of light in the color. +## Hue describes the dominant wavelength. +## Saturation is the amount of hue mixed into the color. +## @seealso{hsv2rgb} +## @end deftypefn + +## Author: Kai Habel +## Adapted-by: jwe + +function hsv_map = rgb2hsv (rgb) + + if (nargin != 1) + print_usage (); + endif + + ## If we have an image convert it into a color map. + if (ismatrix (rgb) && ndims (rgb) == 3) + is_image = true; + Sz = size (rgb); + rgb = [rgb(:,:,1)(:), rgb(:,:,2)(:), rgb(:,:,3)(:)]; + ## Convert to a double image. + if (isinteger (rgb)) + C = class (rgb); + low = double (intmin (C)); + high = double (intmax (C)); + rgb = (double (rgb) - low) / (high - low); + endif + else + is_image = false; + endif + + if (! ismatrix (rgb) || columns (rgb) != 3) + error ("rgb2hsv: RGB_MAP must be a matrix of size n x 3"); + endif + + ## get the max and min + s = min (rgb')'; + v = max (rgb')'; + + ## set hue to zero for undefined values (gray has no hue) + h = zeros (size (v)); + notgray = (s != v); + + ## blue hue + idx = (v == rgb(:,3) & notgray); + if (any (idx)) + h(idx) = 2/3 + 1/6 * (rgb(idx,1) - rgb(idx,2)) ./ (v(idx) - s(idx)); + endif + + ## green hue + idx = (v == rgb(:,2) & notgray); + if (any (idx)) + h(idx) = 1/3 + 1/6 * (rgb(idx,3) - rgb(idx,1)) ./ (v(idx) - s(idx)); + endif + + ## red hue + idx = (v == rgb(:,1) & notgray); + if (any (idx)) + h(idx) = 1/6 * (rgb(idx,2) - rgb(idx,3)) ./ (v(idx) - s(idx)); + endif + + ## correct for negative red + idx = (h < 0); + h(idx) = 1+h(idx); + + ## set the saturation + s(! notgray) = 0; + s(notgray) = 1 - s(notgray) ./ v(notgray); + + hsv_map = [h, s, v]; + + ## If input was an image, convert it back into one. + if (is_image) + hsv_map = reshape (hsv_map, Sz); + endif + +endfunction diff --git a/octave_packages/m/image/rgb2ind.m b/octave_packages/m/image/rgb2ind.m new file mode 100644 index 0000000..01067c3 --- /dev/null +++ b/octave_packages/m/image/rgb2ind.m @@ -0,0 +1,65 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{map}] =} rgb2ind (@var{rgb}) +## @deftypefnx {Function File} {[@var{x}, @var{map}] =} rgb2ind (@var{R}, @var{G}, @var{B}) +## Convert an RGB image to an Octave indexed image. +## @seealso{ind2rgb, rgb2ntsc} +## @end deftypefn + +## Bugs: The color map may have duplicate entries. + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function [x, map] = rgb2ind (R, G, B) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (nargin == 1) + rgb = R; + if (length (size (rgb)) == 3 && size (rgb, 3) == 3) + R = rgb(:,:,1); + G = rgb(:,:,2); + B = rgb(:,:,3); + else + error ("rgb2ind: argument is not an RGB image"); + endif + endif + + if (! size_equal (R, G) || ! size_equal (R, B)) + error ("rgb2ind: arguments must all have the same size"); + endif + + [hi, wi] = size (R); + + x = zeros (hi, wi); + + map = zeros (hi*wi, 3); + + map(:,1) = R(:); + map(:,2) = G(:); + map(:,3) = B(:); + + x(:) = 1:(hi*wi); + +endfunction diff --git a/octave_packages/m/image/rgb2ntsc.m b/octave_packages/m/image/rgb2ntsc.m new file mode 100644 index 0000000..bb8b803 --- /dev/null +++ b/octave_packages/m/image/rgb2ntsc.m @@ -0,0 +1,67 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rgb2ntsc (@var{rgb}) +## Transform a colormap or image from RGB to NTSC. +## @seealso{ntsc2rgb} +## @end deftypefn + +## Author: Tony Richardson +## Created: July 1994 +## Adapted-By: jwe + +function yiq = rgb2ntsc (rgb) + + if (nargin != 1) + print_usage (); + endif + + ## If we have an image convert it into a color map. + if (ismatrix (rgb) && ndims (rgb) == 3) + is_image = true; + Sz = size (rgb); + rgb = [rgb(:,:,1)(:), rgb(:,:,2)(:), rgb(:,:,3)(:)]; + ## Convert to a double image. + if (isinteger (rgb)) + C = class (rgb); + low = double (intmin (C)); + high = double (intmax (C)); + rgb = (double (rgb) - low) / (high - low); + endif + else + is_image = false; + endif + + if (! ismatrix (rgb) || columns (rgb) != 3) + error ("rgb2ntsc: argument must be a matrix of size Nx3 or NxMx3"); + endif + + ## Convert data + trans = [ 0.299, 0.596, 0.211; + 0.587, -0.274, -0.523; + 0.114, -0.322, 0.312 ]; + + yiq = rgb * trans; + + ## If input was an image, convert it back into one. + if (is_image) + yiq = reshape (yiq, Sz); + endif + +endfunction diff --git a/octave_packages/m/image/spring.m b/octave_packages/m/image/spring.m new file mode 100644 index 0000000..48a1816 --- /dev/null +++ b/octave_packages/m/image/spring.m @@ -0,0 +1,60 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} spring () +## @deftypefnx {Function File} {@var{map} =} spring (@var{n}) +## Create color colormap. This colormap varies from magenta to yellow. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = spring (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("spring: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [1, 0, 1]; + elseif (n > 1) + r = ones (n, 1); + g = (0:n - 1)' ./ (n - 1); + b = 1 - g; + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'spring' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (spring (64)) + diff --git a/octave_packages/m/image/summer.m b/octave_packages/m/image/summer.m new file mode 100644 index 0000000..0703dcf --- /dev/null +++ b/octave_packages/m/image/summer.m @@ -0,0 +1,61 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} summer () +## @deftypefnx {Function File} {@var{map} =} summer (@var{n}) +## Create color colormap. This colormap varies from green to yellow. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel +## Date: 06/03/2000 +function map = summer (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("summer: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [0, 0.5, 0.4]; + elseif (n > 1) + r = (0:n - 1)' ./ (n - 1); + g = 0.5 + r ./ 2; + b = 0.4 * ones (n, 1); + + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'summer' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (summer (64)) + diff --git a/octave_packages/m/image/white.m b/octave_packages/m/image/white.m new file mode 100644 index 0000000..13aaec8 --- /dev/null +++ b/octave_packages/m/image/white.m @@ -0,0 +1,55 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} white () +## @deftypefnx {Function File} {@var{map} =} white (@var{n}) +## Create color colormap. This colormap is completely white. +## The argument @var{n} should be a scalar. If it +## is omitted, the length of the current colormap or 64 is assumed. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = white (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("white: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n > 0) + map = ones (n, 3); + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'white' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (white (64)) + diff --git a/octave_packages/m/image/winter.m b/octave_packages/m/image/winter.m new file mode 100644 index 0000000..4252fc6 --- /dev/null +++ b/octave_packages/m/image/winter.m @@ -0,0 +1,61 @@ +## Copyright (C) 1999-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{map} =} winter () +## @deftypefnx {Function File} {@var{map} =} winter (@var{n}) +## Create color colormap. This colormap varies from blue to green. +## The argument @var{n} must be a scalar. +## If unspecified, the length of the current colormap, or 64, is used. +## @seealso{colormap} +## @end deftypefn + +## Author: Kai Habel + +function map = winter (n) + + if (nargin == 0) + n = rows (colormap); + elseif (nargin == 1) + if (! isscalar (n)) + error ("winter: argument must be a scalar"); + endif + else + print_usage (); + endif + + if (n == 1) + map = [0, 0, 1]; + elseif (n > 1) + r = zeros (n, 1); + g = (0:n - 1)' ./ (n - 1); + b = 1 - g ./ 2; + + map = [r, g, b]; + else + map = []; + endif + +endfunction + +%!demo +%! ## Show the 'winter' colormap as an image +%! image (1:64, linspace (0, 1, 64), repmat (1:64, 64, 1)') +%! axis ([1, 64, 0, 1], "ticy", "xy") +%! colormap (winter (64)) + diff --git a/octave_packages/m/io/beep.m b/octave_packages/m/io/beep.m new file mode 100644 index 0000000..e4c4e21 --- /dev/null +++ b/octave_packages/m/io/beep.m @@ -0,0 +1,38 @@ +## Copyright (C) 2003-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} beep () +## Produce a beep from the speaker (or visual bell). +## @seealso{puts, fputs, printf, fprintf} +## @end deftypefn + +## Author: jwe + +function beep () + + if (nargin != 0) + print_usage (); + endif + + puts ("\a"); + +endfunction + + +%!error (beep (1)) diff --git a/octave_packages/m/io/csvread.m b/octave_packages/m/io/csvread.m new file mode 100644 index 0000000..c924d39 --- /dev/null +++ b/octave_packages/m/io/csvread.m @@ -0,0 +1,41 @@ +## Copyright (C) 2001-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} csvread (@var{filename}) +## @deftypefnx {Function File} {@var{x} =} csvread (@var{filename}, @var{dlm_opts}) +## Read the comma-separated-value file @var{filename} into the matrix @var{x}. +## +## This function is equivalent to +## +## @example +## @var{x} = dlmread (@var{filename}, "," , @dots{}) +## @end example +## +## @seealso{csvwrite, dlmread, dlmwrite} +## @end deftypefn + +function x = csvread (filename, varargin) + x = dlmread (filename, ",", varargin{:}); +endfunction + + +%% Tests for csvread() are in csvwrite() +%% Mark file as being tested +%!assert (1) + diff --git a/octave_packages/m/io/csvwrite.m b/octave_packages/m/io/csvwrite.m new file mode 100644 index 0000000..3d918db --- /dev/null +++ b/octave_packages/m/io/csvwrite.m @@ -0,0 +1,54 @@ +## Copyright (C) 2001-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} csvwrite (@var{filename}, @var{x}) +## @deftypefnx {Function File} {} csvwrite (@var{filename}, @var{x}, @var{dlm_opts}) +## Write the matrix @var{x} to the file @var{filename} in +## @w{comma-separated-value} format. +## +## This function is equivalent to +## +## @example +## dlmwrite (@var{filename}, @var{x}, ",", @dots{}) +## @end example +## +## @seealso{csvread, dlmwrite, dlmread} +## @end deftypefn + +function csvwrite (filename, x, varargin) + dlmwrite (filename, x, ",", varargin{:}); +endfunction + + +%!shared fname +%! fname = tmpnam (); + +%!test +%! csvwrite (fname, magic (3)); +%! assert (csvread (fname), magic (3)); +%! unlink (fname); + +%!test +%! csvwrite (fname, magic (3), "precision", "%2.1f", "newline", "unix"); +%! fid = fopen (fname, "rt"); +%! txt = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! assert (txt, "8.0,1.0,6.0\n3.0,5.0,7.0\n4.0,9.0,2.0\n"); +%! unlink (fname); + diff --git a/octave_packages/m/io/dlmwrite.m b/octave_packages/m/io/dlmwrite.m new file mode 100644 index 0000000..c10a252 --- /dev/null +++ b/octave_packages/m/io/dlmwrite.m @@ -0,0 +1,212 @@ +## Copyright (C) 2002-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dlmwrite (@var{file}, @var{M}) +## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, @var{delim}, @var{r}, @var{c}) +## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, @var{key}, @var{val} @dots{}) +## @deftypefnx {Function File} {} dlmwrite (@var{file}, @var{M}, "-append", @dots{}) +## @deftypefnx {Function File} {} dlmwrite (@var{fid}, @dots{}) +## Write the matrix @var{M} to the named file using delimiters. +## +## @var{file} should be a file name or writable file ID given by @code{fopen}. +## +## The parameter @var{delim} specifies the delimiter to use to separate +## values on a row. +## +## The value of @var{r} specifies the number of delimiter-only lines to +## add to the start of the file. +## +## The value of @var{c} specifies the number of delimiters to prepend to +## each line of data. +## +## If the argument @code{"-append"} is given, append to the end of +## @var{file}. +## +## In addition, the following keyword value pairs may appear at the end +## of the argument list: +## +## @table @asis +## @item "append" +## Either @samp{"on"} or @samp{"off"}. See @samp{"-append"} above. +## +## @item "delimiter" +## See @var{delim} above. +## +## @item "newline" +## The character(s) to use to separate each row. Three special cases +## exist for this option. @samp{"unix"} is changed into "\n", +## @samp{"pc"} is changed into "\r\n", and @samp{"mac"} is changed +## into "\r". Other values for this option are kept as is. +## +## @item "roffset" +## See @var{r} above. +## +## @item "coffset" +## See @var{c} above. +## +## @item "precision" +## The precision to use when writing the file. It can either be a +## format string (as used by fprintf) or a number of significant digits. +## @end table +## +## @example +## dlmwrite ("file.csv", reshape (1:16, 4, 4)); +## @end example +## +## @example +## dlmwrite ("file.tex", a, "delimiter", "&", "newline", "\\n") +## @end example +## +## @seealso{dlmread, csvread, csvwrite} +## @end deftypefn + +## Author: Paul Kienzle +## +## This program was originally granted to the public domain +## +## 2002-03-08 Paul Kienzle +## * Initial revision +## 2005-11-27 Bill Denney +## * Significant modifications of the input arguments for additional +## functionality. + +function dlmwrite (file, M, varargin) + + if (nargin < 2) + print_usage (); + endif + + ## set defaults + delim = ","; + r = c = 0; + newline = "\n"; + if (ischar (M)) + precision = "%c"; + else + precision = "%.16g"; + endif + opentype = "wt"; + + ## process the input arguments + i = 0; + while (i < length (varargin)) + i++; + if (strcmpi (varargin{i}, "delimiter")) + delim = varargin{++i}; + elseif (strcmpi (varargin{i}, "newline")) + newline = varargin{++i}; + if (strcmpi (newline, "unix")) + newline = "\n"; + elseif (strcmpi (newline, "pc")) + newline = "\r\n"; + elseif (strcmpi (newline, "mac")) + newline = "\r"; + endif + elseif (strcmpi (varargin{i}, "roffset")) + r = varargin{++i}; + elseif (strcmpi (varargin{i}, "coffset")) + c = varargin{++i}; + elseif (strcmpi (varargin{i}, "precision")) + precision = varargin{++i}; + if (! strcmpi (class (precision), "char")) + precision = sprintf ("%%.%gg", precision); + endif + elseif (strcmpi (varargin{i}, "-append")) + opentype = "at"; + elseif (strcmpi (varargin{i}, "append")) + i++; + if (strcmpi (varargin{i}, "on")) + opentype = "at"; + elseif (strcmpi (varargin{i}, "off")) + opentype = "wt"; + else + error ('dlmwrite: append must be "on" or "off"'); + endif + else + if (i == 1) + delim = varargin{i}; + elseif (i == 2) + r = varargin{i}; + elseif (i == 3) + c = varargin{i}; + else + print_usage(); + endif + endif + endwhile + + if (ischar (file)) + [fid, msg] = fopen (file, opentype); + elseif (isscalar (file) && isnumeric (file)) + [fid, msg] = deal (file, "invalid file number"); + else + error ("dlmwrite: FILE must be a filename string or numeric FID"); + endif + + if (fid < 0) + error (["dlmwrite: " msg]); + else + if (r > 0) + fprintf (fid, "%s", + repmat ([repmat(delim, 1, c + columns(M)-1), newline], 1, r)); + endif + if (iscomplex (M)) + cprecision = regexprep (precision, '^%([-\d.])', '%+$1'); + template = [precision, cprecision, "i", ... + repmat([delim, precision, cprecision, "i"], 1, ... + columns(M) - 1), newline ]; + else + template = [precision, repmat([delim, precision], 1, columns(M)-1),... + newline]; + endif + if (c > 0) + template = [repmat(delim, 1, c), template]; + endif + if (iscomplex (M)) + M = M.'; + b = zeros (2*rows(M), columns (M)); + b(1: 2 : end, :) = real (M); + b(2: 2 : end, :) = imag (M); + fprintf (fid, template, b); + else + fprintf (fid, template, M.'); + endif + if (! isscalar (file)) + fclose (fid); + endif + endif + +endfunction + + +%!test +%! f = tmpnam (); +%! dlmwrite (f,[1,2;3,4],'precision','%5.2f','newline','unix','roffset',1,'coffset',1); +%! fid = fopen (f,"rt"); +%! f1 = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! dlmwrite (f,[5,6],'precision','%5.2f','newline','unix','coffset',1,'delimiter',',','-append'); +%! fid = fopen (f,"rt"); +%! f2 = char (fread (fid,Inf,'char')'); +%! fclose (fid); +%! unlink (f); +%! +%! assert (f1,",,\n, 1.00, 2.00\n, 3.00, 4.00\n"); +%! assert (f2,",,\n, 1.00, 2.00\n, 3.00, 4.00\n, 5.00, 6.00\n"); + diff --git a/octave_packages/m/io/fileread.m b/octave_packages/m/io/fileread.m new file mode 100644 index 0000000..bfc7d7e --- /dev/null +++ b/octave_packages/m/io/fileread.m @@ -0,0 +1,63 @@ +## Copyright (C) 2010-2012 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{str} =} fileread (@var{filename}) +## Read the contents of @var{filename} and return it as a string. +## @seealso{fread, textread, sscanf} +## @end deftypefn + +function str = fileread (filename) + + if (nargin != 1) + print_usage (); + endif + + if (! ischar (filename)) + error ("fileread: FILENAME argument must be a string"); + endif + + fid = fopen (filename, "r"); + if (fid < 0) + error ("fileread: cannot open file"); + endif + + unwind_protect + str = fread (fid, "*char"); + unwind_protect_cleanup + fclose (fid); + end_unwind_protect + +endfunction + + +%!test +%! cstr = {"Hello World", "The answer is 42", "Goodbye World"}; +%! fname = tmpnam (); +%! fid = fopen (fname, "w"); +%! fprintf (fid, "%s\n", cstr{:}) +%! fclose (fid); +%! str = fileread (fname); +%! assert (str', [cstr{1} "\n" cstr{2} "\n" cstr{3} "\n"]); +%! unlink (fname); + +%% Test input validation +%!error fileread () +%!error fileread (1, 2) +%!error fileread (1) + diff --git a/octave_packages/m/io/is_valid_file_id.m b/octave_packages/m/io/is_valid_file_id.m new file mode 100644 index 0000000..3734653 --- /dev/null +++ b/octave_packages/m/io/is_valid_file_id.m @@ -0,0 +1,46 @@ +## Copyright (C) 2010-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} is_valid_file_id (@var{fid}) +## Return true if @var{fid} refers to an open file. +## @seealso{fopen} +## @end deftypefn + +function retval = is_valid_file_id (fid) + + retval = false; + + if (nargin == 1) + try + if (isscalar (fid)) + [file, mode, arch] = fopen (fid); + retval = ! isempty (file); + endif + end_try_catch + else + print_usage (); + endif + +endfunction + +%!assert (is_valid_file_id (stdout)) +%!assert (! is_valid_file_id ([1,2;3,4])) +%!assert (! is_valid_file_id ("not_a_file_id")) +%!assert (! is_valid_file_id (-1)) +%!assert (! is_valid_file_id (pi)) diff --git a/octave_packages/m/io/strread.m b/octave_packages/m/io/strread.m new file mode 100644 index 0000000..0320444 --- /dev/null +++ b/octave_packages/m/io/strread.m @@ -0,0 +1,889 @@ +## Copyright (C) 2009-2012 Eric Chassande-Mottin, CNRS (France) +## Copyright (C) 2012 Philip Nienhuis +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{a}, @dots{}] =} strread (@var{str}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{format_repeat}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{prop1}, @var{value1}, @dots{}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} strread (@var{str}, @var{format}, @var{format_repeat}, @var{prop1}, @var{value1}, @dots{}) +## Read data from a string. +## +## The string @var{str} is split into words that are repeatedly matched to the +## specifiers in @var{format}. The first word is matched to the first +## specifier, the second to the second specifier and so forth. If there are +## more words than specifiers, the process is repeated until all words have +## been processed. +## +## The string @var{format} describes how the words in @var{str} should be +## parsed. +## It may contain any combination of the following specifiers: +## +## @table @code +## @item %s +## The word is parsed as a string. +## +## @itemx %f +## @itemx %n +## The word is parsed as a number and converted to double. +## +## @item %d +## @itemx %u +## The word is parsed as a number and converted to int32. +## +## @item %*', '%*f', '%*s +## The word is skipped. +## +## For %s and %d, %f, %n, %u and the associated %*s @dots{} specifiers an +## optional width can be specified as %Ns, etc. where N is an integer > 1. +## For %f, format specifiers like %N.Mf are allowed. +## +## @item literals +## In addition the format may contain literal character strings; these will be +## skipped during reading. +## @end table +## +## Parsed word corresponding to the first specifier are returned in the first +## output argument and likewise for the rest of the specifiers. +## +## By default, @var{format} is @t{"%f"}, meaning that numbers are read from +## @var{str}. This will do if @var{str} contains only numeric fields. +## +## For example, the string +## +## @example +## @group +## @var{str} = "\ +## Bunny Bugs 5.5\n\ +## Duck Daffy -7.5e-5\n\ +## Penguin Tux 6" +## @end group +## @end example +## +## @noindent +## can be read using +## +## @example +## [@var{a}, @var{b}, @var{c}] = strread (@var{str}, "%s %s %f"); +## @end example +## +## Optional numeric argument @var{format_repeat} can be used for +## limiting the number of items read: +## +## @table @asis +## @item -1 +## (default) read all of the string until the end. +## +## @item N +## Read N times @var{nargout} items. 0 (zero) is an acceptable +## value for @var{format_repeat}. +## @end table +## +## The behavior of @code{strread} can be changed via property-value +## pairs. The following properties are recognized: +## +## @table @asis +## @item "commentstyle" +## Parts of @var{str} are considered comments and will be skipped. +## @var{value} is the comment style and can be any of the following. +## @itemize +## @item "shell" +## Everything from @code{#} characters to the nearest end-of-line is skipped. +## +## @item "c" +## Everything between @code{/*} and @code{*/} is skipped. +## +## @item "c++" +## Everything from @code{//} characters to the nearest end-of-line is skipped. +## +## @item "matlab" +## Everything from @code{%} characters to the nearest end-of-line is skipped. +## +## @item user-supplied. Two options: +## (1) One string, or 1x1 cell string: Skip everything to the right of it; +## (2) 2x1 cell string array: Everything between the left and right strings +## is skipped. +## @end itemize +## +## @item "delimiter" +## Any character in @var{value} will be used to split @var{str} into words +## (default value = any whitespace). +## +## @item "emptyvalue": +## Value to return for empty numeric values in non-whitespace delimited data. +## The default is NaN@. When the data type does not support NaN +## (int32 for example), then default is zero. +## +## @item "multipledelimsasone" +## Treat a series of consecutive delimiters, without whitespace in between, +## as a single delimiter. Consecutive delimiter series need not be vertically +## "aligned". +## +## @item "treatasempty" +## Treat single occurrences (surrounded by delimiters or whitespace) of the +## string(s) in @var{value} as missing values. +## +## @item "returnonerror" +## If @var{value} true (1, default), ignore read errors and return normally. +## If false (0), return an error. +## +## @item "whitespace" +## Any character in @var{value} will be interpreted as whitespace and +## trimmed; the string defining whitespace must be enclosed in double +## quotes for proper processing of special characters like \t. +## The default value for whitespace = " \b\r\n\t" (note the space). +## Unless whitespace is set to '' (empty) AND at least one "%s" format +## conversion specifier is supplied, a space is always part of whitespace. +## +## @end table +## +## @seealso{textscan, textread, load, dlmread, fscanf} +## @end deftypefn + +function varargout = strread (str, format = "%f", varargin) + + ## Check input + if (nargin < 1) + print_usage (); + endif + + if (isempty (format)) + format = "%f"; + endif + + if (! ischar (str) || ! ischar (format)) + error ("strread: STR and FORMAT arguments must be strings"); + endif + + ## Parse format string to compare number of conversion fields and nargout + nfields = length (strfind (format, "%")) - length (strfind (format, "%*")); + ## If str only has numeric fields, a (default) format ("%f") will do. + ## Otherwise: + if ((max (nargout, 1) != nfields) && ! strcmp (format, "%f")) + error ("strread: the number of output variables must match that specified by FORMAT"); + endif + + ## Check for format string repeat count + format_repeat_count = -1; + if (nargin > 2 && isnumeric (varargin{1})) + if (varargin{1} >= 0) + format_repeat_count = varargin{1}; + endif + if (nargin > 3) + varargin = varargin(2:end); + else + varargin = {}; + endif + endif + + ## Parse options. First initialize defaults + comment_flag = false; + delimiter_str = ""; + empty_str = ""; + eol_char = ""; + err_action = 0; + mult_dlms_s1 = false; + numeric_fill_value = NaN; + white_spaces = " \b\r\n\t"; + for n = 1:2:length (varargin) + switch (lower (varargin{n})) + case "bufsize" + ## We could synthesize this, but that just seems weird... + warning ('strread: property "bufsize" is not implemented'); + case "commentstyle" + comment_flag = true; + switch (lower (varargin{n+1})) + case "c" + [comment_start, comment_end] = deal ("/*", "*/"); + case "c++" + [comment_start, comment_end] = deal ("//", "eol_char"); + case "shell" + [comment_start, comment_end] = deal ("#" , "eol_char"); + case "matlab" + [comment_start, comment_end] = deal ("%" , "eol_char"); + otherwise + if (ischar (varargin{n+1}) || + (numel (varargin{n+1}) == 1 && iscellstr (varargin{n+1}))) + [comment_start, comment_end] = deal (char (varargin{n+1}), "eol_char"); + elseif (iscellstr (varargin{n+1}) && numel (varargin{n+1}) == 2) + [comment_start, comment_end] = deal (varargin{n+1}{:}); + else + ## FIXME - a user may have numeric values specified: {'//', 7} + ## this will lead to an error in the warning message + error ("strread: unknown or unrecognized comment style '%s'", + varargin{n+1}); + endif + endswitch + case "delimiter" + delimiter_str = varargin{n+1}; + if (strcmp (typeinfo (delimiter_str), "sq_string")) + delimiter_str = do_string_escapes (delimiter_str); + endif + case "emptyvalue" + numeric_fill_value = varargin{n+1}; + case "expchars" + warning ('strread: property "expchars" is not implemented'); + case "whitespace" + white_spaces = varargin{n+1}; + if (strcmp (typeinfo (white_spaces), "sq_string")) + white_spaces = do_string_escapes (white_spaces); + endif + ## The following parameters are specific to textscan and textread + case "endofline" + eol_char = varargin{n+1}; + if (strcmp (typeinfo (eol_char), "sq_string")) + eol_char = do_string_escapes (eol_char); + endif + case "returnonerror" + err_action = varargin{n+1}; + case "multipledelimsasone" + mult_dlms_s1 = varargin{n+1}; + case "treatasempty" + if (iscellstr (varargin{n+1})) + empty_str = varargin{n+1}; + elseif (ischar (varargin{n+1})) + empty_str = varargin(n+1); + else + error ('strread: "treatasempty" value must be string or cellstr'); + endif + otherwise + warning ('strread: unknown property "%s"', varargin{n}); + endswitch + endfor + + ## First parse of FORMAT + if (strcmpi (strtrim (format), "%f")) + ## Default format specified. Expand it (to desired nargout) + fmt_words = cell (nargout, 1); + fmt_words (1:nargout) = format; + else + ## Determine the number of words per line as a first guess. Forms + ## like %f) (w/o delimiter in between) are fixed further on + format = strrep (format, "%", " %"); + fmt_words = regexp (format, '[^ ]+', 'match'); + ## Format conversion specifiers following literals w/o space/delim + ## in between are separate now. Separate those w trailing literals + idy2 = find (! cellfun ("isempty", strfind (fmt_words, "%"))); + a = strfind (fmt_words(idy2), "%"); + b = regexp (fmt_words(idy2), '[nfdus]', 'end'); + for jj = 1:numel (a) + ii = numel (a) - jj + 1; + if (! (length (fmt_words{idy2(ii)}) == b{ii}(1))) + ## Fix format_words + fmt_words(idy2(ii)+1 : end+1) = fmt_words(idy2(ii) : end); + fmt_words{idy2(ii)} = fmt_words{idy2(ii)}(a{ii} : b{ii}(1)); + fmt_words{idy2(ii)+1} = fmt_words{idy2(ii)+1}(b{ii}+1:end); + endif + endfor + endif + num_words_per_line = numel (fmt_words); + + ## Special handling for CRLF EOL character in str + if (! isempty (eol_char) && strcmp (eol_char, "\r\n")) + ## Strip CR from CRLF sequences + str = strrep (str, "\r\n", "\n"); + ## CR serves no further purpose in function + eol_char = "\n"; + endif + + ## Remove comments in str + if (comment_flag) + ## Expand 'eol_char' here, after option processing which may have set value + comment_end = regexprep (comment_end, 'eol_char', eol_char); + cstart = strfind (str, comment_start); + cstop = strfind (str, comment_end); + ## Treat end of string as additional comment stop + if (isempty (cstop) || cstop(end) != length (str)) + cstop(end+1) = length (str); + endif + if (! isempty (cstart)) + ## Ignore nested openers. + [idx, cidx] = unique (lookup (cstop, cstart), "first"); + if (idx(end) == length (cstop)) + cidx(end) = []; # Drop the last one if orphaned. + endif + cstart = cstart(cidx); + endif + if (! isempty (cstop)) + ## Ignore nested closers. + [idx, cidx] = unique (lookup (cstart, cstop), "first"); + if (idx(1) == 0) + cidx(1) = []; # Drop the first one if orphaned. + endif + cstop = cstop(cidx); + endif + len = length (str); + c2len = length (comment_end); + str = cellslices (str, [1, cstop + c2len], [cstart - 1, len]); + str = [str{:}]; + endif + + if (! isempty (white_spaces)) + ## For numeric fields, whitespace is always a delimiter, but not for text fields + if (isempty (strfind (format, "%s"))) + ## Add whitespace to delimiter set + delimiter_str = unique ([white_spaces delimiter_str]); + else + ## Remove any delimiter chars from white_spaces list + white_spaces = setdiff (white_spaces, delimiter_str); + endif + endif + if (isempty (delimiter_str)) + delimiter_str = " "; + endif + if (! isempty (eol_char)) + ## Add eol_char to delimiter collection + delimiter_str = unique ([delimiter_str eol_char]); + ## .. and remove it from whitespace collection + white_spaces = strrep (white_spaces, eol_char, ''); + endif + + pad_out = 0; + ## Trim whitespace if needed + if (! isempty (white_spaces)) + ## Check if trailing "\n" might signal padding output arrays to equal size + ## before it is trimmed away below + if ((str(end) == 10) && (nargout > 1)) + pad_out = 1; + endif + ## Condense all repeated whitespace into one single space + ## FIXME: this will also fold repeated whitespace in a char field + rxp_wsp = sprintf ("[%s]+", white_spaces); + str = regexprep (str, rxp_wsp, ' '); + ## Remove possible leading space at string + if (str(1) == 32) + str = str(2:end); + endif + ## Check for single delimiter followed/preceded by whitespace + ## FIXME: Double strrep on str is enormously expensive of CPU time. + ## Can this be eliminated + if (! isempty (delimiter_str)) + dlmstr = setdiff (delimiter_str, " "); + rxp_dlmwsp = sprintf ("( [%s]|[%s] )", dlmstr, dlmstr); + str = regexprep (str, rxp_dlmwsp, delimiter_str(1)); + endif + ## FIXME: Double strrep on str is enormously expensive of CPU time. + ## Can this be eliminated + ## Wipe leading and trailing whitespace on each line (it may be delimiter too) + if (! isempty (eol_char)) + str = strrep (str, [eol_char " "], eol_char); + str = strrep (str, [" " eol_char], eol_char); + endif + endif + + ## Split 'str' into words + words = split_by (str, delimiter_str, mult_dlms_s1, eol_char); + if (! isempty (white_spaces)) + ## Trim leading and trailing white_spaces + ## FIXME: Is this correct? strtrim clears what matches isspace(), not + ## necessarily what is in white_spaces. + words = strtrim (words); + endif + num_words = numel (words); + ## First guess at number of lines in file (ignoring leading/trailing literals) + num_lines = ceil (num_words / num_words_per_line); + + ## Replace TreatAsEmpty char sequences by empty strings + if (! isempty (empty_str)) + for ii = 1:numel (empty_str) + idz = strmatch (empty_str{ii}, words, "exact"); + words(idz) = {""}; + endfor + endif + + ## fmt_words has been split properly now, but words{} has only been split on + ## delimiter positions. + ## As numeric fields can also be separated by whitespace, more splits may be + ## needed. + ## We also don't know the number of lines (as EndOfLine may have been set to + ## "" (empty) by the caller). + ## + ## We also may have to cope with 3 cases as far as literals go: + ## A: Trailing literals (%f) w/o delimiter in between. + ## B: Leading literals (%f) w/o delimiter in between. + ## C. Skipping leftover parts of specified skip fields (%*N ) + ## Some words columns may have to be split further to fix these. + + ## Find indices and pointers to possible literals in fmt_words + idf = cellfun ("isempty", strfind (fmt_words, "%")); + ## Find indices and pointers to conversion specifiers with fixed width + idg = ! cellfun ("isempty", regexp (fmt_words, '%\*?\d')); + idy = find (idf | idg); + ## Find indices to numeric conversion specifiers + idn = ! cellfun ("isempty", regexp (fmt_words, "%[dnfu]")); + + ## If needed, split up columns in three steps: + if (! isempty (idy)) + ## Try-catch because complexity of strings to read can be infinite + try + + ## 1. Assess "period" in the split-up words array ( < num_words_per_line). + ## Could be done using EndOfLine but that prohibits EndOfLine = "" option. + ## Alternative below goes by simply parsing a first grab of words + ## and counting words until the fmt_words array is exhausted: + iwrd = 1; iwrdp = 0; iwrdl = length (words{iwrd}); + for ii = 1:numel (fmt_words) + + nxt_wrd = 0; + + if (idf(ii)) + ## Literal expected + if (isempty (strfind (fmt_words{ii}, words(iwrd)))) + ## Not found in current word; supposed to be in next word + nxt_wrd = 1; + else + ## Found it in current word. Subtract literal length + iwrdp += length (fmt_words{ii}); + if (iwrdp > iwrdl) + ## Parse error. Literal extends beyond delimiter (word boundary) + warning ("strread: literal '%s' (fmt spec # %d) does not match data", ... + fmt_words{ii}, ii); + ## Word assumed to be completely "used up". Next word + nxt_wrd = 1; + elseif (iwrdp == iwrdl) + ## Word completely "used up". Next word + nxt_wrd = 1; + endif + endif + + elseif (idg(ii)) + ## Fixed width specifier (%N or %*N): read just a part of word + iwrdp += floor ... + (str2double (fmt_words{ii}(regexp(fmt_words{ii}, '\d') : end-1))); + if (iwrdp > iwrdl) + ## Match error. Field extends beyond word boundary. + warning ... + ("strread: field width '%s' (fmt spec # %d) extends beyond actual word limit", ... + fmt_words{ii}, ii); + ## Assume word to be completely "used up". Next word + nxt_wrd = 1; + elseif (iwrdp == iwrdl) + ## Word completely "used up". Next word + nxt_wrd = 1; + endif + + else + ## A simple format conv. specifier. Either (1) uses rest of word, or + ## (2) is squeezed between current iwrdp and next literal, or (3) uses + ## next word. (3) is already taken care of. So just check (1) & (2) + if (ii < numel (fmt_words) && idf(ii+1)) + ## Next fmt_word is a literal... + if (! index (words{iwrd}(iwrdp+1:end), fmt_words{ii+1})) + ## ...but not found in current word => field uses rest of word + nxt_wrd = 1; + else + ## ..or it IS found. Add inferred width of current conversion field + iwrdp += index (words{iwrd}(iwrdp+1:end), fmt_words{ii+1}) - 1; + endif + elseif (iwrdp < iwrdl) + ## No bordering literal to the right => field occupies (rest of) word + nxt_wrd = 1; + endif + + endif + + if (nxt_wrd) + ++iwrd; iwrdp = 0; + if (ii < numel (fmt_words)) + iwrdl = length (words{iwrd}); + endif + endif + + endfor + ## Done + words_period = max (iwrd - 1, 1); + num_lines = ceil (num_words / words_period); + + ## 2. Pad words array so that it can be reshaped + tmp_lines = ceil (num_words / words_period); + num_words_padded = tmp_lines * words_period - num_words; + if (num_words_padded) + words = [words'; cell(num_words_padded, 1)]; + endif + words = reshape (words, words_period, tmp_lines); + + ## 3. Do the column splitting on rectangular words array + icol = 1; ii = 1; # icol = current column, ii = current fmt_word + while (ii <= num_words_per_line) + + ## Check if fmt_words(ii) contains a literal or fixed-width + if ((idf(ii) || idg(ii)) && (rows(words) < num_words_per_line)) + if (idf(ii)) + s = strfind (words(icol, 1), fmt_words{ii}); + if (isempty (s{:})) + error ("strread: Literal '%s' not found in column %d", fmt_words{ii}, icol); + endif + s = s{:}(1); + e = s(1) + length (fmt_words{ii}) - 1; + endif + if (! strcmp (fmt_words{ii}, words{icol, 1})) + ## Column doesn't exactly match literal => split needed. Insert a column + words(icol+1:end+1, :) = words(icol:end, :); + ## Watch out for empty cells + jptr = find (! cellfun ("isempty", words(icol, :))); + + ## Distinguish leading or trailing literals + if (! idg(ii) && ! isempty (s) && s(1) == 1) + ## Leading literal. Assign literal to icol, paste rest in icol + 1 + ## Apply only to those cells that do have something beyond literal + jptr = find (cellfun("length", words(icol+1, jptr), ... + "UniformOutput", false) > e(1)); + words(icol+1, :) = {""}; + words(icol+1, jptr) = cellfun ... + (@(x) substr(x, e(1)+1, length(x)-e(1)), words(icol, jptr), ... + "UniformOutput", false); + words(icol, jptr) = fmt_words{ii}; + + else + if (! idg(ii) && ! isempty (strfind (fmt_words{ii-1}, "%s"))) + ## Trailing literal. If preceding format == '%s' this is an error + warning ("Ambiguous '%s' specifier next to literal in column %d", icol); + elseif (idg(ii)) + ## Current field = fixed width. Strip into icol, rest in icol+1 + wdth = floor (str2double (fmt_words{ii}(regexp(fmt_words{ii}, ... + '\d') : end-1))); + words(icol+1, jptr) = cellfun (@(x) x(wdth+1:end), + words(icol,jptr), "UniformOutput", false); + words(icol, jptr) = strtrunc (words(icol, jptr), wdth); + else + ## FIXME: this assumes char(254)/char(255) won't occur in input! + clear wrds; + wrds(1:2:2*numel (words(icol, jptr))) = ... + strrep (words(icol, jptr), fmt_words{ii}, ... + [char(255) char(254)]); + wrds(2:2:2*numel (words(icol, jptr))-1) = char(255); + wrds = strsplit ([wrds{:}], char(255)); + words(icol, jptr) = ... + wrds(find (cellfun ("isempty", strfind (wrds, char(254))))); + wrds(find (cellfun ("isempty", strfind (wrds, char(254))))) ... + = char(255); + words(icol+1, jptr) = strsplit (strrep ([wrds{2:end}], ... + char(254), fmt_words{ii}), char(255)); + ## Former trailing literal may now be leading for next specifier + --ii; + endif + endif + endif + + else + ## Conv. specifier. Peek if next fmt_word needs split from current column + if (ii < num_words_per_line) + if (idf(ii+1) && (! isempty (strfind (words{icol, 1}, fmt_words{ii+1})))) + --icol; + elseif (idg(ii+1)) + --icol; + endif + endif + endif + ## Next fmt_word, next column + ++ii; ++icol; + endwhile + + ## Done. Reshape words back into 1 long vector and strip padded empty words + words = reshape (words, 1, numel (words))(1 : end-num_words_padded); + + catch + warning ("strread: unable to parse text or file with given format string"); + return; + + end_try_catch + endif + + ## For each specifier, process corresponding column + k = 1; + for m = 1:num_words_per_line + try + if (format_repeat_count < 0) + data = words(m:num_words_per_line:end); + elseif (format_repeat_count == 0) + data = {}; + else + lastline = ... + min (num_words_per_line * format_repeat_count + m - 1, numel (words)); + data = words(m:num_words_per_line:lastline); + endif + + ## Map to format + ## FIXME - add support for formats like "<%s>", "%[a-zA-Z]" + ## Someone with regexp experience is needed. + switch fmt_words{m}(1:min (2, length (fmt_words{m}))) + case "%s" + if (pad_out) + data(end+1:num_lines) = {""}; + endif + varargout{k} = data'; + k++; + case {"%d", "%u", "%f", "%n"} + n = cellfun ("isempty", data); + ### FIXME - erroneously formatted data lead to NaN, not an error + data = str2double (data); + if (! isempty (regexp (fmt_words{m}, "%[du]"))) + ## Cast to integer + ## FIXME: NaNs will be transformed into zeros + data = int32 (data); + endif + data(n) = numeric_fill_value; + if (pad_out) + data(end+1:num_lines) = numeric_fill_value; + endif + varargout{k} = data.'; + k++; + case {"%0", "%1", "%2", "%3", "%4", "%5", "%6", "%7", "%8", "%9"} + nfmt = strsplit (fmt_words{m}(2:end-1), '.'); + swidth = str2double (nfmt{1}); + switch fmt_words{m}(end) + case {"d", "u", "f", "n%"} + n = cellfun ("isempty", data); + ### FIXME - erroneously formatted data lead to NaN, not an error + ### => ReturnOnError can't be implemented for numeric data + data = str2double (strtrunc (data, swidth)); + data(n) = numeric_fill_value; + if (pad_out) + data(end+1:num_lines) = numeric_fill_value; + endif + if (numel (nfmt) > 1) + sprec = str2double (nfmt{2}); + data = 10^-sprec * round (10^sprec * data); + elseif (! isempty (regexp (fmt_words{m}, "[du]"))) + ## Cast to integer + ## FIXME: NaNs will be transformed into zeros + data = int32 (data); + endif + varargout{k} = data.'; + k++; + case "s" + if (pad_out) + data(end+1:num_lines) = {""}; + endif + varargout{k} = strtrunc (data, swidth)'; + k++; + otherwise + endswitch + case {"%*", "%*s"} + ## skip the word + otherwise + ## Ensure descriptive content is consistent. + ## Test made a bit lax to accomodate for incomplete last lines + n = find (! cellfun ("isempty", data)); + if (numel (unique (data(n))) > 1 + || ! strcmpi (unique (data), fmt_words{m})) + error ("strread: FORMAT does not match data"); + endif + endswitch + catch + ## As strread processes columnwise, ML-compatible error processing + ## (row after row) is not feasible. In addition Octave sets unrecognizable + ## numbers to NaN w/o error. But maybe Octave is better in this respect. + if (err_action) + ## Just try the next column where ML bails out + else + rethrow (lasterror); + endif + end_try_catch + endfor + +endfunction + +function out = split_by (text, sep, mult_dlms_s1, eol_char) + + ## Check & if needed, process MultipleDelimsAsOne parameter + if (mult_dlms_s1) + mult_dlms_s1 = true; + ## FIXME: Should re-implement strsplit() function here in order + ## to avoid strrep on megabytes of data. + ## If \n is in sep collection we need to enclose it in text + ## to avoid it being included in consecutive delim series + enchr = ' '; + ## However watch out if eol_char is also in delimiters + if (index (sep, eol_char)); enchr = char(255); endif + text = strrep (text, eol_char, [enchr eol_char enchr]); + else + mult_dlms_s1 = false; + endif + + ## Split text string along delimiters + out = strsplit (text, sep, mult_dlms_s1); + if (index (sep, eol_char)); out = strrep (out, char(255), ''); endif + ## In case of trailing delimiter, strip stray last empty word + if (!isempty (out) && any (sep == text(end))) + out(end) = []; + endif + + ## Empty cells converted to empty cellstrings. + out(cellfun ("isempty", out)) = {""}; + +endfunction + + +%!test +%! [a, b] = strread ("1 2", "%f%f"); +%! assert (a, 1); +%! assert (b, 2); + +%!test +%! str = ''; +%! a = rand (10, 1); +%! b = char (randi ([65, 85], 10, 1)); +%! for k = 1:10 +%! str = sprintf ('%s %.6f %s\n', str, a(k), b(k)); +%! endfor +%! [aa, bb] = strread (str, '%f %s'); +%! assert (a, aa, 1e-6); +%! assert (cellstr (b), bb); + +%!test +%! str = ''; +%! a = rand (10, 1); +%! b = char (randi ([65, 85], 10, 1)); +%! for k = 1:10 +%! str = sprintf ('%s %.6f %s\n', str, a(k), b(k)); +%! endfor +%! aa = strread (str, '%f %*s'); +%! assert (a, aa, 1e-6); + +%!test +%! str = sprintf ('/* this is\nacomment*/ 1 2 3'); +%! a = strread (str, '%f', 'commentstyle', 'c'); +%! assert (a, [1; 2; 3]); + +%!test +%! str = "# comment\n# comment\n1 2 3"; +%! [a, b] = strread (str, '%n %s', 'commentstyle', 'shell', 'endofline', "\n"); +%! assert (a, [1; 3]); +%! assert (b, {"2"}); + +%!test +%! str = sprintf ("Tom 100 miles/hr\nDick 90 miles/hr\nHarry 80 miles/hr"); +%! fmt = "%s %f miles/hr"; +%! c = cell (1, 2); +%! [c{:}] = strread (str, fmt); +%! assert (c{1}, {"Tom"; "Dick"; "Harry"}) +%! assert (c{2}, [100; 90; 80]) + +%!test +%! a = strread ("a b c, d e, , f", "%s", "delimiter", ","); +%! assert (a, {"a b c"; "d e"; ""; "f"}); + +%!test +%! # Bug #33536 +%! [a, b, c] = strread ("1,,2", "%s%s%s", "delimiter", ","); +%! assert (a{1}, '1'); +%! assert (b{1}, ''); +%! assert (c{1}, '2'); + +%!test +%! # Bug #33536 +%! a = strread ("[SomeText]", "[%s", "delimiter", "]"); +%! assert (a{1}, "SomeText"); + +%!test +%! dat = "Data file.\r\n= = = = =\r\nCOMPANY : \r\n"; +%! a = strread (dat, "%s", 'delimiter', "\n", 'whitespace', '', 'endofline', "\r\n"); +%! assert (a{2}, "= = = = ="); +%! assert (double (a{3}(end-5:end)), [32 110 97 109 101 62]); + +%!test +%! [a, b, c, d] = strread ("1,2,3,,5,6", "%d%f%d%f", 'delimiter', ','); +%! assert (c, int32 (3)); +%! assert (d, NaN); + +%!test +%! [a, b, c, d] = strread ("1,2,3,,5,6\n", "%d%d%f%d", 'delimiter', ','); +%! assert (c, [3; NaN]); +%! assert (d, int32 ([0; 0])); + +%!test +%! # Default format (= %f) +%1 [a, b, c] = strread ("0.12 0.234 0.3567"); +%1 assert (a, 0.12); +%1 assert (b, 0.234); +%1 assert (c, 0.3567); + +%!test +%! [a, b] = strread('0.41 8.24 3.57 6.24 9.27', "%f%f", 2, 'delimiter', ' '); +%1 assert (a, [0.41; 3.57]); + +%!test +%! # TreatAsEmpty +%! [a, b, c, d] = strread ("1,2,3,NN,5,6\n", "%d%d%d%f", 'delimiter', ',', 'TreatAsEmpty', 'NN'); +%! assert (c, int32 ([3; 0])); +%! assert (d, [NaN; NaN]); + +%!test +%! # No delimiters at all besides EOL. Plain reading numbers & strings +%! str = "Text1Text2Text\nText398Text4Text\nText57Text"; +%! [a, b] = strread (str, "Text%dText%1sText"); +%! assert (a, int32 ([1; 398; 57])); +%! assert (b(1:2), {'2'; '4'}); +%! assert (isempty (b{3}), true); + +%% MultipleDelimsAsOne +%!test +%! str = "11, 12, 13,, 15\n21,, 23, 24, 25\n,, 33, 34, 35"; +%! [a b c d] = strread (str, "%f %f %f %f", 'delimiter', ',', 'multipledelimsasone', 1, 'endofline', "\n"); +%! assert (a', [11, 21, NaN]); +%! assert (b', [12, 23, 33]); +%! assert (c', [13, 24, 34]); +%! assert (d', [15, 25, 35]); + +%% delimiter as sq_string and dq_string +%!test +%! assert (strread ("1\n2\n3", "%d", "delimiter", "\n"), +%! strread ("1\n2\n3", "%d", "delimiter", '\n')) + +%% whitespace as sq_string and dq_string +%!test +%! assert (strread ("1\b2\r3\b4\t5", "%d", "whitespace", "\b\r\n\t"), +%! strread ("1\b2\r3\b4\t5", "%d", "whitespace", '\b\r\n\t')) + +%!test +%! str = "0.31 0.86 0.94\n 0.60 0.72 0.87"; +%! fmt = "%f %f %f"; +%! args = {"delimiter", " ", "endofline", "\n", "whitespace", " "}; +%! [a, b, c] = strread (str, fmt, args {:}); +%! assert (a, [0.31; 0.60], 0.01) +%! assert (b, [0.86; 0.72], 0.01) +%! assert (c, [0.94; 0.87], 0.01) + +%!test +%! str = "0.31,0.86,0.94\n0.60,0.72,0.87"; +%! fmt = "%f %f %f"; +%! args = {"delimiter", ",", "endofline", "\n", "whitespace", " "}; +%! [a, b, c] = strread (str, fmt, args {:}); +%! assert (a, [0.31; 0.60], 0.01) +%! assert (b, [0.86; 0.72], 0.01) +%! assert (c, [0.94; 0.87], 0.01) + +%!test +%! str = "0.31 0.86 0.94\n 0.60 0.72 0.87"; +%! fmt = "%f %f %f"; +%! args = {"delimiter", ",", "endofline", "\n", "whitespace", " "}; +%! [a, b, c] = strread (str, fmt, args {:}); +%! assert (a, [0.31; 0.60], 0.01) +%! assert (b, [0.86; 0.72], 0.01) +%! assert (c, [0.94; 0.87], 0.01) + +%!test +%! str = "0.31, 0.86, 0.94\n 0.60, 0.72, 0.87"; +%! fmt = "%f %f %f"; +%! args = {"delimiter", ",", "endofline", "\n", "whitespace", " "}; +%! [a, b, c] = strread (str, fmt, args {:}); +%! assert (a, [0.31; 0.60], 0.01) +%! assert (b, [0.86; 0.72], 0.01) +%! assert (c, [0.94; 0.87], 0.01) diff --git a/octave_packages/m/io/textread.m b/octave_packages/m/io/textread.m new file mode 100644 index 0000000..7d1fd24 --- /dev/null +++ b/octave_packages/m/io/textread.m @@ -0,0 +1,148 @@ +## Copyright (C) 2009-2012 Eric Chassande-Mottin, CNRS (France) +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{n}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{prop1}, @var{value1}, @dots{}) +## @deftypefnx {Function File} {[@var{a}, @dots{}] =} textread (@var{filename}, @var{format}, @var{n}, @var{prop1}, @var{value1}, @dots{}) +## Read data from a text file. +## +## The file @var{filename} is read and parsed according to @var{format}. The +## function behaves like @code{strread} except it works by parsing a file +## instead of a string. See the documentation of @code{strread} for details. +## +## In addition to the options supported by @code{strread}, this function +## supports two more: +## +## @itemize +## @item "headerlines": +## The first @var{value} number of lines of @var{filename} are skipped. +## +## @item "endofline": +## Specify a single character or "\r\n". If no value is given, it will be +## inferred from the file. If set to "" (empty string) EOLs are ignored as +## delimiters. +## @end itemize +## +## The optional input @var{n} specifes the number of times to use +## @var{format} when parsing, i.e., the format repeat count. +## +## @seealso{strread, load, dlmread, fscanf, textscan} +## @end deftypefn + +function varargout = textread (filename, format = "%f", varargin) + + ## Check input + if (nargin < 1) + print_usage (); + endif + + if (! ischar (filename) || ! ischar (format)) + error ("textread: FILENAME and FORMAT arguments must be strings"); + endif + + ## Read file + fid = fopen (filename, "r"); + if (fid == -1) + error ("textread: could not open '%s' for reading", filename); + endif + + ## Skip header lines if requested + headerlines = find (strcmpi (varargin, "headerlines"), 1); + ## Beware of zero valued headerline, fskipl would skip to EOF + if (! isempty (headerlines) && (varargin{headerlines + 1} > 0)) + fskipl (fid, varargin{headerlines + 1}); + varargin(headerlines:headerlines+1) = []; + endif + + if (nargin > 2 && isnumeric (varargin{1})) + nlines = varargin{1}; + else + nlines = Inf; + endif + + if (isfinite (nlines) && (nlines >= 0)) + str = tmp_str = ""; + n = 0; + ## FIXME: Can this be done without slow loop? + while (ischar (tmp_str) && n++ <= nlines) + str = strcat (str, tmp_str); + tmp_str = fgets (fid); + endwhile + else + str = fread (fid, "char=>char").'; + endif + fclose (fid); + + if (isempty (str)) + warning ("textread: empty file"); + return; + endif + + endofline = find (strcmpi (varargin, "endofline"), 1); + if (! isempty (endofline)) + ## 'endofline' option set by user. + if (! ischar (varargin{endofline + 1})); + error ("textread: character value required for EndOfLine"); + endif + else + ## Determine EOL from file. Search for EOL candidates in first 3000 chars + eol_srch_len = min (length (str), 3000); + ## First try DOS (CRLF) + if (! isempty (findstr ("\r\n", str(1 : eol_srch_len)))) + eol_char = "\r\n"; + ## Perhaps old Macintosh? (CR) + elseif (! isempty (findstr ("\r", str(1 : eol_srch_len)))) + eol_char = "\r"; + ## Otherwise, use plain UNIX (LF) + else + eol_char = "\n"; + endif + ## Set up default endofline param value + varargin(end+1:end+2) = {'endofline', eol_char}; + endif + + ## Set up default whitespace param value if needed + if (isempty (find (strcmpi ('whitespace', varargin)))) + varargin(end+1:end+2) = {'whitespace', " \b\t"}; + endif + + ## Call strread to make it do the real work + [varargout{1:max (nargout, 1)}] = strread (str, format, varargin {:}); + +endfunction + + +%!test +%! f = tmpnam(); +%! d = rand (5, 3); +%! dlmwrite (f, d, 'precision', '%5.2f'); +%! [a, b, c] = textread (f, "%f %f %f", "delimiter", ",", "headerlines", 3); +%! unlink(f); +%! assert (a, d(4:5, 1), 1e-2); +%! assert (b, d(4:5, 2), 1e-2); +%! assert (c, d(4:5, 3), 1e-2); + +%% Test input validation +%!error textread () +%!error textread (1) +%!error textread (1, '%f') +%!error textread ("fname", 1) + diff --git a/octave_packages/m/io/textscan.m b/octave_packages/m/io/textscan.m new file mode 100644 index 0000000..8736db4 --- /dev/null +++ b/octave_packages/m/io/textscan.m @@ -0,0 +1,332 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{C} =} textscan (@var{fid}, @var{format}) +## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @var{n}) +## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @var{param}, @var{value}, @dots{}) +## @deftypefnx {Function File} {@var{C} =} textscan (@var{fid}, @var{format}, @var{n}, @var{param}, @var{value}, @dots{}) +## @deftypefnx {Function File} {@var{C} =} textscan (@var{str}, @dots{}) +## @deftypefnx {Function File} {[@var{C}, @var{position}] =} textscan (@var{fid}, @dots{}) +## Read data from a text file or string. +## +## The file associated with @var{fid} is read and parsed according to +## @var{format}. The function behaves like @code{strread} except it works by +## parsing a file instead of a string. See the documentation of +## @code{strread} for details. +## +## In addition to the options supported by +## @code{strread}, this function supports a few more: +## +## @itemize +## @item "collectoutput": +## A value of 1 or true instructs textscan to concatenate consecutive columns +## of the same class in the output cell array. A value of 0 or false (default) +## leaves output in distinct columns. +## +## @item "endofline": +## Specify "\r", "\n" or "\r\n" (for CR, LF, or CRLF). If no value is given, +## it will be inferred from the file. If set to "" (empty string) EOLs are +## ignored as delimiters and added to whitespace. +## +## @item "headerlines": +## The first @var{value} number of lines of @var{fid} are skipped. +## +## @item "returnonerror": +## If set to numerical 1 or true (default), return normally when read errors +## have been encountered. If set to 0 or false, return an error and no data. +## @end itemize +## +## The optional input @var{n} specifes the number of times to use +## @var{format} when parsing, i.e., the format repeat count. +## +## The output @var{C} is a cell array whose length is given by the number +## of format specifiers. +## +## The second output, @var{position}, provides the position, in characters, +## from the beginning of the file. +## +## @seealso{dlmread, fscanf, load, strread, textread} +## @end deftypefn + +function [C, position] = textscan (fid, format = "%f", varargin) + + ## Check input + if (nargin < 1) + print_usage (); + endif + + if (isempty (format)) + format = "%f"; + endif + + if (! (isa (fid, "double") && fid > 0) && ! ischar (fid)) + error ("textscan: first argument must be a file id or character string"); + endif + + if (! ischar (format)) + error ("textscan: FORMAT must be a string"); + endif + + args = varargin; + if (nargin > 2 && isnumeric (args{1})) + nlines = args{1}; + else + nlines = Inf; + endif + + if (! any (strcmpi (args, "emptyvalue"))) + ## Matlab returns NaNs for missing values + args(end+1:end+2) = {'emptyvalue', NaN}; + endif + + ## Check default parameter values that differ for strread & textread + + ipos = find (strcmpi (args, "whitespace")); + if (isempty (ipos)) + ## Matlab default whitespace = " \b\t" + args(end+1:end+2) = {'whitespace', " \b\t"}; + whitespace = " \b\t"; + else + ## Check if there's at least one string format specifier + fmt = strrep (format, "%", " %"); + fmt = regexp (fmt, '[^ ]+', 'match'); + fmt = strtrim (fmt(strmatch ("%", fmt))) + has_str_fmt = all (cellfun ("isempty", strfind (strtrim (fmt(strmatch ("%", fmt))), 's'))); + ## If there is a format, AND whitespace value = empty, + ## don't add a space (char(32)) to whitespace + if (! (isempty (args{ipos+1}) && has_str_fmt)) + args{ipos+1} = unique ([" ", whitespace]); + endif + endif + + if (! any (strcmpi (args, "delimiter"))) + ## Matlab says default delimiter = whitespace. + ## strread() will pick this up further + args(end+1:end+2) = {'delimiter', ""}; + endif + + collop = false; + ipos = find (strcmpi (args, "collectoutput")); + if (! isempty (ipos)) + ## Search & concatenate consecutive columns of same class requested + if (isscalar (args{ipos+1}) + && (islogical (args{ipos+1}) || isnumeric (args{ipos+1}))) + collop = args{ipos+1}; + else + warning ("textscan: illegal value for CollectOutput parameter - ignored"); + endif + ## Remove argument before call to strread() below + args(ipos:ipos+1) = []; + endif + + if (any (strcmpi (args, "returnonerror"))) + ## Because of the way strread() reads data (columnwise) this parameter + ## can't be neatly implemented. strread() will pick it up anyway + warning ('textscan: ReturnOnError is not fully implemented'); + else + ## Set default value (=true) + args(end+1:end+2) = {"returnonerror", 1}; + endif + + if (ischar (fid)) + ## Read from a text string + if (nargout == 2) + error ("textscan: cannot provide position information for character input"); + endif + str = fid; + else + ## Skip header lines if requested + headerlines = find (strcmpi (args, "headerlines"), 1); + ## Beware of zero valued headerline, fskipl would skip to EOF + if (! isempty (headerlines) && (args{headerlines + 1} > 0)) + fskipl (fid, varargin{headerlines + 1}); + args(headerlines:headerlines+1) = []; + endif + if (isfinite (nlines) && (nlines >= 0)) + str = tmp_str = ""; + n = 0; + ## FIXME: Can this be done without slow loop? + while (ischar (tmp_str) && n++ < nlines) + tmp_str = fgets (fid); + if (ischar (tmp_str)) + str = strcat (str, tmp_str); + endif + endwhile + else + str = fread (fid, "char=>char").'; + endif + endif + + ## Check for empty result + if (isempty (str)) + warning ("textscan: no data read"); + C = []; + return; + endif + + ## Check value of 'endofline'. String or file doesn't seem to matter + endofline = find (strcmpi (args, "endofline"), 1); + if (! isempty (endofline)) + if (ischar (args{endofline + 1})) + eol_char = args{endofline + 1}; + if (isempty (strmatch (eol_char, {"", "\n", "\r", "\r\n"}, 'exact'))) + error ("textscan: illegal EndOfLine character value specified"); + endif + else + error ("textscan: character value required for EndOfLine"); + endif + else + ## Determine EOL from file. Search for EOL candidates in first 3000 chars + eol_srch_len = min (length (str), 3000); + ## First try DOS (CRLF) + if (! isempty (findstr ("\r\n", str(1 : eol_srch_len)))) + eol_char = "\r\n"; + ## Perhaps old Macintosh? (CR) + elseif (! isempty (findstr ("\r", str(1 : eol_srch_len)))) + eol_char = "\r"; + ## Otherwise, use plain UNIX (LF) + else + eol_char = "\n"; + endif + ## Set up the default endofline param value + args(end+1:end+2) = {'endofline', eol_char}; + endif + + ## Determine the number of data fields + num_fields = numel (strfind (format, "%")) - numel (strfind (format, "%*")); + + ## Strip trailing EOL to avoid returning stray missing values (f. strread) + if (strcmp (str(end-length (eol_char) + 1 : end), eol_char)); + str(end-length (eol_char) + 1 : end) = ""; + endif + + ## Call strread to make it do the real work + C = cell (1, num_fields); + [C{:}] = strread (str, format, args{:}); + + ## If requested, collect output columns of same class + if (collop) + C = colloutp (C); + endif + + if (nargout == 2) + position = ftell (fid); + endif + +endfunction + + +## Collect consecutive columns of same class into one cell column +function C = colloutp (C) + + ## Start at rightmost column and work backwards to avoid ptr mixup + ii = numel (C); + while ii > 1 + clss1 = class (C{ii}); + jj = ii; + while (jj > 1 && strcmp (clss1, class (C{jj - 1}))) + ## Column to the left is still same class; check next column to the left + --jj; + endwhile + if (jj < ii) + ## Concatenate columns into current column + C{jj} = [C{jj : ii}]; + ## Wipe concatenated columns to the right, resume search to the left + C(jj+1 : ii) = []; + ii = jj - 1; + else + ## No similar class in column to the left, search from there + --ii; + endif + endwhile + +endfunction + +%!test +%! str = "1, 2, 3, 4\n 5, , , 8\n 9, 10, 11, 12"; +%! fmtstr = "%f %d %f %s"; +%! c = textscan (str, fmtstr, 2, "delimiter", ",", "emptyvalue", -Inf); +%! assert (isequal (c{1}, [1;5])); +%! assert (length (c{1}), 2); +%! assert (iscellstr (c{4})); +%! assert (isequal (c{3}, [3; -Inf])); + +%!test +%! b = [10:10:100]; +%! b = [b; 8*b/5]; +%! str = sprintf ("%g miles/hr = %g kilometers/hr\n", b); +%! fmt = "%f miles/hr = %f kilometers/hr"; +%! c = textscan (str, fmt); +%! assert (b(1,:)', c{1}, 1e-5); +%! assert (b(2,:)', c{2}, 1e-5); + +#%!test +#%! str = "13, 72, NA, str1, 25\r\n// Middle line\r\n36, na, 05, str3, 6"; +#%! a = textscan(str, '%d %n %f %s %n', 'delimiter', ',','treatAsEmpty', {'NA', 'na'},'commentStyle', '//'); +#%! assert (a{1}, int32([13; 36])); +#%! assert (a{2}, [72; NaN]); +#%! assert (a{3}, [NaN; 5]); +#%! assert (a{4}, {"str1"; "str3"}); +#%! assert (a{5}, [25; 6]); + +%!test +%! str = "Km:10 = hhhBjjj miles16hour\r\n"; +%! str = [str "Km:15 = hhhJjjj miles241hour\r\n"]; +%! str = [str "Km:2 = hhhRjjj miles3hour\r\n"]; +%! str = [str "Km:25 = hhhZ\r\n"]; +%! fmt = "Km:%d = hhh%1sjjj miles%dhour"; +%! a = textscan (str, fmt, 'delimiter', ' '); +%! assert (a{1}', int32([10 15 2 25])); +%! assert (a{2}', {'B' 'J' 'R' 'Z'}); +%! assert (a{3}', int32([16 241 3 0])); + +%% Test with default endofline parameter +%!test +%! c = textscan ("L1\nL2", "%s"); +%! assert (c{:}, {"L1"; "L2"}); + +%% Test with endofline parameter set to '' (empty) - newline should be in word +%!test +%! c = textscan ("L1\nL2", "%s", 'endofline', ''); +%! assert (int8(c{:}{:}), int8([ 76, 49, 10, 76, 50 ])); + +%!test +%! # No delimiters at all besides EOL. Skip fields, even empty fields +%! str = "Text1Text2Text\nTextText4Text\nText57Text"; +%! c = textscan (str, "Text%*dText%dText"); +%! assert (c{1}, int32 ([2; 4; 0])); + +%!test +%% CollectOutput test +%! b = [10:10:100]; +%! b = [b; 8*b/5; 8*b*1000/5]; +%! str = sprintf ("%g miles/hr = %g (%g) kilometers (meters)/hr\n", b); +%! fmt = "%f miles%s %s %f (%f) kilometers %*s"; +%! c = textscan (str, fmt, 'collectoutput', 1); +%! assert (size(c{3}), [10, 2]); +%! assert (size(c{2}), [10, 2]); + +%% Test input validation +%!error textscan () +%!error textscan (single (4)) +%!error textscan ({4}) +%!error textscan ("Hello World", 2) +%!error [C, pos] = textscan ("Hello World") +%!error textscan ("Hello World", '%s', 'EndOfLine', 3) + diff --git a/octave_packages/m/linear-algebra/commutation_matrix.m b/octave_packages/m/linear-algebra/commutation_matrix.m new file mode 100644 index 0000000..58e04d5 --- /dev/null +++ b/octave_packages/m/linear-algebra/commutation_matrix.m @@ -0,0 +1,119 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} commutation_matrix (@var{m}, @var{n}) +## Return the commutation matrix +## @tex +## $K_{m,n}$ +## @end tex +## @ifnottex +## K(m,n) +## @end ifnottex +## which is the unique +## @tex +## $m n \times m n$ +## @end tex +## @ifnottex +## @var{m}*@var{n} by @var{m}*@var{n} +## @end ifnottex +## matrix such that +## @tex +## $K_{m,n} \cdot {\rm vec} (A) = {\rm vec} (A^T)$ +## @end tex +## @ifnottex +## @math{K(m,n) * vec(A) = vec(A')} +## @end ifnottex +## for all +## @tex +## $m\times n$ +## @end tex +## @ifnottex +## @math{m} by @math{n} +## @end ifnottex +## matrices +## @tex +## $A$. +## @end tex +## @ifnottex +## @math{A}. +## @end ifnottex +## +## If only one argument @var{m} is given, +## @tex +## $K_{m,m}$ +## @end tex +## @ifnottex +## @math{K(m,m)} +## @end ifnottex +## is returned. +## +## See Magnus and Neudecker (1988), @cite{Matrix Differential Calculus with +## Applications in Statistics and Econometrics.} +## @end deftypefn + +## Author: KH +## Created: 8 May 1995 +## Adapted-By: jwe + +function k = commutation_matrix (m, n) + + if (nargin < 1 || nargin > 2) + print_usage (); + else + if (! (isscalar (m) && m == fix (m) && m > 0)) + error ("commutation_matrix: M must be a positive integer"); + endif + if (nargin == 1) + n = m; + elseif (! (isscalar (n) && n == fix (n) && n > 0)) + error ("commutation_matrix: N must be a positive integer"); + endif + endif + + ## It is clearly possible to make this a LOT faster! + k = zeros (m * n, m * n); + for i = 1 : m + for j = 1 : n + k ((i - 1) * n + j, (j - 1) * m + i) = 1; + endfor + endfor + +endfunction + +%!test +%! c = commutation_matrix(1,1); +%! assert(c,1); + +%!test +%! A = rand(3,5); +%! vc = vec(A); +%! vr = vec(A'); +%! c = commutation_matrix(3,5); +%! assert(c*vc,vr); + +%!test +%! A = rand(4,6); +%! vc = vec(A); +%! vr = vec(A'); +%! c = commutation_matrix(4,6); +%! assert(c*vc,vr); + +%!error commutation_matrix(0,0); +%!error commutation_matrix(1,0); +%!error commutation_matrix(0,1); diff --git a/octave_packages/m/linear-algebra/cond.m b/octave_packages/m/linear-algebra/cond.m new file mode 100644 index 0000000..eaa2266 --- /dev/null +++ b/octave_packages/m/linear-algebra/cond.m @@ -0,0 +1,93 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cond (@var{A}) +## @deftypefnx {Function File} {} cond (@var{A}, @var{p}) +## Compute the @var{p}-norm condition number of a matrix. +## +## @code{cond (@var{A})} is ## defined as +## @tex +## $ {\parallel A \parallel_p * \parallel A^{-1} \parallel_p .} $ +## @end tex +## @ifnottex +## @code{norm (@var{A}, @var{p}) * norm (inv (@var{A}), @var{p})}. +## @end ifnottex +## +## By default @code{@var{p} = 2} is used which implies a (relatively slow) +## singular value decomposition. Other possible selections are +## @code{@var{p} = 1, Inf, "fro"} which are generally faster. See +## @code{norm} for a full discussion of possible @var{p} values. +## @seealso{condest, rcond, norm, svd} +## @end deftypefn + +## Author: jwe + +function retval = cond (A, p) + + if (nargin && nargin < 3) + if (ndims (A) > 2) + error ("cond: only valid on 2-D objects"); + endif + + if (nargin <2) + p = 2; + endif + + if (! ischar (p) && p == 2) + [nr, nc] = size (A); + if (nr == 0 || nc == 0) + retval = 0.0; + elseif (any (any (isinf (A) | isnan (A)))) + error ("cond: argument must not contain Inf or NaN values"); + else + sigma = svd (A); + sigma_1 = sigma(1); + sigma_n = sigma(end); + if (sigma_1 == 0 || sigma_n == 0) + retval = Inf; + else + retval = sigma_1 / sigma_n; + endif + endif + else + retval = norm (A, p) * norm (inv (A), p); + endif + else + print_usage (); + endif + +endfunction + +%!test +%! y= [7, 2, 3; 1, 3, 4; 6, 4, 5]; +%! tol = 1e-6; +%! type = {1, 2, 'fro', 'inf', inf}; +%! for n = 1:numel(type) +%! rcondition(n) = 1 / cond (y, type{n}); +%! endfor +%! assert (rcondition, [0.017460, 0.019597, 0.018714, 0.012022, 0.012022], tol); + +%!assert (abs (cond ([1, 2; 2, 1]) - 3) < sqrt (eps)); + +%!assert (cond ([1, 2, 3; 4, 5, 6; 7, 8, 9]) > 1.0e+16); + +%!error cond (); + +%!error cond (1, 2, 3); + diff --git a/octave_packages/m/linear-algebra/condest.m b/octave_packages/m/linear-algebra/condest.m new file mode 100644 index 0000000..2f3ea10 --- /dev/null +++ b/octave_packages/m/linear-algebra/condest.m @@ -0,0 +1,238 @@ +## Copyright (C) 2007-2012 Regents of the University of California +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} condest (@var{A}) +## @deftypefnx {Function File} {} condest (@var{A}, @var{t}) +## @deftypefnx {Function File} {[@var{est}, @var{v}] =} condest (@dots{}) +## @deftypefnx {Function File} {[@var{est}, @var{v}] =} condest (@var{A}, @var{solve}, @var{solve_t}, @var{t}) +## @deftypefnx {Function File} {[@var{est}, @var{v}] =} condest (@var{apply}, @var{apply_t}, @var{solve}, @var{solve_t}, @var{n}, @var{t}) +## +## Estimate the 1-norm condition number of a matrix @var{A} +## using @var{t} test vectors using a randomized 1-norm estimator. +## If @var{t} exceeds 5, then only 5 test vectors are used. +## +## If the matrix is not explicit, e.g., when estimating the condition +## number of @var{A} given an LU@tie{}factorization, @code{condest} uses the +## following functions: +## +## @table @var +## @item apply +## @code{A*x} for a matrix @code{x} of size @var{n} by @var{t}. +## +## @item apply_t +## @code{A'*x} for a matrix @code{x} of size @var{n} by @var{t}. +## +## @item solve +## @code{A \ b} for a matrix @code{b} of size @var{n} by @var{t}. +## +## @item solve_t +## @code{A' \ b} for a matrix @code{b} of size @var{n} by @var{t}. +## @end table +## +## The implicit version requires an explicit dimension @var{n}. +## +## @code{condest} uses a randomized algorithm to approximate +## the 1-norms. +## +## @code{condest} returns the 1-norm condition estimate @var{est} and +## a vector @var{v} satisfying @code{norm (A*v, 1) == norm (A, 1) * norm +## (@var{v}, 1) / @var{est}}. When @var{est} is large, @var{v} is an +## approximate null vector. +## +## References: +## @itemize +## @item +## N.J. Higham and F. Tisseur, @cite{A Block Algorithm +## for Matrix 1-Norm Estimation, with an Application to 1-Norm +## Pseudospectra}. SIMAX vol 21, no 4, pp 1185-1201. +## @url{http://dx.doi.org/10.1137/S0895479899356080} +## +## @item +## N.J. Higham and F. Tisseur, @cite{A Block Algorithm +## for Matrix 1-Norm Estimation, with an Application to 1-Norm +## Pseudospectra}. @url{http://citeseer.ist.psu.edu/223007.html} +## @end itemize +## +## @seealso{cond, norm, onenormest} +## @end deftypefn + +## Code originally licensed under +## +## Copyright (c) 2007, Regents of the University of California +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions +## are met: +## +## * Redistributions of source code must retain the above copyright +## notice, this list of conditions and the following disclaimer. +## +## * Redistributions in binary form must reproduce the above +## copyright notice, this list of conditions and the following +## disclaimer in the documentation and/or other materials provided +## with the distribution. +## +## * Neither the name of the University of California, Berkeley 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 REGENTS 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 REGENTS AND +## 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. + +## Author: Jason Riedy +## Keywords: linear-algebra norm estimation +## Version: 0.2 + +function [est, v] = condest (varargin) + + if (nargin < 1 || nargin > 6) + print_usage (); + endif + + default_t = 5; + + have_A = false; + have_t = false; + have_solve = false; + + if (ismatrix (varargin{1})) + A = varargin{1}; + if (! issquare (A)) + error ("condest: matrix must be square"); + endif + n = rows (A); + have_A = true; + + if (nargin > 1) + if (isscalar (varargin{2})) + t = varargin{2}; + have_t = true; + elseif (nargin > 2) + solve = varargin{2}; + solve_t = varargin{3}; + have_solve = true; + if (nargin > 3) + t = varargin{4}; + have_t = true; + endif + else + error ("condest: must supply both SOLVE and SOLVE_T"); + endif + endif + elseif (nargin > 4) + apply = varargin{1}; + apply_t = varargin{2}; + solve = varargin{3}; + solve_t = varargin{4}; + have_solve = true; + n = varargin{5}; + if (! isscalar (n)) + error ("condest: dimension argument of implicit form must be scalar"); + endif + if (nargin > 5) + t = varargin{6}; + have_t = true; + endif + else + error ("condest: implicit form of condest requires at least 5 arguments"); + endif + + if (! have_t) + t = min (n, default_t); + endif + + if (! have_solve) + if (issparse (A)) + [L, U, P, Pc] = lu (A); + solve = @(x) Pc' * (U \ (L \ (P * x))); + solve_t = @(x) P' * (L' \ (U' \ (Pc * x))); + else + [L, U, P] = lu (A); + solve = @(x) U \ (L \ (P*x)); + solve_t = @(x) P' * (L' \ (U' \ x)); + endif + endif + + if (have_A) + Anorm = norm (A, 1); + else + Anorm = onenormest (apply, apply_t, n, t); + endif + + [Ainv_norm, v, w] = onenormest (solve, solve_t, n, t); + + est = Anorm * Ainv_norm; + v = w / norm (w, 1); + +endfunction + +%!demo +%! N = 100; +%! A = randn (N) + eye (N); +%! condest (A) +%! [L,U,P] = lu (A); +%! condest (A, @(x) U\ (L\ (P*x)), @(x) P'*(L'\ (U'\x))) +%! condest (@(x) A*x, @(x) A'*x, @(x) U\ (L\ (P*x)), @(x) P'*(L'\ (U'\x)), N) +%! norm (inv (A), 1) * norm (A, 1) + +## Yes, these test bounds are really loose. There's +## enough randomization to trigger odd cases with hilb(). + +%!test +%! N = 6; +%! A = hilb (N); +%! cA = condest (A); +%! cA_test = norm (inv (A), 1) * norm (A, 1); +%! assert (cA, cA_test, -2^-8); + +%!test +%! N = 6; +%! A = hilb (N); +%! solve = @(x) A\x; solve_t = @(x) A'\x; +%! cA = condest (A, solve, solve_t); +%! cA_test = norm (inv (A), 1) * norm (A, 1); +%! assert (cA, cA_test, -2^-8); + +%!test +%! N = 6; +%! A = hilb (N); +%! apply = @(x) A*x; apply_t = @(x) A'*x; +%! solve = @(x) A\x; solve_t = @(x) A'\x; +%! cA = condest (apply, apply_t, solve, solve_t, N); +%! cA_test = norm (inv (A), 1) * norm (A, 1); +%! assert (cA, cA_test, -2^-6); + +%!test +%! N = 12; +%! A = hilb (N); +%! [rcondA, v] = condest (A); +%! x = A*v; +%! assert (norm(x, inf), 0, eps); diff --git a/octave_packages/m/linear-algebra/cross.m b/octave_packages/m/linear-algebra/cross.m new file mode 100644 index 0000000..3dfc09f --- /dev/null +++ b/octave_packages/m/linear-algebra/cross.m @@ -0,0 +1,115 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cross (@var{x}, @var{y}) +## @deftypefnx {Function File} {} cross (@var{x}, @var{y}, @var{dim}) +## Compute the vector cross product of two 3-dimensional vectors +## @var{x} and @var{y}. +## +## @example +## @group +## cross ([1,1,0], [0,1,1]) +## @result{} [ 1; -1; 1 ] +## @end group +## @end example +## +## If @var{x} and @var{y} are matrices, the cross product is applied +## along the first dimension with 3 elements. The optional argument +## @var{dim} forces the cross product to be calculated along +## the specified dimension. +## @seealso{dot, curl, divergence} +## @end deftypefn + +## Author: Kurt Hornik +## Created: 15 October 1994 +## Adapted-By: jwe + +function z = cross (x, y, dim) + + if (nargin != 2 && nargin != 3) + print_usage (); + endif + + if (ndims (x) < 3 && ndims (y) < 3 && nargin < 3) + ## COMPATIBILITY -- opposite behaviour for cross(row,col) + ## Swap x and y in the assignments below to get the matlab behaviour. + ## Better yet, fix the calling code so that it uses conformant vectors. + if (columns (x) == 1 && rows (y) == 1) + warning ("cross: taking cross product of column by row"); + y = y.'; + elseif (rows (x) == 1 && columns (y) == 1) + warning ("cross: taking cross product of row by column"); + x = x.'; + endif + endif + + if (nargin == 2) + dim = find (size (x) == 3, 1); + if (isempty (dim)) + error ("cross: must have at least one dimension with 3 elements"); + endif + else + if (size (x, dim) != 3) + error ("cross: dimension DIM must have 3 elements"); + endif + endif + + nd = ndims (x); + sz = size (x); + idx2 = idx3 = idx1 = {':'}(ones (1, nd)); + idx1(dim) = 1; + idx2(dim) = 2; + idx3(dim) = 3; + + if (size_equal (x, y)) + x1 = x(idx1{:}); + x2 = x(idx2{:}); + x3 = x(idx3{:}); + y1 = y(idx1{:}); + y2 = y(idx2{:}); + y3 = y(idx3{:}); + z = cat (dim, (x2.*y3 - x3.*y2), (x3.*y1 - x1.*y3), (x1.*y2 - x2.*y1)); + else + error ("cross: X and Y must have the same dimensions"); + endif + +endfunction + +%!test +%! x = [1 0 0]; +%! y = [0 1 0]; +%! r = [0 0 1]; +%! assert(cross(x, y), r, 2e-8); + +%!test +%! x = [1 2 3]; +%! y = [4 5 6]; +%! r = [(2*6-3*5) (3*4-1*6) (1*5-2*4)]; +%! assert(cross(x, y), r, 2e-8); + +%!test +%! x = [1 0 0; 0 1 0; 0 0 1]; +%! y = [0 1 0; 0 0 1; 1 0 0]; +%! r = [0 0 1; 1 0 0; 0 1 0]; +%! assert(cross(x, y, 2), r, 2e-8); +%! assert(cross(x, y, 1), -r, 2e-8); + +%!error cross(0,0); +%!error cross(); + diff --git a/octave_packages/m/linear-algebra/duplication_matrix.m b/octave_packages/m/linear-algebra/duplication_matrix.m new file mode 100644 index 0000000..20d373d --- /dev/null +++ b/octave_packages/m/linear-algebra/duplication_matrix.m @@ -0,0 +1,120 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} duplication_matrix (@var{n}) +## Return the duplication matrix +## @tex +## $D_n$ +## @end tex +## @ifnottex +## @math{Dn} +## @end ifnottex +## which is the unique +## @tex +## $n^2 \times n(n+1)/2$ +## @end tex +## @ifnottex +## @math{n^2} by @math{n*(n+1)/2} +## @end ifnottex +## matrix such that +## @tex +## $D_n * {\rm vech} (A) = {\rm vec} (A)$ +## @end tex +## @ifnottex +## @math{Dn vech (A) = vec (A)} +## @end ifnottex +## for all symmetric +## @tex +## $n \times n$ +## @end tex +## @ifnottex +## @math{n} by @math{n} +## @end ifnottex +## matrices +## @tex +## $A$. +## @end tex +## @ifnottex +## @math{A}. +## @end ifnottex +## +## See Magnus and Neudecker (1988), Matrix differential calculus with +## applications in statistics and econometrics. +## @end deftypefn + +## Author: KH +## Created: 8 May 1995 +## Adapged-By: jwe + +function d = duplication_matrix (n) + + if (nargin != 1) + print_usage (); + endif + + if (! (isscalar (n) && n > 0 && n == fix (n))) + error ("duplication_matrix: N must be a positive integer"); + endif + + d = zeros (n * n, n * (n + 1) / 2); + + ## It is clearly possible to make this a LOT faster! + count = 0; + for j = 1 : n + d ((j - 1) * n + j, count + j) = 1; + for i = (j + 1) : n + d ((j - 1) * n + i, count + i) = 1; + d ((i - 1) * n + j, count + i) = 1; + endfor + count = count + n - j; + endfor + +endfunction + +%!test +%! N = 2; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!test +%! N = 3; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!test +%! N = 4; +%! A = rand(N); +%! B = A * A'; +%! C = A + A'; +%! D = duplication_matrix (N); +%! assert (D * vech (B), vec (B), 1e-6); +%! assert (D * vech (C), vec (C), 1e-6); + +%!error duplication_matrix (); +%!error duplication_matrix (0.5); +%!error duplication_matrix (-1); +%!error duplication_matrix (ones(1,4)); diff --git a/octave_packages/m/linear-algebra/expm.m b/octave_packages/m/linear-algebra/expm.m new file mode 100644 index 0000000..eb5454f --- /dev/null +++ b/octave_packages/m/linear-algebra/expm.m @@ -0,0 +1,154 @@ +## Copyright (C) 2008-2012 Jaroslav Hajek, Marco Caliari +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} expm (@var{A}) +## Return the exponential of a matrix, defined as the infinite Taylor +## series +## @tex +## $$ +## \exp (A) = I + A + {A^2 \over 2!} + {A^3 \over 3!} + \cdots +## $$ +## @end tex +## @ifnottex +## +## @example +## expm (A) = I + A + A^2/2! + A^3/3! + @dots{} +## @end example +## +## @end ifnottex +## The Taylor series is @emph{not} the way to compute the matrix +## exponential; see Moler and Van Loan, @cite{Nineteen Dubious Ways to +## Compute the Exponential of a Matrix}, SIAM Review, 1978. This routine +## uses Ward's diagonal Pad@'e approximation method with three step +## preconditioning (SIAM Journal on Numerical Analysis, 1977). Diagonal +## Pad@'e approximations are rational polynomials of matrices +## @tex +## $D_q(A)^{-1}N_q(A)$ +## @end tex +## @ifnottex +## +## @example +## @group +## -1 +## D (A) N (A) +## @end group +## @end example +## +## @end ifnottex +## whose Taylor series matches the first +## @tex +## $2 q + 1 $ +## @end tex +## @ifnottex +## @code{2q+1} +## @end ifnottex +## terms of the Taylor series above; direct evaluation of the Taylor series +## (with the same preconditioning steps) may be desirable in lieu of the +## Pad@'e approximation when +## @tex +## $D_q(A)$ +## @end tex +## @ifnottex +## @code{Dq(A)} +## @end ifnottex +## is ill-conditioned. +## @seealso{logm, sqrtm} +## @end deftypefn + +function r = expm (A) + + if (nargin != 1) + print_usage (); + endif + + if (! ismatrix (A) || ! issquare (A)) + error ("expm: A must be a square matrix"); + endif + + if (isscalar (A)) + r = exp (A); + return + elseif (strfind (typeinfo (A), "diagonal matrix")) + r = diag (exp (diag (A))); + return + endif + + n = rows (A); + ## Trace reduction. + A(A == -Inf) = -realmax; + trshift = trace (A) / length (A); + if (trshift > 0) + A -= trshift*eye (n); + endif + ## Balancing. + [d, p, aa] = balance (A); + ## FIXME: can we both permute and scale at once? Or should we rather do + ## this: + ## + ## [d, xx, aa] = balance (A, "noperm"); + ## [xx, p, aa] = balance (aa, "noscal"); + [f, e] = log2 (norm (aa, "inf")); + s = max (0, e); + s = min (s, 1023); + aa *= 2^(-s); + + ## Pade approximation for exp(A). + c = [5.0000000000000000e-1,... + 1.1666666666666667e-1,... + 1.6666666666666667e-2,... + 1.6025641025641026e-3,... + 1.0683760683760684e-4,... + 4.8562548562548563e-6,... + 1.3875013875013875e-7,... + 1.9270852604185938e-9]; + + a2 = aa^2; + id = eye (n); + x = (((c(8) * a2 + c(6) * id) * a2 + c(4) * id) * a2 + c(2) * id) * a2 + id; + y = (((c(7) * a2 + c(5) * id) * a2 + c(3) * id) * a2 + c(1) * id) * aa; + + r = (x - y) \ (x + y); + + ## Undo scaling by repeated squaring. + for k = 1:s + r ^= 2; + endfor + + ## inverse balancing. + d = diag (d); + r = d * r / d; + r(p, p) = r; + ## Inverse trace reduction. + if (trshift >0) + r *= exp (trshift); + endif + +endfunction + +%!assert(norm(expm([1 -1;0 1]) - [e -e; 0 e]) < 1e-5); +%!assert(expm([1 -1 -1;0 1 -1; 0 0 1]), [e -e -e/2; 0 e -e; 0 0 e], 1e-5); + +%% Test input validation +%!error expm (); +%!error expm (1, 2); +%!error expm([1 0;0 1; 2 2]); + +%!assert (expm (10), expm (10)) +%!assert (full (expm (eye (3))), expm (full (eye (3)))) +%!assert (full (expm (10*eye (3))), expm (full (10*eye (3))), 8*eps) diff --git a/octave_packages/m/linear-algebra/housh.m b/octave_packages/m/linear-algebra/housh.m new file mode 100644 index 0000000..54246c7 --- /dev/null +++ b/octave_packages/m/linear-algebra/housh.m @@ -0,0 +1,133 @@ +## Copyright (C) 1995-2012 A. Scottedward Hodel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{housv}, @var{beta}, @var{zer}] =} housh (@var{x}, @var{j}, @var{z}) +## Compute Householder reflection vector @var{housv} to reflect @var{x} +## to be the j-th column of identity, i.e., +## +## @example +## @group +## (I - beta*housv*housv')x = norm(x)*e(j) if x(j) < 0, +## (I - beta*housv*housv')x = -norm(x)*e(j) if x(j) >= 0 +## @end group +## @end example +## +## @noindent +## Inputs +## +## @table @var +## @item x +## vector +## +## @item j +## index into vector +## +## @item z +## threshold for zero (usually should be the number 0) +## @end table +## +## @noindent +## Outputs (see Golub and Van Loan): +## +## @table @var +## @item beta +## If beta = 0, then no reflection need be applied (zer set to 0) +## +## @item housv +## householder vector +## @end table +## @end deftypefn + +## Author: A. S. Hodel +## Created: August 1995 + +function [housv, beta, zer] = housh (x, j, z) + + if (nargin != 3) + print_usage (); + endif + + ## Check for valid inputs. + if (! isvector (x) && ! isscalar (x)) + error ("housh: first input must be a vector"); + elseif (! isscalar(j)) + error ("housh: second argment must be an integer scalar"); + else + housv = x; + m = max (abs (housv)); + if (m != 0.0) + housv = housv / m; + alpha = norm (housv); + if (alpha > z) + beta = 1.0 / (alpha * (alpha + abs (housv(j)))); + sg = sign (housv(j)); + if (sg == 0) + sg = 1; + endif + housv(j) = housv(j) + alpha*sg; + else + beta = 0.0; + endif + else + beta = 0.0; + endif + zer = (beta == 0); + endif + +endfunction + +%!test +%! x = [1 2 3]'; +%! j = 3; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(3) - b*hv*hv') * x; +%! d = - norm(x) * [0 0 1]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!test +%! x = [7 -3 1]'; +%! j = 2; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(3) - b*hv*hv') * x; +%! d = norm(x) * [0 1 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!test +%! x = [1 0 0]'; +%! j = 1; +%! [hv, b, z] = housh(x, j, 10); +%! r = (eye(3) - b*hv*hv') * x; +%! d = norm(x) * [1 0 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 1, 2e-8); + +%!test +%! x = [5 0 4 1]'; +%! j = 2; +%! [hv, b, z] = housh(x, j, 0); +%! r = (eye(4) - b*hv*hv') * x; +%! d = - norm(x) * [0 1 0 0]'; +%! assert(r, d, 2e-8); +%! assert(z, 0, 2e-8); + +%!error housh([0]); +%!error housh(); + diff --git a/octave_packages/m/linear-algebra/isdefinite.m b/octave_packages/m/linear-algebra/isdefinite.m new file mode 100644 index 0000000..55c01b9 --- /dev/null +++ b/octave_packages/m/linear-algebra/isdefinite.m @@ -0,0 +1,87 @@ +## Copyright (C) 2003-2012 Gabriele Pannocchia +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isdefinite (@var{x}) +## @deftypefnx {Function File} {} isdefinite (@var{x}, @var{tol}) +## Return 1 if @var{x} is symmetric positive definite within the +## tolerance specified by @var{tol} or 0 if @var{x} is symmetric +## positive semidefinite. Otherwise, return -1. If @var{tol} +## is omitted, use a tolerance of +## @code{100 * eps * norm (@var{x}, "fro")} +## @seealso{issymmetric, ishermitian} +## @end deftypefn + +## Author: Gabriele Pannocchia +## Created: November 2003 +## Adapted-By: jwe + +function retval = isdefinite (x, tol) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (! isfloat (x)) + x = double (x); + endif + + if (nargin == 1) + tol = 100 * eps (class (x)) * norm (x, "fro"); + endif + + if (! ishermitian (x, tol)) + error ("isdefinite: X must be a Hermitian matrix"); + endif + + e = tol * eye (rows (x)); + [r, p] = chol (x - e); + if (p == 0) + retval = 1; + else + [r, p] = chol (x + e); + if (p == 0) + retval = 0; + else + retval = -1; + endif + endif + +endfunction + + +%!test +%! A = [-1 0; 0 -1]; +%! assert (isdefinite (A), -1) + +%!test +%! A = [1 0; 0 1]; +%! assert (isdefinite (A), 1) + +%!test +%! A = [2 -1 0; -1 2 -1; 0 -1 2]; +%! assert (isdefinite (A), 1) + +%!test +%! A = [1 0; 0 0]; +%! assert (isdefinite (A), 0) + +%!error isdefinite () +%!error isdefinite (1,2,3) +%!error isdefinite ([1 2; 3 4]) + diff --git a/octave_packages/m/linear-algebra/ishermitian.m b/octave_packages/m/linear-algebra/ishermitian.m new file mode 100644 index 0000000..a5702a3 --- /dev/null +++ b/octave_packages/m/linear-algebra/ishermitian.m @@ -0,0 +1,67 @@ +## Copyright (C) 1996-2012 John W. Eaton +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ishermitian (@var{x}) +## @deftypefnx {Function File} {} ishermitian (@var{x}, @var{tol}) +## Return true if @var{x} is Hermitian within the tolerance specified by +## @var{tol}. +## The default tolerance is zero (uses faster code). +## Matrix @var{x} is considered symmetric if +## @code{norm (@var{x} - @var{x}', Inf) / norm (@var{x}, Inf) < @var{tol}}. +## @seealso{issymmetric, isdefinite} +## @end deftypefn + +## Author: A. S. Hodel +## Created: August 1993 +## Adapted-By: jwe + +function retval = ishermitian (x, tol = 0) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + retval = isnumeric (x) && issquare (x); + if (retval) + if (tol == 0) + retval = all ((x == x')(:)); + else + norm_x = norm (x, inf); + retval = norm_x == 0 || norm (x - x', inf) / norm_x <= tol; + endif + endif + +endfunction + +%!assert(ishermitian (1)); +%!assert(!(ishermitian ([1, 2]))); +%!assert(ishermitian ([])); +%!assert(ishermitian ([1, 2; 2, 1])); +%!assert(!(ishermitian ("test"))); +%!assert(ishermitian ([1, 2.1; 2, 1.1], 0.2)); +%!assert(ishermitian ([1, -2i; 2i, 1])); +%!assert(!(ishermitian ("t"))); +%!assert(!(ishermitian (["te"; "et"]))); +%!error ishermitian ([1, 2; 2, 1], 0, 0); +%!error ishermitian (); + +%!test +%! s.a = 1; +%! assert(!(ishermitian (s))); diff --git a/octave_packages/m/linear-algebra/issymmetric.m b/octave_packages/m/linear-algebra/issymmetric.m new file mode 100644 index 0000000..3a4fc65 --- /dev/null +++ b/octave_packages/m/linear-algebra/issymmetric.m @@ -0,0 +1,66 @@ +## Copyright (C) 1996-2012 John W. Eaton +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} issymmetric (@var{x}) +## @deftypefnx {Function File} {} issymmetric (@var{x}, @var{tol}) +## Return true if @var{x} is a symmetric matrix within the tolerance specified +## by @var{tol}. The default tolerance is zero (uses faster code). +## Matrix @var{x} is considered symmetric if +## @code{norm (@var{x} - @var{x}.', Inf) / norm (@var{x}, Inf) < @var{tol}}. +## @seealso{ishermitian, isdefinite} +## @end deftypefn + +## Author: A. S. Hodel +## Created: August 1993 +## Adapted-By: jwe + +function retval = issymmetric (x, tol = 0) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + retval = isnumeric (x) && issquare (x); + if (retval) + if (tol == 0) + retval = all ((x == x.')(:)); + else + norm_x = norm (x, inf); + retval = norm_x == 0 || norm (x - x.', inf) / norm_x <= tol; + endif + endif + +endfunction + +%!assert(issymmetric (1)); +%!assert(!(issymmetric ([1, 2]))); +%!assert(issymmetric ([])); +%!assert(issymmetric ([1, 2; 2, 1])); +%!assert(!(issymmetric ("test"))); +%!assert(issymmetric ([1, 2.1; 2, 1.1], 0.2)); +%!assert(issymmetric ([1, 2i; 2i, 1])); +%!assert(!(issymmetric ("t"))); +%!assert(!(issymmetric (["te"; "et"]))); +%!error issymmetric ([1, 2; 2, 1], 0, 0); +%!error issymmetric (); + +%!test +%! s.a = 1; +%! assert(!(issymmetric (s))); diff --git a/octave_packages/m/linear-algebra/krylov.m b/octave_packages/m/linear-algebra/krylov.m new file mode 100644 index 0000000..b322f7d --- /dev/null +++ b/octave_packages/m/linear-algebra/krylov.m @@ -0,0 +1,246 @@ +## Copyright (C) 1993-2012 Auburn University. All rights reserved. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{u}, @var{h}, @var{nu}] =} krylov (@var{A}, @var{V}, @var{k}, @var{eps1}, @var{pflg}) +## Construct an orthogonal basis @var{u} of block Krylov subspace +## +## @example +## [v a*v a^2*v @dots{} a^(k+1)*v] +## @end example +## +## @noindent +## Using Householder reflections to guard against loss of orthogonality. +## +## If @var{V} is a vector, then @var{h} contains the Hessenberg matrix +## such that @nospell{@xcode{a*u == u*h+rk*ek'}}, in which @code{rk = +## a*u(:,k)-u*h(:,k)}, and @nospell{@xcode{ek'}} is the vector +## @code{[0, 0, @dots{}, 1]} of length @code{k}. Otherwise, @var{h} is +## meaningless. +## +## If @var{V} is a vector and @var{k} is greater than +## @code{length(A)-1}, then @var{h} contains the Hessenberg matrix such +## that @code{a*u == u*h}. +## +## The value of @var{nu} is the dimension of the span of the Krylov +## subspace (based on @var{eps1}). +## +## If @var{b} is a vector and @var{k} is greater than @var{m-1}, then +## @var{h} contains the Hessenberg decomposition of @var{A}. +## +## The optional parameter @var{eps1} is the threshold for zero. The +## default value is 1e-12. +## +## If the optional parameter @var{pflg} is nonzero, row pivoting is used +## to improve numerical behavior. The default value is 0. +## +## Reference: A. Hodel, P. Misra, @cite{Partial Pivoting in the Computation of +## Krylov Subspaces of Large Sparse Systems}, Proceedings of the 42nd IEEE +## Conference on Decision and Control, December 2003. +## @end deftypefn + +## Author: A. Scottedward Hodel + +function [Uret, H, nu] = krylov (A, V, k, eps1, pflg); + + if (isa (A, "single") || isa (V, "single")) + defeps = 1e-6; + else + defeps = 1e-12; + endif + + if (nargin < 3 || nargin > 5) + print_usage (); + elseif (nargin < 5) + ## Default permutation flag. + pflg = 0; + endif + + if(nargin < 4) + ## Default tolerance parameter. + eps1 = defeps; + endif + + if (isempty (eps1)) + eps1 = defeps; + endif + + if (! issquare (A) || isempty (A)) + error ("krylov: A(%d x %d) must be a non-empty square matrix", rows (A), columns (A)); + endif + na = rows (A); + + [m, kb] = size (V); + if (m != na) + error ("krylov: A(%d x %d), V(%d x %d): argument dimensions do not match", + na, na, m, kb); + endif + + if (! isscalar (k)) + error ("krylov: K must be a scalar integer"); + endif + + Vnrm = norm (V, Inf); + + ## check for trivial solution. + if (Vnrm == 0) + Uret = []; + H = []; + nu = 0; + return; + endif + + ## Identify trivial null space. + abm = max (abs ([A, V]')); + zidx = find (abm == 0); + + ## Set up vector of pivot points. + pivot_vec = 1:na; + + iter = 0; + alpha = []; + nh = 0; + while (length(alpha) < na) && (columns(V) > 0) && (iter < k) + iter++; + + ## Get orthogonal basis of V. + jj = 1; + while (jj <= columns (V) && length (alpha) < na) + ## Index of next Householder reflection. + nu = length(alpha)+1; + + short_pv = pivot_vec(nu:na); + q = V(:,jj); + short_q = q(short_pv); + + if (norm (short_q) < eps1) + ## Insignificant column; delete. + nv = columns (V); + if (jj != nv) + [V(:,jj), V(:,nv)] = swap (V(:,jj), V(:,nv)); + ## FIXME -- H columns should be swapped too. Not done + ## since Block Hessenberg structure is lost anyway. + endif + V = V(:,1:(nv-1)); + ## One less reflection. + nu--; + else + ## New householder reflection. + if (pflg) + ## Locate max magnitude element in short_q. + asq = abs (short_q); + maxv = max (asq); + maxidx = find (asq == maxv, 1); + pivot_idx = short_pv(maxidx); + + ## See if need to change the pivot list. + if (pivot_idx != pivot_vec(nu)) + swapidx = maxidx + (nu-1); + [pivot_vec(nu), pivot_vec(swapidx)] = ... + swap (pivot_vec(nu), pivot_vec(swapidx)); + endif + endif + + ## Isolate portion of vector for reflection. + idx = pivot_vec(nu:na); + jdx = pivot_vec(1:nu); + + [hv, av, z] = housh (q(idx), 1, 0); + alpha(nu) = av; + U(idx,nu) = hv; + + ## Reduce V per the reflection. + V(idx,:) = V(idx,:) - av*hv*(hv' * V(idx,:)); + if(iter > 1) + ## FIXME -- not done correctly for block case. + H(nu,nu-1) = V(pivot_vec(nu),jj); + endif + + ## Advance to next column of V. + jj++; + endif + endwhile + + ## Check for oversize V (due to full rank). + if ((columns (V) > na) && (length (alpha) == na)) + ## Trim to size. + V = V(:,1:na); + elseif (columns(V) > na) + krylov_V = V; + krylov_na = na; + krylov_length_alpha = length (alpha); + error ("krylov: this case should never happen; submit a bug report"); + endif + + if (columns (V) > 0) + ## Construct next Q and multiply. + Q = zeros (size (V)); + for kk = 1:columns (Q) + Q(pivot_vec(nu-columns(Q)+kk),kk) = 1; + endfor + + ## Apply Householder reflections. + for ii = nu:-1:1 + idx = pivot_vec(ii:na); + hv = U(idx,ii); + av = alpha(ii); + Q(idx,:) = Q(idx,:) - av*hv*(hv'*Q(idx,:)); + endfor + endif + + ## Multiply to get new vector. + V = A*Q; + ## Project off of previous vectors. + nu = length (alpha); + for i = 1:nu + hv = U(:,i); + av = alpha(i); + V = V - av*hv*(hv'*V); + H(i,nu-columns(V)+(1:columns(V))) = V(pivot_vec(i),:); + endfor + + endwhile + + ## Back out complete U matrix. + ## back out U matrix. + j1 = columns (U); + for i = j1:-1:1; + idx = pivot_vec(i:na); + hv = U(idx,i); + av = alpha(i); + U(:,i) = zeros (na, 1); + U(idx(1),i) = 1; + U(idx,i:j1) = U(idx,i:j1)-av*hv*(hv'*U(idx,i:j1)); + endfor + + nu = length (alpha); + Uret = U; + if (max (max (abs (Uret(zidx,:)))) > 0) + warning ("krylov: trivial null space corrupted; set pflg = 1 or eps1 > %e", + eps1); + endif + +endfunction + + +function [a1, b1] = swap (a, b) + + a1 = b; + b1 = a; + +endfunction diff --git a/octave_packages/m/linear-algebra/logm.m b/octave_packages/m/linear-algebra/logm.m new file mode 100644 index 0000000..7e03538 --- /dev/null +++ b/octave_packages/m/linear-algebra/logm.m @@ -0,0 +1,171 @@ +## Copyright (C) 2008-2012 N.J. Higham +## Copyright (C) 2010 Richard T. Guy +## Copyright (C) 2010 Marco Caliari +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{s} =} logm (@var{A}) +## @deftypefnx {Function File} {@var{s} =} logm (@var{A}, @var{opt_iters}) +## @deftypefnx {Function File} {[@var{s}, @var{iters}] =} logm (@dots{}) +## Compute the matrix logarithm of the square matrix @var{A}. The +## implementation utilizes a Pad@'e approximant and the identity +## +## @example +## logm (@var{A}) = 2^k * logm (@var{A}^(1 / 2^k)) +## @end example +## +## The optional argument @var{opt_iters} is the maximum number of square roots +## to compute and defaults to 100. The optional output @var{iters} is the +## number of square roots actually computed. +## @seealso{expm, sqrtm} +## @end deftypefn + +## Reference: N. J. Higham, Functions of Matrices: Theory and Computation +## (SIAM, 2008.) +## + +function [s, iters] = logm (A, opt_iters = 100) + + if (nargin == 0 || nargin > 2) + print_usage (); + endif + + if (! issquare (A)) + error ("logm: A must be a square matrix"); + endif + + if (isscalar (A)) + s = log (A); + return; + elseif (strfind (typeinfo (A), "diagonal matrix")) + s = diag (log (diag (A))); + return; + endif + + [u, s] = schur (A); + + if (isreal (A)) + [u, s] = rsf2csf (u, s); + endif + + eigv = diag (s); + if (any (eigv < 0)) + warning ("Octave:logm:non-principal", + "logm: principal matrix logarithm is not defined for matrices with negative eigenvalues; computing non-principal logarithm"); + endif + + real_eig = all (eigv >= 0); + + k = 0; + ## Algorithm 11.9 in "Function of matrices", by N. Higham + theta = [0, 0, 1.61e-2, 5.38e-2, 1.13e-1, 1.86e-1, 2.6429608311114350e-1]; + p = 0; + m = 7; + while (k < opt_iters) + tau = norm (s - eye (size (s)),1); + if (tau <= theta (7)) + p = p + 1; + j(1) = find (tau <= theta, 1); + j(2) = find (tau / 2 <= theta, 1); + if (j(1) - j(2) <= 1 || p == 2) + m = j(1); + break + endif + endif + k = k + 1; + s = sqrtm (s); + endwhile + + if (k >= opt_iters) + warning ("logm: maximum number of square roots exceeded; results may still be accurate"); + endif + + s = s - eye (size (s)); + + if (m > 1) + s = logm_pade_pf (s, m); + endif + + s = 2^k * u * s * u'; + + ## Remove small complex values (O(eps)) which may have entered calculation + if (real_eig && isreal(A)) + s = real (s); + endif + + if (nargout == 2) + iters = k; + endif + +endfunction + +################## ANCILLARY FUNCTIONS ################################ +###### Taken from the mfttoolbox (GPL 3) by D. Higham. +###### Reference: +###### D. Higham, Functions of Matrices: Theory and Computation +###### (SIAM, 2008.). +####################################################################### + +##LOGM_PADE_PF Evaluate Pade approximant to matrix log by partial fractions. +## Y = LOGM_PADE_PF(A,M) evaluates the [M/M] Pade approximation to +## LOG(EYE(SIZE(A))+A) using a partial fraction expansion. + +function s = logm_pade_pf (A, m) + [nodes, wts] = gauss_legendre (m); + ## Convert from [-1,1] to [0,1]. + nodes = (nodes+1)/2; + wts = wts/2; + + n = length (A); + s = zeros (n); + for j = 1:m + s += wts(j)*(A/(eye (n) + nodes(j)*A)); + endfor +endfunction + +###################################################################### +## GAUSS_LEGENDRE Nodes and weights for Gauss-Legendre quadrature. +## [X,W] = GAUSS_LEGENDRE(N) computes the nodes X and weights W +## for N-point Gauss-Legendre quadrature. + +## Reference: +## G. H. Golub and J. H. Welsch, Calculation of Gauss quadrature +## rules, Math. Comp., 23(106):221-230, 1969. + +function [x, w] = gauss_legendre (n) + i = 1:n-1; + v = i./sqrt ((2*i).^2-1); + [V, D] = eig (diag (v, -1) + diag (v, 1)); + x = diag (D); + w = 2*(V(1,:)'.^2); +endfunction + + +%!assert(norm(logm([1 -1;0 1]) - [0 -1; 0 0]) < 1e-5); +%!assert(norm(expm(logm([-1 2 ; 4 -1])) - [-1 2 ; 4 -1]) < 1e-5); +%!assert(logm([1 -1 -1;0 1 -1; 0 0 1]), [0 -1 -1.5; 0 0 -1; 0 0 0], 1e-5); +%!assert (logm (expm ([0 1i; -1i 0])), [0 1i; -1i 0], 10 * eps) + +%% Test input validation +%!error logm (); +%!error logm (1, 2, 3); +%!error logm([1 0;0 1; 2 2]); + +%!assert (logm (10), log (10)) +%!assert (full (logm (eye (3))), logm (full (eye (3)))) +%!assert (full (logm (10*eye (3))), logm (full (10*eye (3))), 8*eps) diff --git a/octave_packages/m/linear-algebra/normest.m b/octave_packages/m/linear-algebra/normest.m new file mode 100644 index 0000000..9ba44c0 --- /dev/null +++ b/octave_packages/m/linear-algebra/normest.m @@ -0,0 +1,93 @@ +## Copyright (C) 2006-2012 David Bateman and Marco Caliari +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{n} =} normest (@var{A}) +## @deftypefnx {Function File} {@var{n} =} normest (@var{A}, @var{tol}) +## @deftypefnx {Function File} {[@var{n}, @var{c}] =} normest (@dots{}) +## Estimate the 2-norm of the matrix @var{A} using a power series +## analysis. This is typically used for large matrices, where the cost +## of calculating @code{norm (@var{A})} is prohibitive and an approximation +## to the 2-norm is acceptable. +## +## @var{tol} is the tolerance to which the 2-norm is calculated. By default +## @var{tol} is 1e-6. @var{c} returns the number of iterations needed for +## @code{normest} to converge. +## @end deftypefn + +function [n, c] = normest (A, tol = 1e-6) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (A) && ndims (A) == 2)) + error ("normest: A must be a numeric 2-D matrix"); + endif + + if (! (isscalar (tol) && isreal (tol))) + error ("normest: TOL must be a real scalar"); + endif + + if (! isfloat (A)) + A = double (A); + endif + + tol = max (tol, eps (class (A))); + ## Set random number generator to depend on target matrix + v = rand ("state"); + rand ("state", trace (A)); + ncols = columns (A); + ## Randomize y to avoid bad guesses for important matrices. + y = rand (ncols, 1); + c = 0; + n = 0; + do + n0 = n; + x = A * y; + normx = norm (x); + if (normx == 0) + x = rand (ncols, 1); + else + x = x / normx; + endif + y = A' * x; + n = norm (y); + c += 1; + until (abs (n - n0) <= tol * n) + + rand ("state", v); # restore state of random number generator +endfunction + +%!test +%! A = toeplitz ([-2,1,0,0]); +%! assert (normest(A), norm(A), 1e-6); + +%!test +%! A = rand (10); +%! assert (normest(A), norm(A), 1e-6); + +%% Test input validation +%!error normest () +%!error normest (1, 2, 3) +%!error normest ([true true]) +%!error normest (ones (3,3,3)) +%!error normest (1, [1, 2]) +%!error normest (1, 1+1i) + diff --git a/octave_packages/m/linear-algebra/null.m b/octave_packages/m/linear-algebra/null.m new file mode 100644 index 0000000..49b1a4e --- /dev/null +++ b/octave_packages/m/linear-algebra/null.m @@ -0,0 +1,111 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} null (@var{A}) +## @deftypefnx {Function File} {} null (@var{A}, @var{tol}) +## Return an orthonormal basis of the null space of @var{A}. +## +## The dimension of the null space is taken as the number of singular +## values of @var{A} not greater than @var{tol}. If the argument @var{tol} +## is missing, it is computed as +## +## @example +## max (size (@var{A})) * max (svd (@var{A})) * eps +## @end example +## @seealso{orth} +## @end deftypefn + +## Author: KH +## Created: 24 December 1993. +## Adapted-By: jwe + +function retval = null (A, tol) + + if (isempty (A)) + retval = []; + else + [U, S, V] = svd (A); + + [rows, cols] = size (A); + + [S_nr, S_nc] = size (S); + + if (S_nr == 1 || S_nc == 1) + s = S(1); + else + s = diag (S); + endif + + if (nargin == 1) + if (isa (A, "single")) + tol = max (size (A)) * s (1) * eps ("single"); + else + tol = max (size (A)) * s (1) * eps; + endif + elseif (nargin != 2) + print_usage (); + endif + + rank = sum (s > tol); + + if (rank < cols) + retval = V (:, rank+1:cols); + if (isa (A, "single")) + retval(abs (retval) < eps ("single")) = 0; + else + retval(abs (retval) < eps) = 0; + endif + else + retval = zeros (cols, 0); + endif + endif + +endfunction + +%!test +%! A = 0; +%! assert(null(A), 1); + +%!test +%! A = 1; +%! assert(null(A), zeros(1,0)) + +%!test +%! A = [1 0; 0 1]; +%! assert(null(A), zeros(2,0)); + +%!test +%! A = [1 0; 1 0]; +%! assert(null(A), [0 1]') + +%!test +%! A = [1 1; 0 0]; +%! assert(null(A), [-1/sqrt(2) 1/sqrt(2)]', eps) + +%!test +%! tol = 1e-4; +%! A = [1 0; 0 tol-eps]; +%! assert(null(A,tol), [0 1]') + +%!test +%! tol = 1e-4; +%! A = [1 0; 0 tol+eps]; +%! assert(null(A,tol), zeros(2,0)); + +%!error null() diff --git a/octave_packages/m/linear-algebra/onenormest.m b/octave_packages/m/linear-algebra/onenormest.m new file mode 100644 index 0000000..fa201fc --- /dev/null +++ b/octave_packages/m/linear-algebra/onenormest.m @@ -0,0 +1,290 @@ +## Copyright (C) 2007-2012 Regents of the University of California +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{est}, @var{v}, @var{w}, @var{iter}] =} onenormest (@var{A}, @var{t}) +## @deftypefnx {Function File} {[@var{est}, @var{v}, @var{w}, @var{iter}] =} onenormest (@var{apply}, @var{apply_t}, @var{n}, @var{t}) +## +## Apply Higham and Tisseur's randomized block 1-norm estimator to +## matrix @var{A} using @var{t} test vectors. If @var{t} exceeds 5, then +## only 5 test vectors are used. +## +## If the matrix is not explicit, e.g., when estimating the norm of +## @code{inv (@var{A})} given an LU@tie{}factorization, @code{onenormest} +## applies @var{A} and its conjugate transpose through a pair of functions +## @var{apply} and @var{apply_t}, respectively, to a dense matrix of size +## @var{n} by @var{t}. The implicit version requires an explicit dimension +## @var{n}. +## +## Returns the norm estimate @var{est}, two vectors @var{v} and +## @var{w} related by norm +## @code{(@var{w}, 1) = @var{est} * norm (@var{v}, 1)}, +## and the number of iterations @var{iter}. The number of +## iterations is limited to 10 and is at least 2. +## +## References: +## @itemize +## @item +## N.J. Higham and F. Tisseur, @cite{A Block Algorithm +## for Matrix 1-Norm Estimation, with an Application to 1-Norm +## Pseudospectra}. SIMAX vol 21, no 4, pp 1185-1201. +## @url{http://dx.doi.org/10.1137/S0895479899356080} +## +## @item +## N.J. Higham and F. Tisseur, @cite{A Block Algorithm +## for Matrix 1-Norm Estimation, with an Application to 1-Norm +## Pseudospectra}. @url{http://citeseer.ist.psu.edu/223007.html} +## @end itemize +## +## @seealso{condest, norm, cond} +## @end deftypefn + +## Code originally licensed under +## +## Copyright (c) 2007, Regents of the University of California +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted provided that the following conditions +## are met: +## +## * Redistributions of source code must retain the above copyright +## notice, this list of conditions and the following disclaimer. +## +## * Redistributions in binary form must reproduce the above +## copyright notice, this list of conditions and the following +## disclaimer in the documentation and/or other materials provided +## with the distribution. +## +## * Neither the name of the University of California, Berkeley 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 REGENTS 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 REGENTS AND +## 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. + +## Author: Jason Riedy +## Keywords: linear-algebra norm estimation +## Version: 0.2 + +function [est, v, w, iter] = onenormest (varargin) + + if (size (varargin, 2) < 1 || size (varargin, 2) > 4) + print_usage (); + endif + + default_t = 5; + itmax = 10; + + if (ismatrix (varargin{1})) + n = size (varargin{1}, 1); + if n != size (varargin{1}, 2), + error ("onenormest: matrix must be square"); + endif + apply = @(x) varargin{1} * x; + apply_t = @(x) varargin{1}' * x; + if (size (varargin) > 1) + t = varargin{2}; + else + t = min (n, default_t); + endif + issing = isa (varargin {1}, "single"); + else + if (size (varargin, 2) < 3) + print_usage(); + endif + n = varargin{3}; + apply = varargin{1}; + apply_t = varargin{2}; + if (size (varargin) > 3) + t = varargin{4}; + else + t = default_t; + endif + issing = isa (varargin {3}, "single"); + endif + + ## Initial test vectors X. + X = rand (n, t); + X = X ./ (ones (n,1) * sum (abs (X), 1)); + + ## Track if a vertex has been visited. + been_there = zeros (n, 1); + + ## To check if the estimate has increased. + est_old = 0; + + ## Normalized vector of signs. + S = zeros (n, t); + + if (issing) + myeps = eps ("single"); + X = single (X); + else + myeps = eps; + endif + + for iter = 1 : itmax + 1 + Y = feval (apply, X); + + ## Find the initial estimate as the largest A*x. + [est, ind_best] = max (sum (abs (Y), 1)); + if (est > est_old || iter == 2) + w = Y(:,ind_best); + endif + if (iter >= 2 && est < est_old) + ## No improvement, so stop. + est = est_old; + break; + endif + + est_old = est; + S_old = S; + if (iter > itmax), + ## Gone too far. Stop. + break; + endif + + S = sign (Y); + + ## Test if any of S are approximately parallel to previous S + ## vectors or current S vectors. If everything is parallel, + ## stop. Otherwise, replace any parallel vectors with + ## rand{-1,+1}. + partest = any (abs (S_old' * S - n) < 4*eps*n); + if (all (partest)) + ## All the current vectors are parallel to old vectors. + ## We've hit a cycle, so stop. + break; + endif + if (any (partest)) + ## Some vectors are parallel to old ones and are cycling, + ## but not all of them. Replace the parallel vectors with + ## rand{-1,+1}. + numpar = sum (partest); + replacements = 2*(rand (n,numpar) < 0.5) - 1; + S(:,partest) = replacements; + endif + ## Now test for parallel vectors within S. + partest = any ((S' * S - eye (t)) == n); + if (any (partest)) + numpar = sum (partest); + replacements = 2*(rand (n,numpar) < 0.5) - 1; + S(:,partest) = replacements; + endif + + Z = feval (apply_t, S); + + ## Now find the largest non-previously-visted index per + ## vector. + h = max (abs (Z),2); + [mh, mhi] = max (h); + if (iter >= 2 && mhi == ind_best) + ## Hit a cycle, stop. + break; + endif + [h, ind] = sort (h, 'descend'); + if (t > 1) + firstind = ind(1:t); + if (all (been_there(firstind))) + ## Visited all these before, so stop. + break; + endif + ind = ind (!been_there (ind)); + if (length (ind) < t) + ## There aren't enough new vectors, so we're practically + ## in a cycle. Stop. + break; + endif + endif + + ## Visit the new indices. + X = zeros (n, t); + for zz = 1 : t + X(ind(zz),zz) = 1; + endfor + been_there (ind (1 : t)) = 1; + endfor + + ## The estimate est and vector w are set in the loop above. The + ## vector v selects the ind_best column of A. + v = zeros (n, 1); + v(ind_best) = 1; +endfunction + +%!demo +%! N = 100; +%! A = randn(N) + eye(N); +%! [L,U,P] = lu(A); +%! nm1inv = onenormest(@(x) U\(L\(P*x)), @(x) P'*(L'\(U'\x)), N, 30) +%! norm(inv(A), 1) + +%!test +%! N = 10; +%! A = ones (N); +%! [nm1, v1, w1] = onenormest (A); +%! [nminf, vinf, winf] = onenormest (A', 6); +%! assert (nm1, N, -2*eps); +%! assert (nminf, N, -2*eps); +%! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) +%! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) + +%!test +%! N = 10; +%! A = ones (N); +%! [nm1, v1, w1] = onenormest (@(x) A*x, @(x) A'*x, N, 3); +%! [nminf, vinf, winf] = onenormest (@(x) A'*x, @(x) A*x, N, 3); +%! assert (nm1, N, -2*eps); +%! assert (nminf, N, -2*eps); +%! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) +%! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) + +%!test +%! N = 5; +%! A = hilb (N); +%! [nm1, v1, w1] = onenormest (A); +%! [nminf, vinf, winf] = onenormest (A', 6); +%! assert (nm1, norm (A, 1), -2*eps); +%! assert (nminf, norm (A, inf), -2*eps); +%! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) +%! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) + +## Only likely to be within a factor of 10. +%!test +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ('state', 42); % Initialize to guarantee reproducible results +%! N = 100; +%! A = rand (N); +%! [nm1, v1, w1] = onenormest (A); +%! [nminf, vinf, winf] = onenormest (A', 6); +%! assert (nm1, norm (A, 1), -.1); +%! assert (nminf, norm (A, inf), -.1); +%! assert (norm (w1, 1), nm1 * norm (v1, 1), -2*eps) +%! assert (norm (winf, 1), nminf * norm (vinf, 1), -2*eps) diff --git a/octave_packages/m/linear-algebra/orth.m b/octave_packages/m/linear-algebra/orth.m new file mode 100644 index 0000000..94cdb40 --- /dev/null +++ b/octave_packages/m/linear-algebra/orth.m @@ -0,0 +1,90 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} orth (@var{A}) +## @deftypefnx {Function File} {} orth (@var{A}, @var{tol}) +## Return an orthonormal basis of the range space of @var{A}. +## +## The dimension of the range space is taken as the number of singular +## values of @var{A} greater than @var{tol}. If the argument @var{tol} is +## missing, it is computed as +## +## @example +## max (size (@var{A})) * max (svd (@var{A})) * eps +## @end example +## @seealso{null} +## @end deftypefn + +## Author: KH +## Created: 24 December 1993. +## Adapted-By: jwe + +function retval = orth (A, tol) + + if (nargin == 1 || nargin == 2) + + if (isempty (A)) + retval = []; + return; + endif + + [U, S, V] = svd (A); + + [rows, cols] = size (A); + + [S_nr, S_nc] = size (S); + + if (S_nr == 1 || S_nc == 1) + s = S(1); + else + s = diag (S); + endif + + if (nargin == 1) + if (isa (A, "single")) + tol = max (size (A)) * s (1) * eps ("single"); + else + tol = max (size (A)) * s (1) * eps; + endif + endif + + rank = sum (s > tol); + + if (rank > 0) + retval = -U (:, 1:rank); + else + retval = zeros (rows, 0); + endif + + else + + print_usage (); + + endif + +endfunction + +%!test +%! for ii=1:20 +%! A = rand (10, 10); +%! V = orth (A); +%! if (det (A) != 0) +%! assert (V'*V, eye (10), 100*eps) +%! endif +%! endfor diff --git a/octave_packages/m/linear-algebra/planerot.m b/octave_packages/m/linear-algebra/planerot.m new file mode 100644 index 0000000..56e9109 --- /dev/null +++ b/octave_packages/m/linear-algebra/planerot.m @@ -0,0 +1,47 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{g}, @var{y}] =} planerot (@var{x}) +## Given a two-element column vector, returns the +## @tex +## $2 \times 2$ orthogonal matrix +## @end tex +## @ifnottex +## 2 by 2 orthogonal matrix +## @end ifnottex +## @var{G} such that +## @code{@var{y} = @var{g} * @var{x}} and @code{@var{y}(2) = 0}. +## @seealso{givens} +## @end deftypefn + +function [G, y] = planerot (x) + G = givens (x(1), x(2)); + y = G * x(:); +endfunction + +%!test +%! x = [3 4]; +%! [g y] = planerot(x); +%! assert(g - [x(1) x(2); -x(2) x(1)] / sqrt(x(1)^2 + x(2)^2), zeros(2), 2e-8); +%! assert(y(2), 0, 2e-8); + +%!error planerot([0]); +%!error planerot([0 0 0]); +%!error planerot(); + diff --git a/octave_packages/m/linear-algebra/qzhess.m b/octave_packages/m/linear-algebra/qzhess.m new file mode 100644 index 0000000..00aba2a --- /dev/null +++ b/octave_packages/m/linear-algebra/qzhess.m @@ -0,0 +1,141 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{aa}, @var{bb}, @var{q}, @var{z}] =} qzhess (@var{A}, @var{B}) +## Compute the Hessenberg-triangular decomposition of the matrix pencil +## @code{(@var{A}, @var{B})}, returning +## @code{@var{aa} = @var{q} * @var{A} * @var{z}}, +## @code{@var{bb} = @var{q} * @var{B} * @var{z}}, with @var{q} and @var{z} +## orthogonal. For example: +## +## @example +## @group +## [aa, bb, q, z] = qzhess ([1, 2; 3, 4], [5, 6; 7, 8]) +## @result{} aa = [ -3.02244, -4.41741; 0.92998, 0.69749 ] +## @result{} bb = [ -8.60233, -9.99730; 0.00000, -0.23250 ] +## @result{} q = [ -0.58124, -0.81373; -0.81373, 0.58124 ] +## @result{} z = [ 1, 0; 0, 1 ] +## @end group +## @end example +## +## The Hessenberg-triangular decomposition is the first step in +## Moler and Stewart's QZ@tie{}decomposition algorithm. +## +## Algorithm taken from Golub and Van Loan, +## @cite{Matrix Computations, 2nd edition}. +## @end deftypefn + +## Author: A. S. Hodel +## Created: August 1993 +## Adapted-By: jwe + +function [aa, bb, q, z] = qzhess (A, B) + + if (nargin != 2) + print_usage (); + endif + + [na, ma] = size (A); + [nb, mb] = size (B); + if (na != ma || na != nb || nb != mb) + error ("qzhess: incompatible dimensions"); + endif + + ## Reduce to hessenberg-triangular form. + + [q, bb] = qr (B); + aa = q' * A; + q = q'; + z = eye (na); + for j = 1:(na-2) + for i = na:-1:(j+2) + + ## disp (["zero out aa(", num2str(i), ",", num2str(j), ")"]) + + rot = givens (aa (i-1, j), aa (i, j)); + aa ((i-1):i, :) = rot *aa ((i-1):i, :); + bb ((i-1):i, :) = rot *bb ((i-1):i, :); + q ((i-1):i, :) = rot *q ((i-1):i, :); + + ## disp (["now zero out bb(", num2str(i), ",", num2str(i-1), ")"]) + + rot = givens (bb (i, i), bb (i, i-1))'; + bb (:, (i-1):i) = bb (:, (i-1):i) * rot'; + aa (:, (i-1):i) = aa (:, (i-1):i) * rot'; + z (:, (i-1):i) = z (:, (i-1):i) * rot'; + + endfor + endfor + + bb (2, 1) = 0.0; + for i = 3:na + bb (i, 1:(i-1)) = zeros (1, i-1); + aa (i, 1:(i-2)) = zeros (1, i-2); + endfor + +endfunction + +%!test +%! a = [1 2 1 3; +%! 2 5 3 2; +%! 5 5 1 0; +%! 4 0 3 2]; +%! b = [0 4 2 1; +%! 2 3 1 1; +%! 1 0 2 1; +%! 2 5 3 2]; +%! mask = [0 0 0 0; +%! 0 0 0 0; +%! 1 0 0 0; +%! 1 1 0 0]; +%! [aa, bb, q, z] = qzhess(a, b); +%! assert(inv(q) - q', zeros(4), 2e-8); +%! assert(inv(z) - z', zeros(4), 2e-8); +%! assert(q * a * z, aa, 2e-8); +%! assert(aa .* mask, zeros(4), 2e-8); +%! assert(q * b * z, bb, 2e-8); +%! assert(bb .* mask, zeros(4), 2e-8); + +%!test +%! a = [1 2 3 4 5; +%! 3 2 3 1 0; +%! 4 3 2 1 1; +%! 0 1 0 1 0; +%! 3 2 1 0 5]; +%! b = [5 0 4 0 1; +%! 1 1 1 2 5; +%! 0 3 2 1 0; +%! 4 3 0 3 5; +%! 2 1 2 1 3]; +%! mask = [0 0 0 0 0; +%! 0 0 0 0 0; +%! 1 0 0 0 0; +%! 1 1 0 0 0; +%! 1 1 1 0 0]; +%! [aa, bb, q, z] = qzhess(a, b); +%! assert(inv(q) - q', zeros(5), 2e-8); +%! assert(inv(z) - z', zeros(5), 2e-8); +%! assert(q * a * z, aa, 2e-8); +%! assert(aa .* mask, zeros(5), 2e-8); +%! assert(q * b * z, bb, 2e-8); +%! assert(bb .* mask, zeros(5), 2e-8); + +%!error qzhess([0]); +%!error qzhess(); + diff --git a/octave_packages/m/linear-algebra/rank.m b/octave_packages/m/linear-algebra/rank.m new file mode 100644 index 0000000..e065536 --- /dev/null +++ b/octave_packages/m/linear-algebra/rank.m @@ -0,0 +1,111 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rank (@var{A}) +## @deftypefnx {Function File} {} rank (@var{A}, @var{tol}) +## Compute the rank of @var{A}, using the singular value decomposition. +## The rank is taken to be the number of singular values of @var{A} that +## are greater than the specified tolerance @var{tol}. If the second +## argument is omitted, it is taken to be +## +## @example +## tol = max (size (@var{A})) * sigma(1) * eps; +## @end example +## +## @noindent +## where @code{eps} is machine precision and @code{sigma(1)} is the largest +## singular value of @var{A}. +## @end deftypefn + +## Author: jwe + +function retval = rank (A, tol) + + if (nargin == 1) + sigma = svd (A); + if (isempty (sigma)) + tolerance = 0; + else + if (isa (A, "single")) + tolerance = max (size (A)) * sigma (1) * eps ("single"); + else + tolerance = max (size (A)) * sigma (1) * eps; + endif + endif + elseif (nargin == 2) + sigma = svd (A); + tolerance = tol; + else + print_usage (); + endif + + retval = sum (sigma > tolerance); + +endfunction + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3.1 4 5 6 7; +%! 2 3 4 5 6 7 8; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),4); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3.0000001 4 5 6 7; +%! 4 5 6 7 8 9 12.00001; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),4); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12.00001; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),3); + +%!test +%! A = [1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 1 2 3 4 5 6 7; +%! 4 5 6 7 8 9 12; +%! 3 4 5 6 7 8 9; +%! 4 5 6 7 8 9 10; +%! 5 6 7 8 9 10 11]; +%! assert(rank(A),3); + +%!test +%! A = eye(100); +%! assert(rank(A),100); + +%!test +%! A = [1, 2, 3; 1, 2.001, 3; 1, 2, 3.0000001]; +%! assert(rank(A),3) +%! assert(rank(A,0.0009),1) +%! assert(rank(A,0.0006),2) +%! assert(rank(A,0.00000002),3) \ No newline at end of file diff --git a/octave_packages/m/linear-algebra/rref.m b/octave_packages/m/linear-algebra/rref.m new file mode 100644 index 0000000..dd91e5b --- /dev/null +++ b/octave_packages/m/linear-algebra/rref.m @@ -0,0 +1,128 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rref (@var{A}) +## @deftypefnx {Function File} {} rref (@var{A}, @var{tol}) +## @deftypefnx {Function File} {[@var{r}, @var{k}] =} rref (@dots{}) +## Return the reduced row echelon form of @var{A}. @var{tol} defaults +## to @code{eps * max (size (@var{A})) * norm (@var{A}, inf)}. +## +## Called with two return arguments, @var{k} returns the vector of +## "bound variables", which are those columns on which elimination +## has been performed. +## +## @end deftypefn + +## Author: Paul Kienzle +## (based on an anonymous source from the public domain) + +function [A, k] = rref (A, tol) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (ndims (A) > 2) + error ("rref: expecting matrix argument"); + endif + + [rows, cols] = size (A); + + if (nargin < 2) + if (isa (A, "single")) + tol = eps ("single") * max (rows, cols) * norm (A, inf ("single")); + else + tol = eps * max (rows, cols) * norm (A, inf); + endif + endif + + used = zeros (1, cols); + r = 1; + for c = 1:cols + ## Find the pivot row + [m, pivot] = max (abs (A(r:rows,c))); + pivot = r + pivot - 1; + + if (m <= tol) + ## Skip column c, making sure the approximately zero terms are + ## actually zero. + A (r:rows, c) = zeros (rows-r+1, 1); + else + ## keep track of bound variables + used (1, c) = 1; + + ## Swap current row and pivot row + A ([pivot, r], c:cols) = A ([r, pivot], c:cols); + + ## Normalize pivot row + A (r, c:cols) = A (r, c:cols) / A (r, c); + + ## Eliminate the current column + ridx = [1:r-1, r+1:rows]; + A (ridx, c:cols) = A (ridx, c:cols) - A (ridx, c) * A(r, c:cols); + + ## Check if done + if (r++ == rows) + break; + endif + endif + endfor + k = find (used); + +endfunction + +%!test +%! a = [1]; +%! [r k] = rref(a); +%! assert(r, [1], 2e-8); +%! assert(k, [1], 2e-8); + +%!test +%! a = [1 3; 4 5]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, eye(2), 2e-8); +%! assert(k == [1, 2] || k == [2, 1]); + + +%!test +%! a = [1 3; 4 5; 7 9]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, eye(3)(:,1:2), 2e-8); +%! assert(k, [1 2], 2e-8); + +%!test +%! a = [1 2 3; 2 4 6; 7 2 0]; +%! [r k] = rref(a); +%! assert(rank(a), rank(r), 2e-8); +%! assert(r, [1 0 (3-7/2); 0 1 (7/4); 0 0 0], 2e-8); +%! assert(k, [1 2], 2e-8); + +%!test +%! a = [1 2 1; 2 4 2.01; 2 4 2.1]; +%! tol = 0.02; +%! [r k] = rref(a, tol); +%! assert(rank(a, tol), rank(r, tol), 2e-8); +%! tol = 0.2; +%! [r k] = rref(a, tol); +%! assert(rank(a, tol), rank(r, tol), 2e-8); + +%!error rref(); + diff --git a/octave_packages/m/linear-algebra/subspace.m b/octave_packages/m/linear-algebra/subspace.m new file mode 100644 index 0000000..47c9862 --- /dev/null +++ b/octave_packages/m/linear-algebra/subspace.m @@ -0,0 +1,61 @@ +## Copyright (C) 2008-2012 VZLU Prague, a.s., Czech Republic +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{angle} =} subspace (@var{A}, @var{B}) +## Determine the largest principal angle between two subspaces +## spanned by the columns of matrices @var{A} and @var{B}. +## @end deftypefn + +## Author: Jaroslav Hajek + +## reference: +## [1] Andrew V. Knyazev, Merico E. Argentati: +## Principal Angles between Subspaces in an A-Based Scalar Product: +## Algorithms and Perturbation Estimates. +## SIAM Journal on Scientific Computing, Vol. 23 no. 6, pp. 2008-2040 +## +## other texts are also around... + +function ang = subspace (A, B) + + if (nargin != 2) + print_usage (); + elseif (ndims (A) != 2 || ndims (B) != 2) + error ("subspace: expecting A and B to be 2-dimensional arrays"); + elseif (rows (A) != rows (B)) + error ("subspace: column dimensions of A and B must match"); + endif + + A = orth (A); + B = orth (B); + c = A'*B; + scos = min (svd (c)); + if (scos^2 > 1/2) + if (columns (A) >= columns (B)) + c = B - A*c; + else + c = A - B*c'; + endif + ssin = max (svd (c)); + ang = asin (min (ssin, 1)); + else + ang = acos (scos); + endif + +endfunction diff --git a/octave_packages/m/linear-algebra/trace.m b/octave_packages/m/linear-algebra/trace.m new file mode 100644 index 0000000..ea14fad --- /dev/null +++ b/octave_packages/m/linear-algebra/trace.m @@ -0,0 +1,52 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} trace (@var{A}) +## Compute the trace of @var{A}, @code{sum (diag (@var{A}))}. +## @end deftypefn + +## Author: jwe + +function y = trace (A) + + if (nargin != 1) + print_usage (); + endif + + if (ndims (A) > 2) + error ("trace: only valid on 2-D objects"); + elseif (isempty (A)) + y = 0; + elseif (any (size (A) == 1)) + y = A(1); + else + y = sum (diag (A)); + endif + +endfunction + +%!assert(trace ([1, 2; 3, 4]) == 5); +%!assert(trace ([1, 2; 3, 4; 5, 6]) == 5); +%!assert(trace ([1, 3, 5; 2, 4, 6]) == 5); +%!assert(trace ([]), 0); +%!assert(trace (randn(1,0)), 0); +%! +%!error trace (); +%!error trace (1, 2); +%!error trace(reshape(1:9,[1,3,3])); diff --git a/octave_packages/m/linear-algebra/vech.m b/octave_packages/m/linear-algebra/vech.m new file mode 100644 index 0000000..b1b278e --- /dev/null +++ b/octave_packages/m/linear-algebra/vech.m @@ -0,0 +1,58 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} vech (@var{x}) +## Return the vector obtained by eliminating all supradiagonal elements of +## the square matrix @var{x} and stacking the result one column above the +## other. This has uses in matrix calculus where the underlying matrix +## is symmetric and it would be pointless to keep values above the main +## diagonal. +## @seealso{vec} +## @end deftypefn + +## See Magnus and Neudecker (1988), Matrix differential calculus with +## applications in statistics and econometrics. + +## Author KH +## Created: 8 May 1995 +## Adapted-By: jwe + +function v = vech (x) + + if (nargin != 1) + print_usage (); + endif + + if (! issquare (x)) + error ("vech: X must be square"); + endif + + n = rows (x); + slices = cellslices (x(:), (1:n) + n*(0:n-1), n*(1:n)); + v = vertcat (slices{:}); + +endfunction + +%!assert(all (vech ([1, 2, 3; 4, 5, 6; 7, 8, 9]) == [1; 4; 7; 5; 8; 9])); + +%!error vech (); + +%!error vech (1, 2); + diff --git a/octave_packages/m/miscellaneous/ans.m b/octave_packages/m/miscellaneous/ans.m new file mode 100644 index 0000000..dfea9b0 --- /dev/null +++ b/octave_packages/m/miscellaneous/ans.m @@ -0,0 +1,34 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @defvr {Automatic Variable} ans +## The most recently computed result that was not +## explicitly assigned to a variable. For example, after the expression +## +## @example +## 3^2 + 4^2 +## @end example +## +## @noindent +## is evaluated, the value returned by @code{ans} is 25. +## @end defvr + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) + diff --git a/octave_packages/m/miscellaneous/bincoeff.m b/octave_packages/m/miscellaneous/bincoeff.m new file mode 100644 index 0000000..1f7cf57 --- /dev/null +++ b/octave_packages/m/miscellaneous/bincoeff.m @@ -0,0 +1,120 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} bincoeff (@var{n}, @var{k}) +## Return the binomial coefficient of @var{n} and @var{k}, defined as +## @tex +## $$ +## {n \choose k} = {n (n-1) (n-2) \cdots (n-k+1) \over k!} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## / \ +## | n | n (n-1) (n-2) @dots{} (n-k+1) +## | | = ------------------------- +## | k | k! +## \ / +## @end group +## @end example +## +## @end ifnottex +## For example: +## +## @example +## @group +## bincoeff (5, 2) +## @result{} 10 +## @end group +## @end example +## +## In most cases, the @code{nchoosek} function is faster for small +## scalar integer arguments. It also warns about loss of precision for +## big arguments. +## +## @seealso{nchoosek} +## @end deftypefn + +## Author: KH +## Created: 8 October 1994 +## Adapted-By: jwe + +function b = bincoeff (n, k) + + if (nargin != 2) + print_usage (); + endif + + [retval, n, k] = common_size (n, k); + if (retval > 0) + error ("bincoeff: N and K must be of common size or scalars"); + endif + + if (iscomplex (n) || iscomplex (k)) + error ("bincoeff: N and K must not be complex"); + endif + + b = zeros (size (n)); + + ok = (k >= 0) & (k == fix (k)) & (! isnan (n)); + b(! ok) = NaN; + + n_int = (n == fix (n)); + idx = n_int & (n < 0) & ok; + b(idx) = (-1) .^ k(idx) .* exp (gammaln (abs (n(idx)) + k(idx)) + - gammaln (k(idx) + 1) + - gammaln (abs (n(idx)))); + + idx = (n >= k) & ok; + b(idx) = exp (gammaln (n(idx) + 1) + - gammaln (k(idx) + 1) + - gammaln (n(idx) - k(idx) + 1)); + + idx = (! n_int) & (n < k) & ok; + b(idx) = (1/pi) * exp (gammaln (n(idx) + 1) + - gammaln (k(idx) + 1) + + gammaln (k(idx) - n(idx)) + + log (sin (pi * (n(idx) - k(idx) + 1)))); + + ## Clean up rounding errors. + b(n_int) = round (b(n_int)); + + idx = ! n_int; + b(idx) = real (b(idx)); + +endfunction + + +%!assert(bincoeff (4, 2), 6) +%!assert(bincoeff (2, 4), 0) +%!assert(bincoeff (-4, 2), 10) +%!assert(bincoeff (5, 2), 10) +%!assert(bincoeff (50, 6), 15890700) +%!assert(bincoeff (0.4, 2), -.12, 8*eps) + +%!assert(bincoeff ([4 NaN 4], [-1, 2, 2.5]), NaN (1, 3)) + +%% Test input validation +%!error bincoeff (); +%!error bincoeff (1, 2, 3); +%!error bincoeff (ones(3),ones(2)) +%!error bincoeff (ones(2),ones(3)) + diff --git a/octave_packages/m/miscellaneous/bug_report.m b/octave_packages/m/miscellaneous/bug_report.m new file mode 100644 index 0000000..d3892b4 --- /dev/null +++ b/octave_packages/m/miscellaneous/bug_report.m @@ -0,0 +1,48 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} bug_report () +## Display information about how to submit bug reports for Octave. +## @end deftypefn + +## Author: jwe + +function bug_report () + + puts ("\n"); + puts (" Bug reports play an essential role in making Octave\n"); + puts (" reliable. Please use the Octave bug tracker at\n"); + puts ("\n"); + puts (" http://bugs.octave.org\n"); + puts ("\n"); + puts (" to report problems.\n"); + puts ("\n"); + puts (" Please also read the bug reporting guidelines at\n"); + puts ("\n"); + puts (" http://www.octave.org/bugs.html\n"); + puts ("\n"); + puts (" to learn how to submit useful bug reports that will\n"); + puts (" help the Octave community diagnose and fix the problem\n"); + puts (" quickly and efficiently.\n"); + puts ("\n"); + +endfunction + +## Mark file as being tested. No real test needed for this function. +%!assert (1) diff --git a/octave_packages/m/miscellaneous/bunzip2.m b/octave_packages/m/miscellaneous/bunzip2.m new file mode 100644 index 0000000..1f0eb76 --- /dev/null +++ b/octave_packages/m/miscellaneous/bunzip2.m @@ -0,0 +1,42 @@ +## Copyright (C) 2006-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} bunzip2 (@var{bzfile}) +## @deftypefnx {Function File} {} bunzip2 (@var{bzfile}, @var{dir}) +## Unpack the bzip2 archive @var{bzfile} to the directory @var{dir}. If +## @var{dir} is not specified, it defaults to the current directory. +## @seealso{bzip2, unpack, gunzip, unzip, untar} +## @end deftypefn + +## Author: Bill Denney + +function varargout = bunzip2 (bzfile, dir = ".") + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (nargout > 0) + varargout = cell (1, nargout); + [varargout{:}] = unpack (bzfile, dir, mfilename ()); + else + unpack (bzfile, dir, mfilename ()); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/bzip2.m b/octave_packages/m/miscellaneous/bzip2.m new file mode 100644 index 0000000..fb39de2 --- /dev/null +++ b/octave_packages/m/miscellaneous/bzip2.m @@ -0,0 +1,61 @@ +## Copyright (C) 2008-2012 Thorsten Meyer +## (based on gzip.m by David Bateman) +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{entries} =} bzip2 (@var{files}) +## @deftypefnx {Function File} {@var{entries} =} bzip2 (@var{files}, @var{outdir}) +## Compress the list of files specified in @var{files}. +## Each file is compressed separately and a new file with a '.bz2' extension +## is created. The original files are not modified. Existing compressed files +## are silently overwritten. If @var{outdir} is defined the compressed +## files are placed in this directory. +## @seealso{bunzip2, gzip, zip, tar} +## @end deftypefn + +function entries = bzip2 (varargin) + + if (nargin == 1 || nargin == 2) + if nargout == 0 + __xzip__ ("bzip2", "bz2", "bzip2 %s", varargin{:}); + else + entries = __xzip__ ("bzip2", "bz2", "bzip2 %s", varargin{:}); + endif + else + print_usage (); + endif + +endfunction + +%!xtest +%! # test for correct cleanup of temporary files +%! unwind_protect +%! filename = tmpnam; +%! dummy = 1; +%! save(filename, "dummy"); +%! n_tmpfiles_before = length(find(strncmp("oct-", cellstr(ls(P_tmpdir)), 4))); +%! entry = bzip2(filename); +%! n_tmpfiles_after = length(find(strncmp("oct-", cellstr(ls(P_tmpdir)), 4))); +%! if (n_tmpfiles_before != n_tmpfiles_after) +%! error("bzip2 has not cleaned up temporary files correctly!"); +%! endif +%! unwind_protect_cleanup +%! delete(filename); +%! [path, basename, extension] = fileparts(filename); +%! delete([basename, extension, ".bz2"]); +%! end_unwind_protect diff --git a/octave_packages/m/miscellaneous/cast.m b/octave_packages/m/miscellaneous/cast.m new file mode 100644 index 0000000..052e10d --- /dev/null +++ b/octave_packages/m/miscellaneous/cast.m @@ -0,0 +1,45 @@ +## Copyright (C) 2007-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cast (@var{val}, @var{type}) +## Convert @var{val} to data type @var{type}. +## @seealso{int8, uint8, int16, uint16, int32, uint32, int64, uint64, double} +## @end deftypefn + +## Author: jwe + +function retval = cast (val, typ) + + if (nargin == 2) + if (ischar (typ)) + if (any (strcmp (typ, {"int8"; "uint8"; "int16"; "uint16"; + "int32"; "uint32"; "int64"; "uint64"; + "double"; "single"; "logical"; "char"}))) + retval = feval (typ, val); + else + error ("cast: type name `%s' is not a built-in type", typ); + endif + else + error ("cast: expecting TYPE name as second argument"); + endif + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/comma.m b/octave_packages/m/miscellaneous/comma.m new file mode 100644 index 0000000..9bf4b47 --- /dev/null +++ b/octave_packages/m/miscellaneous/comma.m @@ -0,0 +1,27 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Operator} {} , +## Array index, function argument, or command separator. +## @seealso{semicolon} +## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) + diff --git a/octave_packages/m/miscellaneous/compare_versions.m b/octave_packages/m/miscellaneous/compare_versions.m new file mode 100644 index 0000000..2be4b53 --- /dev/null +++ b/octave_packages/m/miscellaneous/compare_versions.m @@ -0,0 +1,253 @@ +## Copyright (C) 2006-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} compare_versions (@var{v1}, @var{v2}, @var{operator}) +## Compare two version strings using the given @var{operator}. +## +## This function assumes that versions @var{v1} and @var{v2} are +## arbitrarily long strings made of numeric and period characters +## possibly followed by an arbitrary string (e.g., "1.2.3", "0.3", +## "0.1.2+", or "1.2.3.4-test1"). +## +## The version is first split into numeric and character portions +## and then the parts are padded to be the same length (i.e., "1.1" would be +## padded to be "1.1.0" when being compared with "1.1.1", and +## separately, the character parts of the strings are padded with +## nulls). +## +## The operator can be any logical operator from the set +## +## @itemize @bullet +## @item +## "==" +## equal +## +## @item +## "<" +## less than +## +## @item +## "<=" +## less than or equal to +## +## @item +## ">" +## greater than +## +## @item +## ">=" +## greater than or equal to +## +## @item +## "!=" +## not equal +## +## @item +## "~=" +## not equal +## @end itemize +## +## Note that version "1.1-test2" will compare as greater than +## "1.1-test10". Also, since the numeric part is compared first, "a" +## compares less than "1a" because the second string starts with a +## numeric part even though @code{double("a")} is greater than +## @code{double("1").} +## @end deftypefn + +## Author: Bill Denney + +function out = compare_versions (v1, v2, operator) + + if (nargin != 3) + print_usage (); + endif + + ## Make sure that the version numbers are valid. + if (! (ischar (v1) && ischar (v2))) + error ("compare_versions: both version numbers must be strings"); + elseif (rows (v1) != 1 || rows (v2) != 1) + error ("compare_versions: version numbers must be a single row"); + endif + + ## check and make sure that the operator is valid + if (! ischar (operator)) + error ("compare_versions: OPERATOR must be a character string"); + elseif (numel (operator) > 2) + error("compare_versions: OPERATOR must be 1 or 2 characters long"); + endif + + ## trim off any character data that is not part of a normal version + ## number + numbers = "0123456789."; + + v1firstchar = find (! ismember (v1, numbers), 1); + v2firstchar = find (! ismember (v2, numbers), 1); + if (! isempty (v1firstchar)) + v1c = v1(v1firstchar:length(v1)); + v1nochar = v1(1:v1firstchar-1); + else + v1c = ""; + v1nochar = v1; + endif + if (! isempty (v2firstchar)) + v2c = v2(v2firstchar:length(v2)); + v2nochar = v2(1:v2firstchar-1); + else + v2c = ""; + v2nochar = v2; + endif + + v1n = str2num (char (strsplit (v1nochar, "."))); + v2n = str2num (char (strsplit (v2nochar, "."))); + if ((isempty (v1n) && isempty (v1c)) || (isempty (v2n) && isempty(v2c))) + error ("compare_versions: given version strings are not valid: %s %s", + v1, v2); + endif + + ## Assume that any additional elements would be 0 if one is longer + ## than the other. + maxnumlen = max ([length(v1n) length(v2n)]); + if (length (v1n) < maxnumlen) + v1n(length(v1n)+1:maxnumlen) = 0; + endif + if (length (v2n) < maxnumlen) + v2n(length(v2n)+1:maxnumlen) = 0; + endif + + ## Assume that any additional character elements would be 0 if one is + ## longer than the other. + maxcharlen = max ([length(v1c), length(v2c)]); + if (length (v1c) < maxcharlen) + v1c(length(v1c)+1:maxcharlen) = "\0"; + endif + if (length (v2c) < maxcharlen) + v2c(length(v2c)+1:maxcharlen) = "\0"; + endif + + ## Determine the operator. + if any (ismember (operator, "=")) + equal_op = true; + else + equal_op = false; + endif + if any (ismember (operator, "~!")) + not_op = true; + else + not_op = false; + endif + if any (ismember (operator, "<")) + lt_op = true; + else + lt_op = false; + endif + if any (ismember (operator, ">")) + gt_op = true; + else + gt_op = false; + endif + + ## Make sure that we don't have conflicting operators. + if (gt_op && lt_op) + error ("compare_versions: OPERATOR cannot contain both greater and less than symbols"); + elseif ((gt_op || lt_op) && not_op) + error ("compare_versions: OPERATOR cannot contain not and greater than or less than symbols"); + elseif (strcmp (operator, "=")) + error ("compare_versions: equality OPERATOR is \"==\", not \"=\""); + elseif (! (equal_op || not_op || lt_op || gt_op)) + error ("compare_versions: No valid OPERATOR specified"); + endif + + ## Compare the versions (making sure that they're the same shape) + vcmp = v1n(:) - v2n(:); + vcmp = [vcmp; (v1c - v2c)(:)]; + if (lt_op) + ## so that we only need to check for the output being greater than 1 + vcmp = -vcmp; + endif + firstdiff = find (vcmp != 0, 1); + + if (isempty (firstdiff)) + ## They're equal. + out = equal_op; + elseif (lt_op || gt_op) + ## They're correctly less than or greater than. + out = (vcmp(firstdiff) > 0); + else + ## They're not correctly less than or greater than, and they're not equal. + out = false; + endif + + ## Reverse the output if not is given. + if (not_op) + out = !out; + endif + +endfunction + +## tests +## test both equality symbols +## test arbitrarily long equality +%!assert(compare_versions("1.1.0.0.0", "1.1", "=="), true) +%!assert(compare_versions("1", "1.1", "<"), true) +%!assert(compare_versions("1.1", "1.1", "<="), true) +%!assert(compare_versions("1.1", "1.1.1", "<="), true) +%!assert(compare_versions("1.23", "1.24", "=<"), true) +## test different length numbers +%!assert(compare_versions("23.2000", "23.1", ">"), true) +%!assert(compare_versions("0.0.2", "0.0.1", ">="), true) +%!assert(compare_versions("0.2", "0.0.100", "=>"), true) +%!assert(compare_versions("0.1", "0.2", "!="), true) +%!assert(compare_versions("0.1", "0.2", "~="), true) + +## test alphanumeric strings +%!assert(compare_versions("1a", "1b", "<"), true) +%!assert(compare_versions("a", "1", "<"), true) +%!assert(compare_versions("1a", "1b", ">"), false) +%!assert(compare_versions("a", "1", ">"), false) +%!assert(compare_versions("1.1.0a", "1.1.0b", "=="), false) +%!assert(compare_versions("1.1.0a", "1.1.0b", "!="), true) +%!assert(compare_versions("1.1.0test", "1.1.0b", "=="), false) +%!assert(compare_versions("1.1.0test", "1.1.0test", "=="), true) + +## make sure that it won't just give true output +%!assert(compare_versions("1", "0", "=="), false) +## test arbitrarily long equality +%!assert(compare_versions("1.1.1.0.0", "1.1", "=="), false) +%!assert(compare_versions("1.1", "1", "<"), false) +%!assert(compare_versions("2", "1.1", "<="), false) +%!assert(compare_versions("1.1.1", "1.1", "<="), false) +%!assert(compare_versions("1.25", "1.24", "=<"), false) +## test different length numbers +%!assert(compare_versions("23.2", "23.100", ">"), false) +%!assert(compare_versions("0.0.0.2", "0.0.1", ">="), false) +%!assert(compare_versions("0.0.20", "0.10.2", "=>"), false) +%!assert(compare_versions("0.1", "0.1", "!="), false) +%!assert(compare_versions("0.1", "0.1", "~="), false) + +%% Test input validation +%!error(compare_versions(0.1, "0.1", "==")) +%!error(compare_versions("0.1", 0.1, "==")) +%!error(compare_versions(["0";".";"1"], "0.1", "==")) +%!error(compare_versions("0.1", ["0";".";"1"], "==")) +%!error(compare_versions("0.1", "0.1", "<>")) +%!error(compare_versions("0.1", "0.1", "!>")) +%!error(compare_versions("0.1", "0.1", "=")) +%!error(compare_versions("0.1", "0.1", "aa")) + + diff --git a/octave_packages/m/miscellaneous/computer.m b/octave_packages/m/miscellaneous/computer.m new file mode 100644 index 0000000..ba99dd5 --- /dev/null +++ b/octave_packages/m/miscellaneous/computer.m @@ -0,0 +1,91 @@ +## Copyright (C) 2004-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{c}, @var{maxsize}, @var{endian}] =} computer () +## @deftypefnx {Function File} {@var{arch} =} computer ("arch") +## Print or return a string of the form @var{cpu}-@var{vendor}-@var{os} +## that identifies the kind of computer Octave is running on. If invoked +## with an output argument, the value is returned instead of printed. For +## example: +## +## @example +## @group +## computer () +## @print{} i586-pc-linux-gnu +## +## x = computer () +## @result{} x = "i586-pc-linux-gnu" +## @end group +## @end example +## +## If two output arguments are requested, also return the maximum number +## of elements for an array. +## +## If three output arguments are requested, also return the byte order +## of the current system as a character (@code{"B"} for big-endian or +## @code{"L"} for little-endian). +## +## If the argument @code{"arch"} is specified, return a string +## indicating the architecture of the computer on which Octave is +## running. +## @end deftypefn + +function [c, maxsize, endian] = computer (a) + + if (nargin == 1 && ischar (a) && strcmpi (a, "arch")) + tmp = strsplit (octave_config_info ("canonical_host_type"), "-"); + if (numel (tmp) == 4) + c = sprintf ("%s-%s-%s", tmp{4}, tmp{3}, tmp{1}); + else + c = sprintf ("%s-%s", tmp{3}, tmp{1}); + endif + elseif (nargin == 0) + msg = octave_config_info ("canonical_host_type"); + + if (strcmp (msg, "unknown")) + msg = "Hi Dave, I'm a HAL-9000"; + endif + + if (nargout == 0) + printf ("%s\n", msg); + else + c = msg; + if (strcmp (octave_config_info ("USE_64_BIT_IDX_T"), "true")) + maxsize = 2^63-1; + else + maxsize = 2^31-1; + endif + if (octave_config_info ("words_big_endian")) + endian = "B"; + elseif (octave_config_info ("words_little_endian")) + endian = "L"; + else + endian = "?"; + endif + endif + else + print_usage (); + endif + +endfunction + +%!assert((ischar (computer ()) +%! && computer () == octave_config_info ("canonical_host_type"))); +%!assert(ischar (computer ("arch"))); +%!error computer (2); diff --git a/octave_packages/m/miscellaneous/copyfile.m b/octave_packages/m/miscellaneous/copyfile.m new file mode 100644 index 0000000..e2756ea --- /dev/null +++ b/octave_packages/m/miscellaneous/copyfile.m @@ -0,0 +1,130 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{status}, @var{msg}, @var{msgid}] =} copyfile (@var{f1}, @var{f2}) +## @deftypefnx {Function File} {[@var{status}, @var{msg}, @var{msgid}] =} copyfile (@var{f1}, @var{f2}, 'f') +## Copy the file @var{f1} to the new name @var{f2}. The name @var{f1} +## may contain globbing patterns. If @var{f1} expands to multiple file +## names, @var{f2} must be a directory. If the force flag 'f' is given then +## existing destination files will be overwritten without prompting. +## +## If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty +## character strings. Otherwise, @var{status} is 0, @var{msg} contains a +## system-dependent error message, and @var{msgid} contains a unique +## message identifier. +## @seealso{movefile} +## @end deftypefn + +function [status, msg, msgid] = copyfile (f1, f2, force) + + max_cmd_line = 1024; + status = true; + msg = ""; + msgid = ""; + + ## FIXME -- maybe use the same method as in ls to allow users control + ## over the command that is executed. + + if (ispc () && ! isunix () + && isempty (file_in_path (getenv ("PATH"), "cp.exe"))) + ## Windows. + cmd = "cmd /C xcopy /E"; + cmd_force_flag = "/Y"; + else + cmd = "cp -r"; + cmd_force_flag = "-f"; + endif + + if (nargin == 2 || nargin == 3) + ## Input type check. + if (! (ischar (f1) || iscellstr (f1))) + error ("copyfile: first argument must be a character string or a cell array of character strings"); + endif + + if (! ischar (f2)) + error ("copyfile: second argument must be a character string"); + endif + + if (nargin == 3 && strcmp (force, "f")) + cmd = cstrcat (cmd, " ", cmd_force_flag); + endif + + ## If f1 isn't a cellstr convert it to one. + if (ischar (f1)) + f1 = cellstr (f1); + endif + + ## If f1 has more than 1 element f2 must be a directory + isdir = (exist (f2, "dir") != 0); + if (length(f1) > 1 && ! isdir) + error ("copyfile: when copying multiple files, second argument must be a directory"); + endif + + ## Protect the file name(s). + f1 = glob (f1); + if (isempty (f1)) + error ("copyfile: no files to move"); + endif + p1 = sprintf ("\"%s\" ", f1{:}); + p2 = tilde_expand (f2); + + if (isdir && length(p1) > max_cmd_line) + l2 = length(p2) + length (cmd) + 6; + while (! isempty(f1)) + p1 = sprintf ("\"%s\" ", f1{1}); + f1(1) = []; + while (!isempty (f1) && (length(p1) + length(f1{1}) + l2 < + max_cmd_line)) + p1 = sprintf ("%s\"%s\" ", p1, f1{1}); + f1(1) = []; + endwhile + + if (ispc () && ! isunix () + && ! isempty (file_in_path (getenv ("PATH"), "cp.exe"))) + p1 = strrep (p1, "\\", "/"); + p2 = strrep (p2, "\\", "/"); + endif + + ## Copy the files. + [err, msg] = system (sprintf ("%s %s\"%s\"", cmd, p1, p2)); + if (err < 0) + status = false; + msgid = "copyfile"; + break; + endif + endwhile + else + if (ispc () && ! isunix () + && ! isempty (file_in_path (getenv ("PATH"), "cp.exe"))) + p1 = strrep (p1, "\\", "/"); + p2 = strrep (p2, "\\", "/"); + endif + + ## Copy the files. + [err, msg] = system (sprintf ("%s %s\"%s\"", cmd, p1, p2)); + if (err < 0) + status = false; + msgid = "copyfile"; + endif + endif + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/debug.m b/octave_packages/m/miscellaneous/debug.m new file mode 100644 index 0000000..d3c377d --- /dev/null +++ b/octave_packages/m/miscellaneous/debug.m @@ -0,0 +1,93 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} debug () +## Summary of debugging commands. For more information on each command +## and available options use @code{help CMD}. +## +## The debugging commands available in Octave are +## +## @table @code +## @item dbstop +## Add a breakpoint. +## +## @item dbclear +## Remove a breakpoint. +## +## @item dbstatus +## List all breakpoints. +## +## @item dbwhere +## Report the current file and line number where execution is stopped. +## +## @item dbtype +## List the function where execution is currently stopped, enumerating +## the line numbers. +## +## @item dbstep +## @itemx dbnext +## Execute (step) one or more lines, follow execution into (step into) a +## function call, or execute until the end of a function (step out), and +## re-enter debug mode. +## +## @item dbcont +## Continue normal code execution from the debug prompt. +## +## @item dbquit +## Quit debugging mode immediately and return to the main prompt. +## +## @item dbstack +## Print a backtrace of the execution stack. +## +## @item dbup +## Move up the execution stack. +## +## @item dbdown +## Move down the execution stack. +## +## @item keyboard +## Force entry into debug mode from an m-file. +## +## @item debug_on_error +## Configure whether Octave enters debug mode when it encounters an error. +## +## @item debug_on_warning +## Configure whether Octave enters debug mode when it encounters a warning. +## +## @item debug_on_interrupt +## Configure whether Octave enters debug mode when it encounters an interrupt. +## +## @item isdebugmode +## Return true if in debug mode. +## @end table +## +## @noindent +## When Octave encounters a breakpoint, or other reason to enter debug +## mode, the prompt changes to @code{"debug>"}. The workspace of the function +## where the breakpoint was encountered becomes available and any Octave +## command that is valid in that workspace context may be executed. +## +## @seealso{dbstop, dbclear, dbstatus, dbwhere, dbtype, dbcont, dbquit, +## dbstack, dbup, dbdown, keyboard, debug_on_error, debug_on_warning, +## debug_on_interrupt, isdebugmode} +## @end deftypefn + +function debug () + help ("debug"); +endfunction diff --git a/octave_packages/m/miscellaneous/delete.m b/octave_packages/m/miscellaneous/delete.m new file mode 100644 index 0000000..dbf0395 --- /dev/null +++ b/octave_packages/m/miscellaneous/delete.m @@ -0,0 +1,63 @@ +## Copyright (C) 2004-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} delete (@var{file}) +## @deftypefnx {Function File} {} delete (@var{handle}) +## Delete the named file or graphics handle. +## +## Deleting graphics objects is the proper way to remove +## features from a plot without clearing the entire figure. +## @seealso{clf, cla, unlink} +## @end deftypefn + +## Author: jwe + +function delete (arg) + + if (nargin != 1) + print_usage (); + endif + + if (ischar (arg)) + files = glob (arg); + if (isempty (files)) + warning ("delete: no such file: %s", arg); + endif + for i = 1:length (files) + file = files{i}; + [err, msg] = unlink (file); + if (err) + warning ("delete: %s: %s", file, msg); + endif + endfor + elseif (all (ishandle (arg(:)))) + ## Delete a graphics object. + __go_delete__ (arg); + else + error ("delete: first argument must be a filename or graphics handle"); + endif + +endfunction + + +%% Test input validation +%!error delete () +%!error delete (1, 2) +%!error delete (struct ()) + diff --git a/octave_packages/m/miscellaneous/dir.m b/octave_packages/m/miscellaneous/dir.m new file mode 100644 index 0000000..4fb83cf --- /dev/null +++ b/octave_packages/m/miscellaneous/dir.m @@ -0,0 +1,142 @@ +## Copyright (C) 2004-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dir (@var{directory}) +## @deftypefnx {Function File} {[@var{list}] =} dir (@var{directory}) +## Display file listing for directory @var{directory}. If a return +## value is requested, return a structure array with the fields +## +## @example +## @group +## name +## bytes +## date +## isdir +## statinfo +## @end group +## @end example +## +## @noindent +## where @code{statinfo} is the structure returned from @code{stat}. +## +## If @var{directory} is not a directory, return information about the +## named @var{filename}. @var{directory} may be a list of directories +## specified either by name or with wildcard characters (like * and ?) +## which will be expanded with glob. +## +## Note that for symbolic links, @code{dir} returns information about +## the file that the symbolic link points to instead of the link itself. +## However, if the link points to a nonexistent file, @code{dir} returns +## information about the link. +## @seealso{ls, stat, lstat, readdir, glob, filesep} +## @end deftypefn + +## Author: jwe + +## FIXME -- this is quite slow for large directories, so perhaps +## it should be converted to C++. + +function retval = dir (directory) + + if (nargin == 0) + directory = "."; + elseif (nargin > 1) + print_usage (); + endif + + ## Prep the retval. + info = struct (zeros (0, 1), + {"name", "date", "bytes", "isdir", "datenum", "statinfo"}); + + if (ischar (directory)) + if (strcmp (directory, "*")) + directory = "."; + endif + if (strcmp (directory, ".")) + flst = {"."}; + nf = 1; + else + flst = glob (directory); + nf = length (flst); + endif + + ## Determine the file list for the case where a single directory is + ## specified. + if (nf == 1) + fn = flst{1}; + [st, err, msg] = stat (fn); + if (err < 0) + warning ("dir: `stat (%s)' failed: %s", fn, msg); + nf = 0; + elseif (S_ISDIR (st.mode)) + flst = readdir (flst{1}); + nf = length (flst); + for i = 1:nf + flst{i} = fullfile (fn, flst{i}); + endfor + endif + endif + + if (length (flst) > 0) + ## Collect results. + for i = nf:-1:1 + fn = flst{i}; + [st, err, msg] = lstat (fn); + if (err < 0) + warning ("dir: `lstat (%s)' failed: %s", fn, msg); + else + ## If we are looking at a link that points to something, + ## return info about the target of the link, otherwise, return + ## info about the link itself. + if (S_ISLNK (st.mode)) + [xst, err, msg] = stat (fn); + if (! err) + st = xst; + endif + endif + [dummy, fn, ext] = fileparts (fn); + fn = cstrcat (fn, ext); + info(i,1).name = fn; + lt = localtime (st.mtime); + info(i,1).date = strftime ("%d-%b-%Y %T", lt); + info(i,1).bytes = st.size; + info(i,1).isdir = S_ISDIR (st.mode); + info(i,1).datenum = datenum (lt.year + 1900, lt.mon + 1, lt.mday, + lt.hour, lt.min, lt.sec); + info(i,1).statinfo = st; + endif + endfor + endif + + else + error ("dir: expecting directory or filename to be a char array"); + endif + + ## Return the output arguments. + if (nargout > 0) + ## Return the requested structure. + retval = info; + elseif (length (info) > 0) + ## Print the structure to the screen. + printf ("%s", list_in_columns ({info.name})); + else + warning ("dir: nonexistent directory `%s'", directory); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/dos.m b/octave_packages/m/miscellaneous/dos.m new file mode 100644 index 0000000..9a71e2b --- /dev/null +++ b/octave_packages/m/miscellaneous/dos.m @@ -0,0 +1,71 @@ +## Copyright (C) 2004-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dos ("@var{command}") +## @deftypefnx {Function File} {@var{status} =} dos ("@var{command}") +## @deftypefnx {Function File} {[@var{status}, @var{text}] =} dos ("@var{command"}) +## @deftypefnx {Function File} {[@dots{}] =} dos ("@var{command}", "-echo") +## Execute a system command if running under a Windows-like operating +## system, otherwise do nothing. Return the exit status of the program +## in @var{status} and any output from the command in @var{text}. +## When called with no output argument, or the "-echo" argument is +## given, then @var{text} is also sent to standard output. +## @seealso{unix, system, isunix, ispc} +## @end deftypefn + +## Author: octave-forge ??? +## Adapted by: jwe + +function [status, text] = dos (command, echo_arg) + + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (! isunix ()) + [status, text] = system (command); + if (nargin > 1 || nargout == 0) + printf ("%s\n", text); + endif + endif + +endfunction + + +%!test +%! cmd = ls_command (); +%! old_wstate = warning ("query"); +%! warning ("off", "Octave:undefined-return-values"); +%! unwind_protect +%! [status, output] = dos (cmd); +%! unwind_protect_cleanup +%! warning (old_wstate); +%! end_unwind_protect +%! +%! if (ispc () && ! isunix ()) +%! [status, output] = dos (cmd); +%! assert (status, 0); +%! assert (ischar (output)); +%! assert (! isempty (output)); +%! else +%! assert (status, []); +%! assert (output, []); +%! endif + +%!error dos () +%!error dos (1, 2, 3) + diff --git a/octave_packages/m/miscellaneous/dump_prefs.m b/octave_packages/m/miscellaneous/dump_prefs.m new file mode 100644 index 0000000..d544eae --- /dev/null +++ b/octave_packages/m/miscellaneous/dump_prefs.m @@ -0,0 +1,98 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dump_prefs () +## @deftypefnx {Function File} {} dump_prefs (@var{fid}) +## Dump all of the current user preference variables in a format that can be +## parsed by Octave later. @var{fid} is a file descriptor as returned by +## @code{fopen}. If @var{file} is omitted, the listing is printed to stdout. +## @end deftypefn + +## Author: jwe + +function dump_prefs (file) + + if (nargin == 0) + file = stdout; + endif + + ## FIXME -- it would be nice to be able to get the list of + ## built-in variables directly from Octave so that we wouldn't have to + ## remember to update it each time the list of preference variables + ## changes + + ## Note that these are no longer variables. + + sym_list = ["EDITOR"; + "EXEC_PATH"; + "IMAGE_PATH"; + "PAGER"; + "PS1"; + "PS2"; + "PS4"; + "beep_on_error"; + "completion_append_char"; + "crash_dumps_octave_core"; + "echo_executing_commands"; + "fixed_point_format"; + "gnuplot_binary"; + "gnuplot_command_end"; + "gnuplot_command_plot"; + "gnuplot_command_replot"; + "gnuplot_command_splot"; + "gnuplot_command_title"; + "gnuplot_command_using"; + "gnuplot_command_with"; + "history_file"; + "history_size"; + "ignore_function_time_stamp"; + "info_file"; + "info_program"; + "makeinfo_program"; + "max_recursion_depth"; + "output_max_field_width"; + "output_precision"; + "page_output_immediately"; + "page_screen_output"; + "print_answer_id_name"; + "print_empty_dimensions"; + "save_precision"; + "saving_history"; + "sighup_dumps_octave_core"; + "sigterm_dumps_octave_core"; + "silent_functions"; + "split_long_rows"; + "string_fill_char"; + "struct_levels_to_print"; + "suppress_verbose_help_message"]; + + for i = 1:rows(sym_list) + sym = deblank (sym_list(i,:)); + try + val = feval (sym); + if (isnumeric (val)) + val = sprintf ("%g", val); + endif + fprintf (file, " %s = %s\n", sym, val); + catch + fprintf (file, "# %s = \n", sym); + end_try_catch + endfor + +endfunction diff --git a/octave_packages/m/miscellaneous/edit.m b/octave_packages/m/miscellaneous/edit.m new file mode 100644 index 0000000..1a7c8b3 --- /dev/null +++ b/octave_packages/m/miscellaneous/edit.m @@ -0,0 +1,540 @@ +## Copyright (C) 2001-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} edit @var{name} +## @deftypefnx {Command} {} edit @var{field} @var{value} +## @deftypefnx {Command} {@var{value} =} edit get @var{field} +## Edit the named function, or change editor settings. +## +## If @code{edit} is called with the name of a file or function as +## its argument it will be opened in a text editor. +## +## @itemize @bullet +## @item +## If the function @var{name} is available in a file on your path and +## that file is modifiable, then it will be edited in place. If it +## is a system function, then it will first be copied to the directory +## @env{HOME} (see further down) and then edited. +## If no file is found, then the m-file +## variant, ending with ".m", will be considered. If still no file +## is found, then variants with a leading "@@" and then with both a +## leading "@@" and trailing ".m" will be considered. +## +## @item +## If @var{name} is the name of a function defined in the interpreter but +## not in an m-file, then an m-file will be created in @env{HOME} +## to contain that function along with its current definition. +## +## @item +## If @code{name.cc} is specified, then it will search for @code{name.cc} +## in the path and try to modify it, otherwise it will create a new +## @file{.cc} file in @env{HOME}. If @var{name} happens to be an +## m-file or interpreter defined function, then the text of that +## function will be inserted into the .cc file as a comment. +## +## @item +## If @var{name.ext} is on your path then it will be edited, otherwise +## the editor will be started with @file{HOME/name.ext} as the +## filename. If @file{name.ext} is not modifiable, it will be copied to +## @env{HOME} before editing. +## +## @strong{Warning:} You may need to clear name before the new definition +## is available. If you are editing a .cc file, you will need +## to mkoctfile @file{name.cc} before the definition will be available. +## @end itemize +## +## If @code{edit} is called with @var{field} and @var{value} variables, +## the value of the control field @var{field} will be @var{value}. +## If an output argument is requested and the first argument is @code{get} +## then @code{edit} will return the value of the control field @var{field}. +## If the control field does not exist, edit will return a structure +## containing all fields and values. Thus, @code{edit get all} returns +## a complete control structure. +## The following control fields are used: +## +## @table @samp +## @item editor +## This is the editor to use to modify the functions. By default it uses +## Octave's @env{EDITOR} built-in function, which comes from +## @code{getenv("EDITOR")} and defaults to @code{emacs}. Use @code{%s} +## In place of the function name. For example, +## @table @samp +## @item [EDITOR, " %s"] +## Use the editor which Octave uses for @code{edit_history}. +## +## @item "xedit %s &" +## pop up simple X11 editor in a separate window +## +## @item "gnudoit -q \"(find-file \\\"%s\\\")\"" +## Send it to current Emacs; must have @code{(gnuserv-start)} in @file{.emacs}. +## @end table +## +## See also field 'mode', which controls how the editor is run by Octave. +## +## On Cygwin, you will need to convert the Cygwin path to a Windows +## path if you are using a native Windows editor. For example: +## @c Set example in small font to prevent overfull line in TeX +## +## @smallexample +## @exdent '"C:/Program Files/Good Editor/Editor.exe" "$(cygpath -wa %s)"' +## @end smallexample +## +## @item home +## This is the location of user local m-files. Be be sure it is in your +## path. The default is @file{~/octave}. +## +## @item author +## This is the name to put after the "## Author:" field of new functions. +## By default it guesses from the @code{gecos} field of password database. +## +## @item email +## This is the e-mail address to list after the name in the author field. +## By default it guesses @code{<$LOGNAME@@$HOSTNAME>}, and if @code{$HOSTNAME} +## is not defined it uses @code{uname -n}. You probably want to override this. +## Be sure to use @code{} as your format. +## +## @item license +## @table @samp +## @item gpl +## GNU General Public License (default). +## +## @item bsd +## BSD-style license without advertising clause. +## +## @item pd +## Public domain. +## +## @item "text" +## Your own default copyright and license. +## @end table +## +## Unless you specify @samp{pd}, edit will prepend the copyright statement +## with "Copyright (C) yyyy Function Author". +## +## @item mode +## This value determines whether the editor should be started in async mode +## (editor is started in the background and Octave continues) or sync mode +## (Octave waits until the editor exits). Set it to "sync" to start the editor +## in sync mode. The default is "async" (see also "system"). +## +## @item editinplace +## Determines whether files should be edited in place, without regard to +## whether they are modifiable or not. The default is @code{false}. +## @end table +## @end deftypefn + +## Author: Paul Kienzle + +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +function ret = edit (file, state) + + ## Pick up globals or default them. + + persistent FUNCTION = struct ("EDITOR", cstrcat (EDITOR (), " %s"), + "HOME", fullfile (default_home, "octave"), + "AUTHOR", default_user(1), + "EMAIL", [], + "LICENSE", "GPL", + "MODE", "async", + "EDITINPLACE", false); + ## Make sure the state variables survive "clear functions". + mlock; + + if (nargin == 2) + switch (toupper (file)) + case "EDITOR" + FUNCTION.EDITOR = state; + case "HOME" + if (! isempty (state) && state(1) == "~") + state = [ default_home, state(2:end) ]; + endif + FUNCTION.HOME = state; + case "AUTHOR" + FUNCTION.AUTHOR = state; + case "EMAIL" + FUNCTION.EMAIL = state; + case "LICENSE" + FUNCTION.LICENSE = state; + case "MODE" + if (strcmp (state, "sync") || strcmp (state, "async")) + FUNCTION.MODE = state; + else + error('edit: expected "edit MODE sync|async"'); + endif + case "EDITINPLACE" + if (ischar (state)) + if (strcmpi (state, "true")) + state = true; + elseif (strcmpi (state, "false")) + state = false; + else + state = eval (state); + endif + endif + FUNCTION.EDITINPLACE = state; + case "GET" + if (isfield (FUNCTION, toupper(state))) + ret = FUNCTION.(toupper (state)); + else + ret = FUNCTION; + endif + otherwise + error ('edit: expected "edit EDITOR|HOME|AUTHOR|EMAIL|LICENSE|MODE val"'); + endswitch + return + endif + + ## Start the editor without a file if no file is given. + if (nargin < 1) + if (exist (FUNCTION.HOME, "dir") == 7 && (isunix () || ! ispc ())) + system (cstrcat ("cd \"", FUNCTION.HOME, "\" ; ", + sprintf (FUNCTION.EDITOR, "")), + [], FUNCTION.MODE); + else + system (sprintf (FUNCTION.EDITOR,""), [], FUNCTION.MODE); + endif + return; + endif + + ## Check whether the user is trying to edit a builtin of compiled function. + switch (exist (file)) + case {3, 5} + error ("edit: unable to edit a built-in or compiled function"); + endswitch + + ## Checks for whether the file is + ## absolute or relative should be handled inside file_in_loadpath. + ## That way, it will be possible to look up files correctly given + ## partial path information. For example, you should be able to + ## edit a particular overloaded function by doing any one of + ## + ## edit classname/foo + ## edit classname/foo.m + ## edit @classname/foo + ## edit @classname/foo.m + ## + ## This functionality is needed for other functions as well (at least + ## help and type; there may be more). So the place to fix that is in + ## file_in_loadpath, possibly with some help from the load_path class. + + ## The code below includes a portion that serves as a place-holder for + ## the changes suggested above. + + ## Create list of explicit and implicit file names. + filelist = {file}; + ## If file has no extension, add file.m and file.cc to the list. + idx = rindex (file, "."); + if (idx == 0) + ## Create the list of files to look for + filelist = {file}; + if (isempty (regexp (file, '\.m$'))) + ## No ".m" at the end of the file, add to the list. + filelist{end+1} = cat (2, file, ".m"); + endif + if (isempty (regexp (file, '\.cc$'))) + ## No ".cc" at the end of the file, add to the list. + filelist{end+1} = cat (2, file, ".cc"); + endif + endif + + ## If the file includes a path, it may be an overloaded function. + if (! strcmp (file, "@") && index (file, filesep)) + ## No "@" at the beginning of the file, add to the list. + numfiles = numel(filelist); + for n = 1:numfiles + filelist{n+numfiles} = cat (2, "@", filelist{n}); + endfor + endif + + ## Search the entire path for the 1st instance of a file in the list. + fileandpath = ""; + for n = 1:numel(filelist) + filetoedit = file_in_path (path, filelist{n}); + if (! isempty (filetoedit)) + ## The path is explicitly included. + fileandpath = filetoedit; + break; + endif + endfor + + if (! isempty (fileandpath)) + ## If the file exists, then edit it. + if (FUNCTION.EDITINPLACE) + ## Edit in place even if it is protected. + system (sprintf (FUNCTION.EDITOR, cstrcat ("\"", fileandpath, "\"")), + [], FUNCTION.MODE); + return; + else + ## If the file is modifiable in place then edit it, otherwise make + ## a copy in HOME and then edit it. + fid = fopen (fileandpath, "r+t"); + if (fid < 0) + from = fileandpath; + fileandpath = cstrcat (FUNCTION.HOME, from (rindex (from, filesep):end)); + [status, msg] = copyfile (from, fileandpath, 1); + if (status == 0) + error (msg); + endif + else + fclose (fid); + endif + system (sprintf (FUNCTION.EDITOR, cstrcat ("\"", fileandpath, "\"")), + [], FUNCTION.MODE); + return; + endif + endif + + ## If editing a new file that is neither a m-file or an oct-file, + ## just edit it. + fileandpath = file; + idx = rindex (file, "."); + name = file(1:idx-1); + ext = file(idx+1:end); + switch (ext) + case {"cc", "m"} + 0; + otherwise + system (sprintf (FUNCTION.EDITOR, cstrcat ("\"", fileandpath, "\"")), + [], FUNCTION.MODE); + return; + endswitch + + ## The file doesn't exist in path so create it, put in the function + ## template and edit it. + + ## Guess the email name if it was not given. + if (isempty (FUNCTION.EMAIL)) + host = getenv("HOSTNAME"); + if (isempty (host) && ispc ()) + host = getenv ("COMPUTERNAME"); + endif + if (isempty (host)) + [status, host] = system ("uname -n"); + ## trim newline from end of hostname + if (! isempty (host)) + host = host(1:end-1); + endif + endif + if (isempty (host)) + FUNCTION.EMAIL = " "; + else + FUNCTION.EMAIL = cstrcat ("<", default_user(0), "@", host, ">"); + endif + endif + + ## Fill in the revision string. + now = localtime (time); + revs = cstrcat ("Created: ", strftime ("%Y-%m-%d", now)); + + ## Fill in the copyright string. + copyright = cstrcat (strftime ("Copyright (C) %Y ", now), FUNCTION.AUTHOR); + + ## Fill in the author tag field. + author = cstrcat ("Author: ", FUNCTION.AUTHOR, " ", FUNCTION.EMAIL); + + ## Fill in the header. + uclicense = toupper (FUNCTION.LICENSE); + switch (uclicense) + case "GPL" + head = cstrcat (copyright, "\n\n", "\ +This program is free software; you can redistribute it and/or modify\n\ +it under the terms of the GNU General Public License as published by\n\ +the Free Software Foundation; either version 3 of the License, or\n\ +(at your option) any later version.\n\ +\n\ +This program is distributed in the hope that it will be useful,\n\ +but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ +GNU General Public License for more details.\n\ +\n\ +You should have received a copy of the GNU General Public License\n\ +along with Octave; see the file COPYING. If not, see\n\ +.\ +"); + tail = cstrcat (author, "\n", revs); + + case "BSD" + head = cstrcat (copyright, "\n\n", "\ +This program is free software; redistribution and use in source and\n\ +binary forms, with or without modification, are permitted provided that\n\ +the following conditions are met:\n\ +\n\ + 1.Redistributions of source code must retain the above copyright\n\ + notice, this list of conditions and the following disclaimer.\n\ + 2.Redistributions in binary form must reproduce the above copyright\n\ + notice, this list of conditions and the following disclaimer in the\n\ + documentation and/or other materials provided with the distribution.\n\ +\n\ +THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND\n\ +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE\n\ +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE\n\ +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE\n\ +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\n\ +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS\n\ +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)\n\ +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT\n\ +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY\n\ +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF\n\ +SUCH DAMAGE.\ +"); + tail = cstrcat (author, "\n", revs); + + case "PD" + head = ""; + tail = cstrcat (author, "\n", revs, "\n\n", + "This program is granted to the public domain."); + + otherwise + head = ""; + tail = cstrcat (copyright, "\n\n", FUNCTION.LICENSE, "\n", + author, "\n", revs); + endswitch + + ## Generate the function template. + exists = exist (name); + switch (ext) + case {"cc", "C", "cpp"} + if (isempty (head)) + comment = cstrcat ("/*\n", tail, "\n\n*/\n\n"); + else + comment = cstrcat ("/*\n", head, "\n\n", tail, "\n\n*/\n\n"); + endif + ## If we are shadowing an m-file, paste the code for the m-file. + if (any (exists == [2, 103])) + code = cstrcat ("\\ ", strrep (type (name), "\n", "\n// ")); + else + code = " "; + endif + body = cstrcat ("#include \n\n", + "DEFUN_DLD(", name, ",args,nargout,\"\\\n", + name, "\\n\\\n\")\n{\n", + " octave_value_list retval;\n", + " int nargin = args.length();\n\n", + code, "\n return retval;\n}\n"); + + text = cstrcat (comment, body); + case "m" + ## If we are editing a function defined on the fly, paste the + ## code. + if (any (exists == [2, 103])) + body = type (name); + else + body = cstrcat ("function [ ret ] = ", name, " ()\n\nendfunction\n"); + endif + if (isempty (head)) + comment = cstrcat ("## ", name, "\n\n", + "## ", strrep (tail, "\n", "\n## "), "\n\n"); + else + comment = cstrcat ("## ", strrep(head,"\n","\n## "), "\n\n", ... + "## ", name, "\n\n", ... + "## ", strrep (tail, "\n", "\n## "), "\n\n"); + endif + text = cstrcat (comment, body); + endswitch + + ## Write the initial file (if there is anything to write) + fid = fopen (fileandpath, "wt"); + if (fid < 0) + error ("edit: could not create %s", fileandpath); + endif + fputs (fid, text); + fclose (fid); + + ## Finally we are ready to edit it! + system (sprintf (FUNCTION.EDITOR, cstrcat ("\"", fileandpath, "\"")), + [], FUNCTION.MODE); + +endfunction + +function ret = default_home () + + ret = getenv ("HOME"); + if (isempty (ret)) + ret = glob ("~"); + if (! isempty (ret)) + ret = ret{1}; + else + ret = ""; + endif + endif + +endfunction + +## Return the name associated with the current user ID. +## +## If LONG_FORM is 1, return the full name. This will be the +## default author. Otherwise return the login name. +## login@host will be the default email address. + +function ret = default_user (long_form) + + ent = getpwuid (getuid); + if (! isstruct (ent)) + ret = getenv ("USER"); + if (isempty (ret)) + ret = getenv ("USERNAME"); + endif + elseif (long_form) + ret = ent.gecos; + pos = strfind (ret, ","); + if (! isempty (pos)) + ret = ret(1:pos-1); + endif + else + ret = ent.name; + endif + +endfunction + +%!test +%! s.editor = edit ("get", "editor"); +%! s.home = edit ("get", "home"); +%! s.author = edit ("get", "author"); +%! s.email = edit ("get", "email"); +%! s.license = edit ("get", "license"); +%! s.editinplace = edit ("get", "editinplace"); +%! s.mode = edit ("get", "mode"); +%! edit editor none +%! edit home none +%! edit author none +%! edit email none +%! edit license none +%! edit ("editinplace", !s.editinplace) +%! if (s.mode(1) == "a") +%! edit mode sync +%! else +%! edit mode async +%! endif +%! edit ("editor", s.editor); +%! edit ("home", s.home); +%! edit ("author", s.author); +%! edit ("email", s.email); +%! edit ("license", s.license); +%! edit ("editinplace", s.editinplace); +%! edit ("mode", s.mode); +%! assert (edit ("get", "editor"), s.editor); +%! assert (edit ("get", "home"), s.home); +%! assert (edit ("get", "author"), s.author); +%! assert (edit ("get", "email"), s.email); +%! assert (edit ("get", "license"), s.license); +%! assert (edit ("get", "editinplace"), s.editinplace); +%! assert (edit ("get", "mode"), s.mode); + diff --git a/octave_packages/m/miscellaneous/fact.m b/octave_packages/m/miscellaneous/fact.m new file mode 100644 index 0000000..3dfb7dc --- /dev/null +++ b/octave_packages/m/miscellaneous/fact.m @@ -0,0 +1,269 @@ +## Copyright (C) 2007-2012 Jordi Gutiérrez Hermoso +## Copyright (C) 2007 Stallmanfacts.com +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} fact +## @deftypefnx {Function File} {T =} fact() +## Display an amazing and random fact about the world's greatest hacker. +## @end deftypefn + + +function f = fact() + persistent wisdom = \ + { + "Richard Stallman takes notes in binary."; + "Richard Stallman doesn't need sudo. I will make him a sandwich anyway."; + "Richard Stallman is my shephurd, and I am his GNU."; + "Richard Stallman doesn't wget, Richard Stallman wdemands!"; + "Richard Stallman can touch MC Hammer"; + "Richard Stallman doesn't read web pages. They write to him."; + "Richard Stallman gets 9 bits to the byte."; + "Richard Stallman doesn't really believe in open software, because it's not free enough."; + "Richard Stallman can leave neutral or negative feedback on eBay."; + "Richard Stallman is the only man alive who can pronounce GNU the way it is meant to be pronounced."; + "Richard Stallman does not own a mobile phone because he can fashion a crude convex dish and shout into it at the exact resonant frequency of the ozone, causing a voice to seemingly come from the sky above his intended recipient."; + "Richard Stallman is so handsome that when he was young he was responsible for all other geeks not being able to get girls. This is why he has to cover his face with a thick layer of hair."; + "Some people check their computers for viruses. Viruses check their computers for Richard Stallman."; + "Richard Stallman memorises all his documents. In binary. He just types everything in whenever he needs a document."; + "When Richard Stallman makes a sudo command, he loses permissions."; + "Richard Stallman's beard is made of parentheses."; + "Richard Stallman's DNA is in binary."; + "Richard Stallman's nervous system is completely wireless."; + "Richard Stallman's brain accepts UNIX commands."; + "If Richard Stallman has 1GB of RAM, and if you have 1GB of RAM, Richard Stallman has more RAM than you."; + "Richard Stallman eats ethernet cables. That's why they invented wireless."; + "Richard Stallman has a katana. 'Nuff said."; + "Richard Stallman wrote a program that divides by zero."; + "Ricahrd Stallman doesn't use zip drives, he just squeezes the hard drive."; + "Richard Stallman's compiler is afraid to report errors."; + "Richard Stallman wrote the compiler God used. The Big Bang was the Universe's first segfault."; + "Richard Stallman successfully compiled a kernel of popcorn."; + "Richard Stallman doesn't write programs, they write themselves out of reverence."; + "Richard Stallman can make infinite loops end."; + "Richard Stallman's anti-virus programs cures HIV."; + "Richard Stallman's computer doesn't have a clock; it defines what time it is."; + "Richard Stallman wrote a program to compute the last digit of pi."; + "Richard Stallman doesn't use web browsers. He sends a link to a demon that uses wget to fetch the page and sends it back to him."; + "Richard Stallman can solve the halting problem... in polynomial time."; + "For Richard Stallman, polynomial time is O(1)."; + "Richard Stallman didn't \"write\" Emacs or created it in his own image. Richard Stallman made Emacs an instance of himself."; + "Richard Stallman can coerce meaningful data from /dev/null."; + "Some people wear Linus Torvalds pyjamas to bed, Linus Torvalds wears Richard Stallman pyjamas."; + "There is no software development process, only a bunch of programs Richard Stallman allows to exist. "; + "Richard Stallman spends his leisure time programming with Guile on GNU Hurd. "; + "Richard Stallman's left and right hands are named \"(\" and \")\" "; + "Richard Stallman first words were actually syscalls. "; + "Richard Stallman didn't create the singularity. He is the singularity. GNU/Linux is only the event horizon. "; + "When Richard Stallman pipes to more, he gets less "; + "Richard Stallman never showers: he runs 'make clean'. "; + "Richard Stallman needs neither mouse nor keyboard to operate his computer. He just stares it down until it does what he wants. "; + "Richard Stallman didn't write the GPL. He is the GPL. "; + "Richad Stallman's pinky finger is really a USB memory stick. "; + "Richard Stallman called his operating system GNU because he created it before computers existed, when actual gnus were used for calcuations. "; + "In Soviet Russia, Richard Stallman is still Richard Stallman! "; + "Richard Stallman's flute only plays free music. "; + "When Richard Stallman uses floats, there are no rounding errors."; + "Richard Stallman wrote a program so powerful, it knows the question to 42."; + "Richard Stallman released his own DNA under GNU FDL."; + "Richard Stallman knows the entire wikipedia by heart, markup included."; + "Richard Stallman wrote the HAL9000 OS."; + "Richard Stallman's laser pointer is a lightsaber."; + "Richard Stallman never steps down; he shifts the universe up ."; + "Richard Stallman doesn't maintain code; he stares at it until it fixes itself out of reverence."; + "Richard Stallman doesn't use an editor; he sets the fundamental constants of the universe so that a magnetic platter with his code on it evolves itself."; + "Richard Stallman doesn’t code; he dares the computer to not do his bidding."; + "Global warming is caused by Richard Stallman’s rage toward non-free software."; + "Rather than being birthed like a normal child, Richard Stallman instead instantiated himself polymorphically. Shortly thereafter he grew a beard."; + "Richard Stallman discovered extra-terrestrial life but killed them because they used non-free software."; + "Richard Stallman doesn't evaluate expressions, expressions evaluate to Richard Stallman."; + "Richard Stallman can see Russia from his house."; + "Richard Stallman proved P=NP, twice!"; + "Richard Stallman knows of an unfixed bug in TeX."; + "Richard Stallman can write a context-free grammar for C."; + "Richard Stallman can determine whether an arbitrary program will terminate."; + "Richard Stallman's computer has only two buttons. One is for guests."; + "Richard Stallman does not actually write programs. He comes up with a length and digit index in pi."; + "Richard Stallman's distributed version control system is a flamewar on Usenet."; + "Richard Stallman wrote the first version of Emacs on a typewriter."; + "Richard Stallman has no known weaknesses, except for a phobia against soap."; + "Richard Stallman is not affected by Godwin's Law."; + "Richard Stallman can write an anti-virus program that cures HIV. Too bad he never writes anti-virus programs."; + "Richard Stallman' facial hair is \"free as in beard\""; + "Richard Stallman is licensed under GPL, so you can clone him and redistribute copies so you can help your neighbor. For example a version that take a bath more often."; + "Richard Stallman doesn't code; he just travels around the world."; + "Richard Stallman was coded by himself in lisp with Emacs."; + "Richard Stallman doesn't eat McDonald's because the machine that kills the cows uses proprietary software."; + "There is no chin behind Richard Stallman's legendary beard, there is only another Emacs."; + "In an average living room there are 1,242 objects Richard Stallman could use to write an OS, including the room itself."; + "Vendor lock-in is when vendors lock themselves inside of a building out of fear of Richard Stallman's wrath."; + "When Richard Stallman executes ps -e, you show up."; + "When Richard Stallman gets angry he doesn't swear; he recurses."; + "On Richard Stallman's computer the bootloader is contained in his .emacs."; + "Richard Satallman can make any operating system free, free from drivers."; + "Richard Stallman programmed Chuck Norris."; + "Behind Richard Stallman's beard there is another fist, to code faster."; + "Richard Stallman won a Suduku that started with only one number in each line"; + "Richard Stallman's brain compiles and runs C code."; + "Richard Stallman wrote the first version of Emacs using Emacs."; + "Richard Stallman never gonna give you up, never gonna let you down, never gonna run around and desert you, never gonna make you cry, never gonna say goodbye, never gonna tell a lie and hurt you."; + "Richard Stallman, upon reading these facts, didn't laugh at all. Instead, he complained that he is being linked to that dirty \"open source\" software. He also asked it to be changed to \"free software\", in order to raise awareness for software freedom in our society."; + "Richard Stallman has no problem using Emacs. He wrote it with his 4 hands."; + "Richard Stallman will revert the big rip by adding parenthesis to the dark matter."; + "When you make a Google search and it doesn't find the answer, Google gently consults Richard Stallman."; + "Richard Stallman's uptime is over 53 years. And counting up."; + "Richard Stallman's portable music player plays ogg and WMA."; + "Richard Stallman will never die, but may some day go to /dev/null."; + "Richard Stallman once got swine flu, but it got cleansed by hereditay GPL and thus got assimilated."; + "Richard Stallman don't cut his hair because there are no GNU/Scissors"; + "Richard Stallman is the one who trims Chuck Norris beard. And he does it freely, of course."; + "Richard Stallman does not take bath, for the hydroelectric company uses proprietary software."; + "Agent Smith loves Richard Stallman's scent."; + "Richard Stallman is the One."; + "\"They can take our lives, but they can never take our freedom.\" Willian Wallace after a litle talk with Richard Stallman."; + "Richard Stallman can connect to any brain using an Emacs ssh client."; + "Richard Stallman ported Emacs to Intel 4004 chip."; + "Richard Stallman did not write GNU Emacs, he simply read the source code from /dev/null."; + "Richard Stallman once used GDB to reverse-engineer Windows 7 into a free operating system - able to run on GNU Emacs!"; + "Richard Stallman does not contribute to open source projects; open source projects contribute to Richard Stallman, and then call themselves free software projects."; + "Richard Stallman programmed himself before he could even exist"; + "Richard Stallman can fill up /dev/null."; + "Richard Stallman is so zealous about privacy he has /dev/null as his home."; + "When Richard Stallman runs /bin/false, it returns \"true\"."; + "Richard Stallman doesn't like money, because banks don't run on free software."; + "Richard Stallman user GNU tar to compress air."; + "Richard Stallman was installed in the world, it runs on a free program .."; + "When Richard Stallman reports a bug, the bug prefers to squash itself instead of facing Richard Stallman's wrath."; + "There is no Windows in Richard Stallman's house... only Doors..."; + "Richard Stallman doesn't like neither PCs-Intel nor Burger King... He prefers e-Macs..."; + "Richard Stallman can use grep to find Jimmy Hoffa."; + "Richard Stallman made it possible to not absolutely abhor HPUX."; + "When Richard Stallman pours his alphabets cereal into a bowl, only G's, N's, and U's come out."; + "Richard Stallman is pronounced \"GNU slash Stallman\""; + "Richard Stallman doesn't mind if you read his mail as long as you don't delete it before he reads it."; + "Richard Stallman is just a guy who has strong principles and decided to follow them."; + "Richard Stallman knows that you don't have class because it is a keyword that he defined."; + "Richard Stallman doesn't need a qwerty/dvorak keyboard only two buttons \"1\" and \"0\" and his erect penis."; + "On the first day Richard Stallman said M-x create-light."; + "Richard Stallman once went out of scope for a while. The garbage collector never dared to touch him."; + "Richard Stallman does not compile; he closes his eyes, and see energy lines created between bit blocks by the compiler optimizations..."; + "intx80 first calls Richard Stallman before calling sys_call"; + "Tron is actually a biographical story about Richard Stallman. The director decided to tone it down or audiences wouldn't find it believable."; + "Richard Stallman always wears a red shirt to make sure that whatever attacks his away-team has to go through him first."; + "kill -9 invokes Richard Stallman's rage against a process."; + "If Richard were to stumble upon stallmanfacts.com, he would find it a gnuisance."; + "Richard Stallman can telnet into Mordor."; + "sudo chown Richard:Stallman /all/your/base"; + "Richard Stallman's nervous system is completely wireless."; + "Richard Stallman does not sleep. He yields."; + "Some people say M-x psychoanalyse-pinhead is a merely a program. Others say M-x psychoanalyse-pinhead *is* Richard Stallman. All I know is, Richard Stallman is The Stig."; + "If you execute Emacs backward it either undoes the industrial revolution or induces the rapture. But only Richard Stallman knows which."; + "If Richard Stallman's beard were ever trimmed, the clippings would re-marshal into an exact copy of Richard Stallman."; + "Richard Stallman never sleeps because he altered his own source to gain background garbage collection."; + "Richard Stallman's doctor can retrieve a blood sample via CVS."; + "Richard Stallman can touch this"; + "Because Richard Stallman's DNA is licensed under the FDL, his doctor can't draw his blood without violating HIPAA."; + "Richard Stallman can remove his own appendix, using only gdb."; + "Richard Stallman's DNA includes debugging symbols. But he doesn't need them."; + "Richard Stallman met Chuck Norris once. Chuck tried a roundhouse, but Richard bashed him in the skull."; + "Richard Stallman doesn't need to buy a bigger hard drive. He can compress data infinitely. "; + "When Richard Stallman cannot take your call, his beard answers the phone for you."; + "The R in RMS stands for RMS."; + "Richard Stallman can parse HTML with regular expressions."; + "Richard Stallman's traceroute goes all the way through an infinite number of anonymous proxies back to the traffic's source."; + "Richard Stallman's beard is in fact not a just a beard, but a microprinted hard copy of Emacs source code. New patches must be checked against new hair growth before being approved."; + "In the beginning-of-buffer there was Richard Stallman."; + "The NOOP was created to give Richard Stallman some time to comb his beard."; + "Whenever Richard Stallman looks at a Windows computer, it segfaults. Whenever Richard Stallman doesn't look at a Windows computer, it segfaults."; + "Richard Stallman can walk on Windows!"; + "After being unable to satisfy my wife for years, Richard Stallman was able to single-handedly unlock her orgasm within seconds and managed to write a texinfo manual minutes later for other users."; + "Richard Stallman's tabbed browser is a set to wget/telnet fg/bg processes."; + "There is no chin under Richard Stallman' beard. There's only another beard. Recursively."; + "Stallman can chown anything! stallman@stallman~$ chown stallman:stallman Earth (for example)"; + "Richard Stallman freed his beard so he can always check what's in it."; + "In the beginning was the Word, and the Word was with RMS, and the Word was GNU."; + "RMS means \"RMS means Stallman\""; + "Richard Stallman is the babelfish of his own speeches."; + "Richard Stallman wrote his own library and lives in it."; + "Richard Stallman found Waldo using grep in /dev/null"; + "Richard Stallman doesn't sleep; he is compiling"; + "Richard Stallman will get Coca Cola to release their recipe under the GPL."; + "Richard Stallman doesn't change clothes. He makes case mods."; + "Richard Stallman compiled the first version of gcc with an hexadecimal editor."; + "Richard Stallman will be the last guest on Linux Outlaws"; + "Richard Stallman calculates the universe's entropy by exploiting forced stack overflows."; + "Richard Stallman's consciousness will one day become the singularity, which will create Deep Thought, and answer the meaning of life, the universe and everything."; + "C is actually written in RMS."; + "Richard Stallman can write software that does not have a buffer overflow when counting money lost by Jerome Kerviel."; + "There were no double rainbows before Richard Stallman."; + "Chuck Norris had to shorten his beard in the presence of Stallman because two beards that awsome, so close would segfault the universe (again)."; + "RMS is Titanic."; + "Richard Stallman is the answer to the Turing Test."; + "Richard Stallman's beard makes ads for Gillette and Braun appear."; + "for i = 1 to Stallman will never stop."; + "\"RMS\" stands for \"RMS Makes Software\""; + "Whenever someone writes a \"Hello, world\" program, Richard Stallman says \"Hello\" back."; + "Richard Stallman wasn't born. He was compiled from source."; + "Richard Stallman has a URL tatooed on the left side of his chest where you can download his genetic code."; + "The GNU command line idiom that Richard Stallman never needs: \"date | more\""; + "Richard Stallman's toe cheese is aged to perfection."; + "Richard Stallman doesn't always run an OS kernel, but when he does he prefers GNU/Hurd. He is... the most interesting hacker in the world. Stay free, my friends."; + "When Richard Stallman gets hungry, he just picks debris from his foot and eats it."; + "Richard Stallman can GPL your code just by looking at it funny."; + "Richard Mathew Stallman loves birds. Birds make auricular love to Richard Mathew Stallman."; + "Richard Stallman is so free that the primitive recursive function for computing his liberty causes a stack overflow."; + "GNU Hurd is taking more than twenty years to develop because Richard Stallman is using a programming language comprised entirely of different lengths of time."; + "Richard Stallman's beard contains Richard Stallman, whose beard contains Richard Stallman...."; + "Richard Stallman had a Google Plus account in 2010."; + "sudo chown rms:gnu ~/base -R"; + "Richard Stallman pipes the Emacs binaries to /dev/dsp before he goes to sleep."; + "When Richard Stallman counted his fingers as a kid, he always started with 0."; + "When Richard Stallman's computer gets a virus, he simply applies a GPL license to it which converts the whole botnet to Linux. I mean, GNU/Linux."; + "Richard Stallman's beard trimmings can cure cancer. Too bad he never shaves."; + "Richard Stallman's doesn't kill a process, he just dares it to stay running."; + "Richard Stallman exists because he compiled himself into being. "; + "Richard Stallman's first words were in binary. When they couldn't understand him, he wrote a parser."; + "Richard Stallman doesn't need any codecs, he just opens a multimedia file with Emacs, and reads the bytes of the file as plain text. He then performs all the necessary decoding in his mind. But he refuses to decode files encrypted with DRM, although his mind is able to."; + }; + + w = wisdom{randi([1, numel(wisdom)])}; + if nargout > 0 + f = w; + else + w = wordwrap (w); + printf ("%s", w); + endif +endfunction + +function out = wordwrap (w) + cols = terminal_size ()(2); + wc = strsplit (w, " "); + out = "\n"; + i = 1; + numwords = numel (wc); + while i <= numwords; + line = wc{i}; + while (i < numwords && length (newline = cstrcat (line, " ", wc{i+1})) < cols) + line = newline; + i++; + endwhile + out = cstrcat (out, line, "\n"); + i++; + endwhile + out = cstrcat(out, "\n"); +endfunction \ No newline at end of file diff --git a/octave_packages/m/miscellaneous/fileattrib.m b/octave_packages/m/miscellaneous/fileattrib.m new file mode 100644 index 0000000..418c424 --- /dev/null +++ b/octave_packages/m/miscellaneous/fileattrib.m @@ -0,0 +1,144 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{status}, @var{result}, @var{msgid}] =} fileattrib (@var{file}) +## Return information about @var{file}. +## +## If successful, @var{status} is 1, with @var{result} containing a +## structure with the following fields: +## +## @table @code +## @item Name +## Full name of @var{file}. +## +## @item archive +## True if @var{file} is an archive (Windows). +## +## @item system +## True if @var{file} is a system file (Windows). +## +## @item hidden +## True if @var{file} is a hidden file (Windows). +## +## @item directory +## True if @var{file} is a directory. +## +## @item UserRead +## @itemx GroupRead +## @itemx OtherRead +## True if the user (group; other users) has read permission for +## @var{file}. +## +## @item UserWrite +## @itemx GroupWrite +## @itemx OtherWrite +## True if the user (group; other users) has write permission for +## @var{file}. +## +## @item UserExecute +## @itemx GroupExecute +## @itemx OtherExecute +## True if the user (group; other users) has execute permission for +## @var{file}. +## @end table +## If an attribute does not apply (i.e., archive on a Unix system) then +## the field is set to NaN. +## +## With no input arguments, return information about the current +## directory. +## +## If @var{file} contains globbing characters, return information about +## all the matching files. +## @seealso{glob} +## @end deftypefn + +function [status, msg, msgid] = fileattrib (file) + + status = true; + msg = ""; + msgid = ""; + + if (nargin == 0) + file = "."; + endif + + if (ischar (file)) + files = glob (file); + if (isempty (files)) + files = {file}; + nfiles = 1; + else + nfiles = length (files); + endif + else + error ("fileattrib: expecting first argument to be a character string"); + endif + + if (nargin == 0 || nargin == 1) + + r_n = r_a = r_s = r_h = r_d ... + = r_u_r = r_u_w = r_u_x ... + = r_g_r = r_g_w = r_g_x ... + = r_o_r = r_o_w = r_o_x = cell (nfiles, 1); + + curr_dir = pwd (); + + for i = 1:nfiles + [info, err, msg] = stat (files{i}); + if (! err) + r_n{i} = canonicalize_file_name (files{i}); + r_a{i} = NaN; + r_s{i} = NaN; + r_h{i} = NaN; + r_d{i} = S_ISDIR (info.mode); + ## FIXME -- maybe we should have S_IRUSR etc. masks? + modestr = info.modestr; + r_u_r{i} = modestr(2) == "r"; + r_u_w{i} = modestr(3) == "w"; + r_u_x{i} = modestr(4) == "x"; + r_g_r{i} = modestr(5) == "r"; + r_g_w{i} = modestr(6) == "w"; + r_g_x{i} = modestr(7) == "x"; + r_o_r{i} = modestr(8) == "r"; + r_o_w{i} = modestr(9) == "w"; + r_o_x{i} = modestr(10) == "x"; + else + status = false; + msgid = "fileattrib"; + break; + endif + endfor + if (status) + r = struct ("Name", r_n, "archive", r_a, "system", r_s, + "hidden", r_s, "directory", r_d, "UserRead", r_u_r, + "UserWrite", r_u_w, "UserExecute", r_u_x, + "GroupRead", r_g_r, "GroupWrite", r_g_w, + "GroupExecute", r_g_x, "OtherRead", r_o_r, + "OtherWrite", r_o_w, "OtherExecute", r_o_x); + if (nargout == 0) + status = r; + else + msg = r; + endif + endif + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/fileparts.m b/octave_packages/m/miscellaneous/fileparts.m new file mode 100644 index 0000000..cc33edb --- /dev/null +++ b/octave_packages/m/miscellaneous/fileparts.m @@ -0,0 +1,96 @@ +## Copyright (C) 2003-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{dir}, @var{name}, @var{ext}, @var{ver}] =} fileparts (@var{filename}) +## Return the directory, name, extension, and version components of +## @var{filename}. +## @seealso{fullfile} +## @end deftypefn + +function [directory, name, extension, version] = fileparts (filename) + + if (nargin == 1) + if (ischar (filename)) + ds = strchr (filename, filesep ("all"), 1, "last"); + if (isempty (ds)) + ds = 0; + endif + es = rindex (filename, "."); + ## These can be the same if they are both 0 (no dir or ext). + if (es <= ds) + es = length(filename)+1; + endif + if (ds == 0) + directory = ""; + elseif (ds == 1) + directory = filename(1); + else + directory = filename(1:ds-1); + endif + name = filename(ds+1:es-1); + if (es > 0 && es <= length (filename)) + extension = filename(es:end); + else + extension = ""; + endif + version = ""; + else + error ("fileparts: expecting FILENAME argument to be a string"); + endif + else + print_usage (); + endif + +endfunction + +%!test +%! [d, n, e] = fileparts ("file"); +%! assert (strcmp (d, "") && strcmp (n, "file") && strcmp (e, "")); + +%!test +%! [d, n, e] = fileparts ("file.ext"); +%! assert (strcmp (d, "") && strcmp (n, "file") && strcmp (e, ".ext")); + +%!test +%! [d, n, e] = fileparts ("/file.ext"); +%! assert (strcmp (d, "/") && strcmp (n, "file") && strcmp (e, ".ext")); + +%!test +%! [d, n, e] = fileparts ("dir/file.ext"); +%! assert (strcmp (d, "dir") && strcmp (n, "file") && strcmp (e, ".ext")); + +%!test +%! [d, n, e] = fileparts ("./file.ext"); +%! assert (strcmp (d, ".") && strcmp (n, "file") && strcmp (e, ".ext")); + +%!test +%! [d, n, e] = fileparts ("d1/d2/file.ext"); +%! assert (strcmp (d, "d1/d2") && strcmp (n, "file") && strcmp (e, ".ext")); + +%!test +%! [d, n, e] = fileparts ("/d1/d2/file.ext"); +%! assert (strcmp (d, "/d1/d2") && strcmp (n, "file") && strcmp (e, ".ext")); + +%!test +%! [d, n, e] = fileparts ("/.ext"); +%! assert (strcmp (d, "/") && strcmp (n, char (zeros (1, 0))) && strcmp (e, ".ext")); + +%!test +%! [d, n, e] = fileparts (".ext"); +%! assert (strcmp (d, "") && strcmp (n, char (zeros (1, 0))) && strcmp (e, ".ext")); diff --git a/octave_packages/m/miscellaneous/fullfile.m b/octave_packages/m/miscellaneous/fullfile.m new file mode 100644 index 0000000..4977805 --- /dev/null +++ b/octave_packages/m/miscellaneous/fullfile.m @@ -0,0 +1,80 @@ +## Copyright (C) 2003-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{filename} =} fullfile (@var{dir1}, @var{dir2}, @dots{}, @var{file}) +## Return a complete filename constructed from the given components. +## @seealso{fileparts} +## @end deftypefn + +function filename = fullfile (varargin) + + if (nargin > 0) + ## Discard all empty arguments + varargin(cellfun ("isempty", varargin)) = []; + nargs = numel (varargin); + if (nargs > 1) + filename = varargin{1}; + if (strcmp (filename(end), filesep)) + filename(end) = ""; + endif + for i = 2:nargs + tmp = varargin{i}; + if (i < nargs && strcmp (tmp(end), filesep)) + tmp(end) = ""; + elseif (i == nargs && strcmp (tmp, filesep)) + tmp = ""; + endif + filename = cstrcat (filename, filesep, tmp); + endfor + elseif (nargs == 1) + filename = varargin{1}; + else + filename = ""; + endif + else + print_usage (); + endif + +endfunction + +%!shared fs, fsx, xfs, fsxfs, xfsy +%! fs = filesep (); +%! fsx = cstrcat (fs, "x"); +%! xfs = cstrcat ("x", fs); +%! fsxfs = cstrcat (fs, "x", fs); +%! xfsy = cstrcat ("x", fs, "y"); +%!assert (fullfile (""), "") +%!assert (fullfile (fs), fs) +%!assert (fullfile ("", fs), fs) +%!assert (fullfile (fs, ""), fs) +%!assert (fullfile ("", fs), fs) +%!assert (fullfile ("x"), "x") +%!assert (fullfile ("", "x"), "x") +%!assert (fullfile ("x", ""), "x") +%!assert (fullfile ("", "x", ""), "x") +%!assert (fullfile ("x", "y"), xfsy) +%!assert (fullfile ("x", "", "y"), xfsy) +%!assert (fullfile ("x", "", "y", ""), xfsy) +%!assert (fullfile ("", "x", "", "y", ""), xfsy) +%!assert (fullfile (fs), fs) +%!assert (fullfile (fs, fs), fs) +%!assert (fullfile (fs, "x"), fsx) +%!assert (fullfile (fs, xfs), fsxfs) +%!assert (fullfile (fsx, fs), fsxfs) +%!assert (fullfile (fs, "x", fs), fsxfs) diff --git a/octave_packages/m/miscellaneous/getappdata.m b/octave_packages/m/miscellaneous/getappdata.m new file mode 100644 index 0000000..60ae41e --- /dev/null +++ b/octave_packages/m/miscellaneous/getappdata.m @@ -0,0 +1,59 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## 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 Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{value} =} getappdata (@var{h}, @var{name}) +## Return the @var{value} for named application data for the object(s) with +## handle(s) @var{h}. +## @deftypefnx {Function File} {@var{appdata} =} getappdata (@var{h}) +## Return a structure, @var{appdata}, whose fields correspond to the appdata +## properties. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-07-15 + +function val = getappdata (h, name) + + if (all (ishandle (h)) && nargin == 2 && ischar (name)) + ## FIXME - Is there a better way to handle non-existent appdata + ## and missing fields? + val = cell (numel (h), 1); + appdata = struct(); + for nh = 1:numel(h) + try + appdata = get (h(nh), "__appdata__"); + end_try_catch + if (! isfield (appdata, name)) + appdata.(name) = []; + endif + val(nh) = {appdata.(name)}; + endfor + if (nh == 1) + val = val{1}; + endif + elseif (ishandle (h) && numel (h) == 1 && nargin == 1) + try + val = get (h, "__appdata__"); + catch + val = struct (); + end_try_catch + else + error ("getappdata: invalid input"); + endif + +endfunction + diff --git a/octave_packages/m/miscellaneous/getfield.m b/octave_packages/m/miscellaneous/getfield.m new file mode 100644 index 0000000..b1ea9e8 --- /dev/null +++ b/octave_packages/m/miscellaneous/getfield.m @@ -0,0 +1,68 @@ +## Copyright (C) 2000-2012 Etienne Grossmann +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{v1}, @dots{}] =} getfield (@var{s}, @var{key}, @dots{}) +## Extract a field from a structure (or a nested structure). For example: +## +## @example +## @group +## ss(1,2).fd(3).b = 5; +## getfield (ss, @{1,2@}, "fd", @{3@}, "b") +## @result{} 5 +## @end group +## @end example +## +## Note that the function call in the previous example is equivalent to +## the expression +## +## @example +## @group +## i1 = @{1,2@}; i2 = "fd"; i3 = @{3@}; i4= "b"; +## ss(i1@{:@}).(i2)(i3@{:@}).(i4) +## @result{} 5 +## +## @end group +## @end example +## @seealso{setfield, rmfield, isfield, isstruct, fieldnames, struct} +## @end deftypefn + +## Author: Etienne Grossmann + +function obj = getfield (s, varargin) + if (nargin < 2) + print_usage (); + endif + subs = varargin; + flds = cellfun ("isclass", subs, "char"); + idxs = cellfun ("isclass", subs, "cell"); + if (all (flds | idxs)) + typs = merge (flds, {"."}, {"()"}); + obj = subsref (s, struct ("type", typs, "subs", subs)); + else + error ("getfield: invalid index"); + endif +endfunction + +%!test +%! x.a = "hello"; +%! assert(getfield(x,"a"),"hello"); +%!test +%! ss(1,2).fd(3).b = 5; +%! assert(getfield(ss,{1,2},'fd',{3},'b'),5) diff --git a/octave_packages/m/miscellaneous/gunzip.m b/octave_packages/m/miscellaneous/gunzip.m new file mode 100644 index 0000000..ff88d79 --- /dev/null +++ b/octave_packages/m/miscellaneous/gunzip.m @@ -0,0 +1,43 @@ +## Copyright (C) 2006-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gunzip (@var{gzfile}, @var{dir}) +## Unpack the gzip archive @var{gzfile} to the directory @var{dir}. If +## @var{dir} is not specified, it defaults to the current directory. If +## @var{gzfile} is a directory, all gzfiles in the directory will be +## recursively gunzipped. +## @seealso{gzip, unpack, bunzip2, unzip, untar} +## @end deftypefn + +## Author: Bill Denney + +function varargout = gunzip (gzfile, dir = ".") + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (nargout > 0) + varargout = cell (1, nargout); + [varargout{:}] = unpack (gzfile, dir, mfilename ()); + else + unpack (gzfile, dir, mfilename ()); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/gzip.m b/octave_packages/m/miscellaneous/gzip.m new file mode 100644 index 0000000..12f2205 --- /dev/null +++ b/octave_packages/m/miscellaneous/gzip.m @@ -0,0 +1,72 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{entries} =} gzip (@var{files}) +## @deftypefnx {Function File} {@var{entries} =} gzip (@var{files}, @var{outdir}) +## Compress the list of files and/or directories specified in @var{files}. +## Each file is compressed separately and a new file with a '.gz' extension +## is created. The original files are not modified. Existing compressed +## files are silently overwritten. If @var{outdir} is defined the compressed +## files are placed in this directory. +## @seealso{gunzip, bzip2, zip, tar} +## @end deftypefn + +function entries = gzip (varargin) + if (nargin != 1 && nargin != 2) || (nargout > 1) + print_usage (); + endif + + if (nargout == 0) + __xzip__ ("gzip", "gz", "gzip -r %s", varargin{:}); + else + entries = __xzip__ ("gzip", "gz", "gzip -r %s", varargin{:}); + endif + +endfunction + +%!error gzip("1", "2", "3"); +%!error gzip(); +%!error gzip("1", tmpnam); +%!error gzip(1); +%!xtest +%! # test gzip together with gunzip +%! unwind_protect +%! filename = tmpnam; +%! dummy = 1; +%! save(filename, "dummy"); +%! dirname = tmpnam; +%! mkdir(dirname); +%! entry = gzip(filename, dirname); +%! [path, basename, extension] = fileparts(filename); +%! if ! strcmp(entry, [dirname, filesep, basename, extension, ".gz"]) +%! error("gzipped file does not match expected name!"); +%! endif +%! if ! exist(entry, "file") +%! error("gzipped file cannot be found!"); +%! endif +%! gunzip(entry); +%! if (system(sprintf("diff %s %s%c%s%s", filename, dirname, filesep, +%! basename, extension))) +%! error("unzipped file not equal to original file!"); +%! end +%! unwind_protect_cleanup +%! delete(filename); +%! delete([dirname, filesep, basename, extension]); +%! rmdir(dirname); +%! end_unwind_protect diff --git a/octave_packages/m/miscellaneous/info.m b/octave_packages/m/miscellaneous/info.m new file mode 100644 index 0000000..b2b816d --- /dev/null +++ b/octave_packages/m/miscellaneous/info.m @@ -0,0 +1,48 @@ +## Copyright (C) 2008-2012 Julian Schnidder +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} info () +## Display contact information for the GNU Octave community. +## @end deftypefn + +function info () + + printf ("\n\ + Additional information about GNU Octave is available at\n\ + http://www.octave.org\n\ +\n\ + Descriptions of mailing lists devoted to Octave are available at\n\ + http://www.octave.org/archive.html\n\ +\n\ + You may also find some information in the Octave Wiki at\n\ + http://wiki.octave.org\n\ +\n\ + Additional functionality can be enabled by using packages from\n\ + the Octave Forge project, which may be found at\n\ + http://octave.sourceforge.net\n\ +\n\ + Report bugs to the bug tracker at\n\ + http://bugs.octave.org\n\ + But first, please read the guidelines to writing a helpful report at\n\ + http://www.octave.org/bugs.html\n"); + +endfunction + +## Mark file as being tested. No real test needed for this function. +%! assert (1) diff --git a/octave_packages/m/miscellaneous/inputname.m b/octave_packages/m/miscellaneous/inputname.m new file mode 100644 index 0000000..7d9770b --- /dev/null +++ b/octave_packages/m/miscellaneous/inputname.m @@ -0,0 +1,56 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} inputname (@var{n}) +## Return the name of the @var{n}-th argument to the calling function. +## If the argument is not a simple variable name, return an empty string. +## @end deftypefn + +function s = inputname (n) + + if (nargin == 1) + s = evalin ("caller", sprintf ("__varval__ (\".argn.\"){%d};", n)); + ## For compatibility with Matlab, return empty string if argument + ## name is not a valid identifier. + if (! isvarname (s)) + s = ""; + endif + else + print_usage (); + endif + +endfunction + +## Warning: heap big magic in the following tests!!! +## The test function builds a private context for each +## test, with only the specified values shared between +## them. It does this using the following template: +## +## function [] = testfn() +## +## +## To test inputname, I need a function context invoked +## with known parameter names. So define a couple of +## shared parameters, et voila!, the test is trivial. +%!shared hello,worldly +%!assert(inputname(1),'hello'); +%!assert(inputname(2),'worldly'); diff --git a/octave_packages/m/miscellaneous/isappdata.m b/octave_packages/m/miscellaneous/isappdata.m new file mode 100644 index 0000000..529858a --- /dev/null +++ b/octave_packages/m/miscellaneous/isappdata.m @@ -0,0 +1,48 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## 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 Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{V} =} isappdata (@var{h}, @var{name}) +## Return true if the named application data, @var{name}, exists for the +## object with handle @var{h}. +## @seealso{getappdata, setappdata, rmappdata} +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-07-15 + +function res = isappdata (h, name) + + if (! (all (ishandle (h)) && ischar (name))) + error ("isappdata: invalid input"); + endif + + for nh = 1:numel(h) + data = get (h(nh)); + if (isfield (data, "__appdata__") && isfield (data.__appdata__, name)) + res(nh) = true; + else + res(nh) = false; + endif + endfor + +endfunction + +%!test +%! setappdata (0, "hello", "world") +%! assert (isappdata (0, "hello"), true) +%!assert (isappdata (0, "foobar"), false) + diff --git a/octave_packages/m/miscellaneous/isdeployed.m b/octave_packages/m/miscellaneous/isdeployed.m new file mode 100644 index 0000000..3f67043 --- /dev/null +++ b/octave_packages/m/miscellaneous/isdeployed.m @@ -0,0 +1,31 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isdeployed () +## Return true if the current program has been compiled and is running +## separately from the Octave interpreter and false if it is running in +## the Octave interpreter. Currently, this function always returns +## false in Octave. +## @end deftypefn + +function retval = isdeployed () + retval = false; +endfunction + +%!assert (isdeployed (), false) diff --git a/octave_packages/m/miscellaneous/ismac.m b/octave_packages/m/miscellaneous/ismac.m new file mode 100644 index 0000000..f6c983b --- /dev/null +++ b/octave_packages/m/miscellaneous/ismac.m @@ -0,0 +1,36 @@ +## Copyright (C) 2007-2012 Thomas Treichl +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ismac () +## Return true if Octave is running on a Mac OS X system and false otherwise. +## @seealso{isunix, ispc} +## @end deftypefn + +function retval = ismac () + + if (nargin == 0) + retval = octave_config_info ("mac"); + else + print_usage (); + endif + +endfunction + +%!error ismac (1); +%!assert (islogical (ismac ())); diff --git a/octave_packages/m/miscellaneous/ispc.m b/octave_packages/m/miscellaneous/ispc.m new file mode 100644 index 0000000..ea976fa --- /dev/null +++ b/octave_packages/m/miscellaneous/ispc.m @@ -0,0 +1,36 @@ +## Copyright (C) 2004-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ispc () +## Return true if Octave is running on a Windows system and false otherwise. +## @seealso{isunix, ismac} +## @end deftypefn + +function retval = ispc () + + if (nargin == 0) + retval = octave_config_info ("windows"); + else + print_usage (); + endif + +endfunction + +%!error ispc (1); +%!assert (islogical (ispc ())); diff --git a/octave_packages/m/miscellaneous/isunix.m b/octave_packages/m/miscellaneous/isunix.m new file mode 100644 index 0000000..f19c3f2 --- /dev/null +++ b/octave_packages/m/miscellaneous/isunix.m @@ -0,0 +1,36 @@ +## Copyright (C) 2004-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isunix () +## Return true if Octave is running on a Unix-like system and false otherwise. +## @seealso{ismac, ispc} +## @end deftypefn + +function retval = isunix () + + if (nargin == 0) + retval = octave_config_info ("unix"); + else + print_usage (); + endif + +endfunction + +%!error isunix (1); +%!assert (islogical (isunix ())); diff --git a/octave_packages/m/miscellaneous/license.m b/octave_packages/m/miscellaneous/license.m new file mode 100644 index 0000000..a18c929 --- /dev/null +++ b/octave_packages/m/miscellaneous/license.m @@ -0,0 +1,187 @@ +## Copyright (C) 2005-2012 William Poetra Yoga Hadisoeseno +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} license +## Display the license of Octave. +## +## @deftypefnx {Function File} {} license ("inuse") +## Display a list of packages currently being used. +## +## @deftypefnx {Function File} {@var{retval} =} license ("inuse") +## Return a structure containing the fields @code{feature} and @code{user}. +## +## @deftypefnx {Function File} {@var{retval} =} license ("test", @var{feature}) +## Return 1 if a license exists for the product identified by the string +## @var{feature} and 0 otherwise. The argument @var{feature} is case +## insensitive and only the first 27 characters are checked. +## +## @deftypefnx {Function File} {} license ("test", @var{feature}, @var{toggle}) +## Enable or disable license testing for @var{feature}, depending on +## @var{toggle}, which may be one of: +## +## @table @asis +## @item "enable" +## Future tests for the specified license of @var{feature} are conducted +## as usual. +## +## @item "disable" +## Future tests for the specified license of @var{feature} return 0. +## @end table +## +## @deftypefnx {Function File} {@var{retval} =} license ("checkout", @var{feature}) +## Check out a license for @var{feature}, returning 1 on success and 0 +## on failure. +## +## This function is provided for compatibility with @sc{matlab}. +## @seealso{ver, version} +## @end deftypefn + +## Author: William Poetra Yoga Hadisoeseno + +function retval = license (varargin) + + persistent __octave_licenses__; + + if (isempty (__octave_licenses__)) + __octave_licenses__ = cell (); + __octave_licenses__{1,1} = "Octave"; + __octave_licenses__{1,2} = "GNU General Public License"; + __octave_licenses__{1,3} = true; + if (exist ("OCTAVE_FORGE_VERSION")) + __octave_licenses__{2,1} = "octave-forge"; + __octave_licenses__{2,2} = ""; + __octave_licenses__{2,3} = true; + endif + endif + + nout = nargout; + nin = nargin; + nr_licenses = rows (__octave_licenses__); + + if (nout > 1 || nin > 3) + print_usage (); + endif + + if (nin == 0) + + found = find (strcmp (__octave_licenses__(:,1), "Octave"), 1); + + if (! isempty (found)) + result = __octave_licenses__{found,2}; + else + result = "unknown"; + endif + + if (nout == 0) + printf ("%s\n", result); + else + retval = result; + endif + + elseif (nin == 1) + + if (nout == 0) + + if (! strcmp (varargin{1}, "inuse")) + usage ('license ("inuse")'); + endif + + printf ("%s\n", __octave_licenses__{:,1}); + + else + + if (! strcmp (varargin{1}, "inuse")) + usage ('retval = license ("inuse")'); + endif + + pw = getpwuid (getuid ()); + if (isstruct (pw)) + username = pw.name; + else + username = "octave_user"; + endif + + retval = struct ("feature", __octave_licenses__(:,1), "user", username); + + endif + + else + + feature = varargin{2}(1:(min ([(length (varargin{2})), 27]))); + + if (strcmp (varargin{1}, "test")) + + found = find (strcmpi (__octave_licenses__(:,1), feature), 1); + + if (nin == 2) + retval = ! isempty (found) && __octave_licenses__{found,3}; + else + if (! isempty (found)) + if (strcmp (varargin{3}, "enable")) + __octave_licenses__{found,3} = true; + elseif (strcmp (varargin{3}, "disable")) + __octave_licenses__{found,3} = false; + else + error ("license: TOGGLE must be either `enable' or `disable'"); + endif + else + error ("license: FEATURE `%s' not found", feature); + endif + endif + + elseif (strcmp (varargin{1}, "checkout")) + + if (nin != 2) + usage ('retval = license ("checkout", feature)'); + endif + + found = find (strcmpi (__octave_licenses__(:,1), feature), 1); + + retval = ! isempty (found) && __octave_licenses__{found,3}; + + else + print_usage (); + endif + + endif + +endfunction + + +%!assert (license(), "GNU General Public License") +%!assert ((license ("inuse")).feature, "Octave") + +%!test +%! lstate = license ("test", "Octave"); +%! license ("test", "Octave", "disable"); +%! assert (license ("test", "Octave"), false); +%! license ("test", "Octave", "enable"); +%! assert (license ("test", "Octave"), true); +%! if (lstate == false) +%! license ("test", "Octave", "disable"); +%! endif + +%!assert (license ("checkout", "Octave"), true) + +%% Test input validation +%!error license ("not_inuse") +%!error license ("test", "Octave", "not_enable") +%!error license ("test", "INVALID", "enable") +%!error license ("not_test", "Octave", "enable") + diff --git a/octave_packages/m/miscellaneous/list_primes.m b/octave_packages/m/miscellaneous/list_primes.m new file mode 100644 index 0000000..58a87a0 --- /dev/null +++ b/octave_packages/m/miscellaneous/list_primes.m @@ -0,0 +1,91 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} list_primes () +## @deftypefnx {Function File} {} list_primes (@var{n}) +## List the first @var{n} primes. If @var{n} is unspecified, the first +## 25 primes are listed. +## +## The algorithm used is from page 218 of the @TeX{}book. +## @seealso{primes, isprime} +## @end deftypefn + +## Author: jwe + +function retval = list_primes (n) + + if (nargin > 0) + if (! isscalar (n)) + error ("list_primes: argument must be a scalar"); + endif + endif + + if (nargin == 0) + n = 25; + endif + + if (n == 1) + retval = 2; + return; + endif + + if (n == 2) + retval = [2; 3]; + return; + endif + + retval = zeros (1, n); + retval (1) = 2; + retval (2) = 3; + + n = n - 2; + i = 3; + p = 5; + while (n > 0) + + is_prime = 1; + is_unknown = 1; + d = 3; + while (is_unknown) + a = fix (p / d); + if (a <= d) + is_unknown = 0; + endif + if (a * d == p) + is_prime = 0; + is_unknown = 0; + endif + d = d + 2; + endwhile + + if (is_prime) + retval (i++) = p; + n--; + endif + p = p + 2; + + endwhile + +endfunction + +%!test +%! assert (list_primes(), [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41,\ +%! 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97]); +%! assert (list_primes(5), [2, 3, 5, 7, 11]); + diff --git a/octave_packages/m/miscellaneous/ls.m b/octave_packages/m/miscellaneous/ls.m new file mode 100644 index 0000000..fc86a6d --- /dev/null +++ b/octave_packages/m/miscellaneous/ls.m @@ -0,0 +1,94 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} ls options +## List directory contents. For example: +## +## @example +## @group +## ls -l +## @print{} total 12 +## @print{} -rw-r--r-- 1 jwe users 4488 Aug 19 04:02 foo.m +## @print{} -rw-r--r-- 1 jwe users 1315 Aug 17 23:14 bar.m +## @end group +## @end example +## +## The @code{dir} and @code{ls} commands are implemented by calling your +## system's directory listing command, so the available options may vary +## from system to system. +## @seealso{dir, stat, readdir, glob, filesep, ls_command} +## @end deftypefn + +## Author: jwe + +function retval = ls (varargin) + + global __ls_command__; + + if (isempty (__ls_command__) || ! ischar (__ls_command__)) + ## Initialize value for __ls_command__. + ls_command (); + endif + + if (! iscellstr (varargin)) + error ("ls: all arguments must be character strings"); + endif + + if (nargin > 0) + args = tilde_expand (varargin); + if (ispc () && ! isunix ()) + ## shell (cmd.exe) on MinGW uses '^' as escape character + args = regexprep (args, '([^\w.*? -])', '^$1'); + else + args = regexprep (args, '([^\w.*? -])', '\$1'); + endif + args = sprintf ("%s ", args{:}); + else + args = ""; + endif + + cmd = sprintf ("%s %s", __ls_command__, args); + + if (page_screen_output () || nargout > 0) + [status, output] = system (cmd); + + if (status != 0) + error ("ls: command exited abnormally with status %d\n", status); + elseif (nargout == 0) + puts (output); + else + retval = strvcat (regexp (output, '\S+', 'match'){:}); + endif + else + ## Just let the output flow if the pager is off. That way the + ## output from things like "ls -R /" will show up immediately and + ## we won't have to buffer all the output. + system (cmd); + endif + +endfunction + + +%!test +%! list = ls (); +%! assert (ischar (list)); +%! assert (! isempty (list)); + +%!error ls (1); + diff --git a/octave_packages/m/miscellaneous/ls_command.m b/octave_packages/m/miscellaneous/ls_command.m new file mode 100644 index 0000000..799334b --- /dev/null +++ b/octave_packages/m/miscellaneous/ls_command.m @@ -0,0 +1,67 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{val} =} ls_command () +## @deftypefnx {Function File} {@var{old_val} =} ls_command (@var{new_val}) +## Query or set the shell command used by Octave's @code{ls} command. +## @seealso{ls} +## @end deftypefn + +## Author: jwe + +function old_cmd = ls_command (cmd) + + global __ls_command__; + + if (isempty (__ls_command__)) + ## MinGW uses different ls_command + if (ispc () && ! isunix () + && isempty (file_in_path (getenv ("PATH"), "ls"))) + __ls_command__ = "dir /D"; + else + __ls_command__ = "ls -C"; + endif + endif + + if (nargin == 0 || nargin == 1) + + old_cmd = __ls_command__; + + if (nargin == 1) + if (ischar (cmd)) + __ls_command__ = cmd; + else + error ("ls_command: expecting argument to be a character string"); + endif + endif + + endif + +endfunction + + +%!test +%! cmd = ls_command (); +%! assert (ischar (cmd)); +%! if (ispc () && ! isunix ()) +%! assert (cmd(1:3), "dir"); +%! else +%! assert (cmd(1:2), "ls"); +%! endif + diff --git a/octave_packages/m/miscellaneous/menu.m b/octave_packages/m/miscellaneous/menu.m new file mode 100644 index 0000000..f927aa4 --- /dev/null +++ b/octave_packages/m/miscellaneous/menu.m @@ -0,0 +1,70 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} menu (@var{title}, @var{opt1}, @dots{}) +## Print a title string followed by a series of options. Each option will +## be printed along with a number. The return value is the number of the +## option selected by the user. This function is useful for interactive +## programs. There is no limit to the number of options that may be passed +## in, but it may be confusing to present more than will fit easily on one +## screen. +## @seealso{disp, printf, input} +## @end deftypefn + +## Author: jwe + +function num = menu (title, varargin) + + if (nargin < 2) + print_usage (); + endif + + ## Force pending output to appear before the menu. + + fflush (stdout); + + ## Don't send the menu through the pager since doing that can cause + ## major confusion. + + page_screen_output (0, "local"); + + if (! isempty (title)) + disp (title); + printf ("\n"); + endif + + nopt = nargin - 1; + + while (1) + for i = 1:nopt + printf (" [%2d] ", i); + disp (varargin{i}); + endfor + printf ("\n"); + s = input ("pick a number, any number: ", "s"); + num = sscanf (s, "%d"); + if (! isscalar (num) || num < 1 || num > nopt) + printf ("\nerror: input invalid or out of range\n\n"); + else + break; + endif + endwhile + +endfunction + diff --git a/octave_packages/m/miscellaneous/mex.m b/octave_packages/m/miscellaneous/mex.m new file mode 100644 index 0000000..ebd4b74 --- /dev/null +++ b/octave_packages/m/miscellaneous/mex.m @@ -0,0 +1,29 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mex [options] file @dots{} +## Compile source code written in C, C++, or Fortran, to a MEX file. +## This is equivalent to @code{mkoctfile --mex [options] file}. +## @seealso{mkoctfile} +## @end deftypefn + +function mex (varargin) + args = {"--mex", varargin{:}}; + mkoctfile (args{:}); +endfunction diff --git a/octave_packages/m/miscellaneous/mexext.m b/octave_packages/m/miscellaneous/mexext.m new file mode 100644 index 0000000..9371a14 --- /dev/null +++ b/octave_packages/m/miscellaneous/mexext.m @@ -0,0 +1,29 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mexext () +## Return the filename extension used for MEX files. +## @seealso{mex} +## @end deftypefn + +function retval = mexext () + retval = "mex"; +endfunction + +%!assert (mexext (), "mex") diff --git a/octave_packages/m/miscellaneous/mkoctfile.m b/octave_packages/m/miscellaneous/mkoctfile.m new file mode 100644 index 0000000..ff2600a --- /dev/null +++ b/octave_packages/m/miscellaneous/mkoctfile.m @@ -0,0 +1,169 @@ +## Copyright (C) 2006-2012 Keith Goodman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} mkoctfile [-options] file @dots{} +## @deftypefnx {Function File} {[@var{output}, @var{status} =} mkoctfile (@dots{}) +## +## The @code{mkoctfile} function compiles source code written in C, +## C++, or Fortran. Depending on the options used with @code{mkoctfile}, the +## compiled code can be called within Octave or can be used as a stand-alone +## application. +## +## @code{mkoctfile} can be called from the shell prompt or from the Octave +## prompt. Calling it from the Octave prompt simply delegates the +## call to the shell prompt. The output is stored in the @var{output} +## variable and the exit status in the @var{status} variable. +## +## @code{mkoctfile} accepts the following options, all of which are optional +## except for the file name of the code you wish to compile: +## +## @table @samp +## @item -I DIR +## Add the include directory DIR to compile commands. +## +## @item -D DEF +## Add the definition DEF to the compiler call. +## +## @item -l LIB +## Add the library LIB to the link command. +## +## @item -L DIR +## Add the library directory DIR to the link command. +## +## @item -M +## @itemx --depend +## Generate dependency files (.d) for C and C++ source files. +## +## @item -R DIR +## Add the run-time path to the link command. +## +## @item -Wl,@dots{} +## Pass flags though the linker like "-Wl,-rpath=@dots{}". +## The quotes are needed since commas are interpreted as command +## separators. +## +## @item -W@dots{} +## Pass flags though the compiler like "-Wa,OPTION". +## +## @item -c +## Compile but do not link. +## +## @item -g +## Enable debugging options for compilers. +## +## @item -o FILE +## @itemx --output FILE +## Output file name. Default extension is .oct +## (or .mex if @samp{--mex} is specified) unless linking +## a stand-alone executable. +## +## @item -p VAR +## @itemx --print VAR +## Print the configuration variable VAR@. Recognized variables are: +## +## @example +## ALL_CFLAGS FFTW3F_LIBS +## ALL_CXXFLAGS FLIBS +## ALL_FFLAGS FPICFLAG +## ALL_LDFLAGS INCFLAGS +## BLAS_LIBS LAPACK_LIBS +## CC LDFLAGS +## CFLAGS LD_CXX +## CPICFLAG LD_STATIC_FLAG +## CPPFLAGS LFLAGS +## CXX LIBCRUFT +## CXXFLAGS LIBOCTAVE +## CXXPICFLAG LIBOCTINTERP +## DEPEND_EXTRA_SED_PATTERN LIBS +## DEPEND_FLAGS OCTAVE_LIBS +## DL_LD OCTAVE_LINK_DEPS +## DL_LDFLAGS OCT_LINK_DEPS +## EXEEXT RDYNAMIC_FLAG +## F77 READLINE_LIBS +## F77_INTEGER_8_FLAG SED +## FFLAGS XTRA_CFLAGS +## FFTW3_LDFLAGS XTRA_CXXFLAGS +## FFTW3_LIBS +## FFTW3F_LDFLAGS +## +## @end example +## +## @item --link-stand-alone +## Link a stand-alone executable file. +## +## @item --mex +## Assume we are creating a MEX file. Set the default output extension +## to ".mex". +## +## @item -s +## @itemx --strip +## Strip the output file. +## +## @item -v +## @itemx --verbose +## Echo commands as they are executed. +## +## @item file +## The file to compile or link. Recognized file types are +## +## @example +## @group +## .c C source +## .cc C++ source +## .C C++ source +## .cpp C++ source +## .f Fortran source (fixed form) +## .F Fortran source (fixed form) +## .f90 Fortran source (free form) +## .F90 Fortran source (free form) +## .o object file +## .a library file +## @end group +## @end example +## +## @end table +## @end deftypefn + +function [output, status] = mkoctfile (varargin) + + bindir = octave_config_info ("bindir"); + + shell_script = fullfile (bindir, "mkoctfile"); + + cmd = cstrcat ("\"", shell_script, "\""); + for i = 1:nargin + cmd = cstrcat (cmd, " \"", varargin{i}, "\""); + endfor + + [sys, out] = system (cmd); + + if (nargout > 0) + [output, status] = deal (out, sys); + else + printf ("%s", out); + endif + + if (sys == 127) + warning ("unable to find mkoctfile in expected location: `%s'", + shell_script); + + warning ("mkoctfile exited with failure status"); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/movefile.m b/octave_packages/m/miscellaneous/movefile.m new file mode 100644 index 0000000..40ecfca --- /dev/null +++ b/octave_packages/m/miscellaneous/movefile.m @@ -0,0 +1,128 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{status}, @var{msg}, @var{msgid}] =} movefile (@var{f1}, @var{f2}) +## @deftypefnx {Function File} {[@var{status}, @var{msg}, @var{msgid}] =} movefile (@var{f1}, @var{f2}, 'f') +## Move the file @var{f1} to the new name @var{f2}. The name @var{f1} +## may contain globbing patterns. If @var{f1} expands to multiple file +## names, @var{f2} must be a directory. If the force flag 'f' is given +## then any existing files will be overwritten without prompting. +## +## If successful, @var{status} is 1, with @var{msg} and @var{msgid} empty +## character strings. Otherwise, @var{status} is 0, @var{msg} contains a +## system-dependent error message, and @var{msgid} contains a unique +## message identifier. +## @seealso{rename, copyfile} +## @end deftypefn + +function [status, msg, msgid] = movefile (f1, f2, force) + + max_cmd_line = 1024; + status = true; + msg = ""; + msgid = ""; + + ## FIXME -- maybe use the same method as in ls to allow users control + ## over the command that is executed. + + if (ispc () && ! isunix () + && isempty (file_in_path (getenv ("PATH"), "mv.exe"))) + ## Windows. + cmd = "cmd /C move"; + cmd_force_flag = "/Y"; + else + cmd = "mv"; + cmd_force_flag = "-f"; + endif + + if (nargin == 2 || nargin == 3) + ## Input type check. + if (! (ischar (f1) || iscellstr (f1))) + error ("movefile: first argument must be a character string or a cell array of character strings"); + endif + + if (! ischar (f2)) + error ("movefile: second argument must be a character string"); + endif + + if (nargin == 3 && strcmp (force, "f")) + cmd = cstrcat (cmd, " ", cmd_force_flag); + endif + + ## If f1 isn't a cellstr convert it to one. + if (ischar (f1)) + f1 = cellstr (f1); + endif + + ## If f1 has more than 1 element f2 must be a directory + isdir = (exist (f2, "dir") != 0); + if (length(f1) > 1 && ! isdir) + error ("movefile: when moving multiple files, second argument must be a directory"); + endif + + ## Protect the file name(s). + f1 = glob (f1); + if (isempty (f1)) + error ("movefile: no files to move"); + endif + p1 = sprintf ("\"%s\" ", f1{:}); + p2 = tilde_expand (f2); + + if (isdir && length(p1) > max_cmd_line) + l2 = length(p2) + length (cmd) + 6; + while (! isempty(f1)) + p1 = sprintf ("\"%s\" ", f1{1}); + f1(1) = []; + while (!isempty (f1) && (length(p1) + length(f1{1}) + l2 < + max_cmd_line)) + p1 = sprintf ("%s\"%s\" ", p1, f1{1}); + f1(1) = []; + endwhile + + if (ispc () && ! isunix () + && ! isempty (file_in_path (getenv ("PATH"), "cp.exe"))) + p1 = strrep (p1, "\\", "/"); + p2 = strrep (p2, "\\", "/"); + endif + + ## Move the file(s). + [err, msg] = system (sprintf ("%s %s \"%s\"", cmd, p1, p2)); + if (err < 0) + status = false; + msgid = "movefile"; + endif + endwhile + else + if (ispc () && ! isunix () + && ! isempty (file_in_path (getenv ("PATH"), "cp.exe"))) + p1 = strrep (p1, "\\", "/"); + p2 = strrep (p2, "\\", "/"); + endif + + ## Move the file(s). + [err, msg] = system (sprintf ("%s %s \"%s\"", cmd, p1, p2)); + if (err < 0) + status = false; + msgid = "movefile"; + endif + endif + else + print_usage (); + endif +endfunction diff --git a/octave_packages/m/miscellaneous/namelengthmax.m b/octave_packages/m/miscellaneous/namelengthmax.m new file mode 100644 index 0000000..da9123b --- /dev/null +++ b/octave_packages/m/miscellaneous/namelengthmax.m @@ -0,0 +1,34 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} namelengthmax () +## Return the @sc{matlab} compatible maximum variable name length. Octave is +## capable of storing strings up to @math{2^{31} - 1} in length. +## However for @sc{matlab} compatibility all variable, function, +## and structure field names should be shorter than the length supplied by +## @code{namelengthmax}. In particular variables stored to a @sc{matlab} file +## format will have their names truncated to this length. +## @end deftypefn + +function n = namelengthmax () + n = 63; +endfunction + + +%!assert (namelengthmax, 63) diff --git a/octave_packages/m/miscellaneous/news.m b/octave_packages/m/miscellaneous/news.m new file mode 100644 index 0000000..ec2320a --- /dev/null +++ b/octave_packages/m/miscellaneous/news.m @@ -0,0 +1,63 @@ +## Copyright (C) 2007-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} news (@var{package}) +## Display the current NEWS file for Octave or installed package. +## +## If @var{package} is the name of an installed package, display the current +## NEWS file for that package. +## @end deftypefn + +function news (package = "octave") + + if (ischar (package) && strcmpi (package, "octave")) + octetcdir = octave_config_info ("octetcdir"); + newsfile = fullfile (octetcdir, "NEWS"); + + elseif (nargin == 1 && ischar (package)) + installed = pkg ("list"); + names = cellfun (@(x) x.name, installed, "UniformOutput", false); + ## we are nice and let the user use any case on the package name + pos = strcmpi (names, package); + if (!any (pos)) + error ("Package '%s' is not installed.", package); + endif + newsfile = fullfile (installed{pos}.dir, "packinfo", "NEWS"); + + else + print_usage; + endif + + if (exist (newsfile, "file")) + f = fopen (newsfile, "r"); + while (ischar (line = fgets (f))) + puts (line); + endwhile + else + if (strcmpi (package, "octave")) + error ("news: unable to locate NEWS file"); + else + error ("news: unable to locate NEWS file of %s package", package); + endif + endif + +endfunction + +## Remove from test statistics. No real tests possible +%!assert (1) diff --git a/octave_packages/m/miscellaneous/orderfields.m b/octave_packages/m/miscellaneous/orderfields.m new file mode 100644 index 0000000..4ea8f95 --- /dev/null +++ b/octave_packages/m/miscellaneous/orderfields.m @@ -0,0 +1,195 @@ +## Copyright (C) 2006-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{t}, @var{p}] =} orderfields (@var{s1}) +## @deftypefnx {Function File} {[@var{t}, @var{p}] =} orderfields (@var{s1}, @var{s2}) +## Return a copy of @var{s1} with fields arranged alphabetically or +## as specified by @var{s2}. +## +## Given one struct, arrange field names in @var{s1} alphabetically. +## +## If the second argument is a struct, arrange field names in @var{s1} +## as they appear in @var{s2}. The second argument may also specify the +## order in a permutation vector or a cell array of strings containing +## the fieldnames of @var{s1} in the desired order. +## +## The optional second output argument @var{p} is assigned the permutation +## vector +## which converts the original name order into the new name order. +## +## Examples: +## +## @example +## @group +## s = struct("d", 4, "b", 2, "a", 1, "c", 3); +## t1 = orderfields (s) +## @result{} t1 = +## @{ +## a = 1 +## b = 2 +## c = 3 +## d = 4 +## @} +## @end group +## @group +## t = struct("d", @{@}, "c", @{@}, "b", "a", @{@}); +## t2 = orderfields (s, t) +## @result{} t2 = +## @{ +## d = 4 +## c = 3 +## b = 2 +## a = 1 +## @} +## @end group +## @group +## t3 = orderfields (s, [3, 2, 4, 1]); +## @result{} t3 = +## @{ +## a = 1 +## b = 2 +## c = 3 +## d = 4 +## @} +## @end group +## @group +## [t4, p] = orderfields (s, @{"d", "c", "b", "a"@}) +## @result{} t4 = +## @{ +## d = 4 +## c = 3 +## b = 2 +## a = 1 +## @} +## p = +## 1 +## 4 +## 2 +## 3 +## @end group +## @end example +## +## @seealso{getfield, rmfield, isfield, isstruct, fieldnames, struct} +## @end deftypefn + +## Author: Paul Kienzle +## Adapted-By: jwe + +function [t, p] = orderfields (s1, s2) + + if (nargin == 1 || nargin == 2) + if (! isstruct (s1)) + error ("orderfields: expecting argument to be a struct"); + endif + else + print_usage (); + endif + + if (nargin == 1) + ## One structure: return the fields in alphabetical order. + if (isstruct (s1)) + names = sort (fieldnames (s1)); + endif + elseif (nargin == 2) + if (isstruct (s2)) + ## Two structures: return the fields in the order of s2. + names = fieldnames (s2); + if (! isequal (sort (fieldnames (s1)), sort (names))) + error ("orderfields: structures do not have same fields"); + endif + elseif (iscellstr (s2)) + ## A structure and a list of fields: order by the list of fields. + t1 = sort (fieldnames (s1)); + t2 = sort (s2(:)); + if (! isequal (t1, t2)) + error ("orderfields: name list does not match structure fields"); + endif + names = s2; + elseif (isvector (s2)) + ## A structure and a permutation vector: permute the order of s1. + names = fieldnames (s1); + t1 = sort (s2); + t1 = t1(:)'; + t2 = 1:numel (names); + if (! isequal (t1, t2)) + error ("orderfields: invalid permutation vector"); + endif + names = names (s2); + endif + endif + + ## Find permutation vector which converts the original name order + ## into the new name order. Note: could save a couple of sorts + ## in some cases, but performance isn't critical. + + if (nargout == 2) + [oldel, oldidx] = sort (fieldnames (s1)); + [newel, newidx] = sort (names); + p = oldidx(newidx); + endif + + ## Permute the names in the structure. + if (numel (s1) == 0) + args = cell (1, 2 * numel (names)); + args(1:2:end) = names; + args(2:2:end) = {[]}; + t = struct (args{:}); + else + n = numel (s1); + for i = 1:numel (names) + el = names(i); + [t(1:n).(el)] = s1(:).(el); + endfor + ## inherit dimensions + t = reshape (t, size (s1)); + endif + +endfunction + +%!shared a, b, c +%! a = struct ("foo", {1, 2}, "bar", {3, 4}); +%! b = struct ("bar", 6, "foo", 5); +%! c = struct ("bar", {7, 8}, "foo", 9); +%!test +%! a(2) = orderfields (b, a); +%! assert (a(2).foo, 5) +%! assert (a(2).bar, 6) +%!test +%! [a(2), p] = orderfields (b, [2 1]); +%! assert (a(2).foo, 5) +%! assert (a(2).bar, 6) +%! assert (p, [2; 1]); +%!test +%! a(2) = orderfields (b, fieldnames (a)); +%! assert (a(2).foo, 5) +%! assert (a(2).bar, 6) +%!test +%! a(1:2) = orderfields (c, fieldnames (a)); +%! assert (a(2).foo, 9) +%! assert (a(2).bar, 8) + +%!test +%! aa.x = {1, 2}; +%! aa.y = 3; +%! aa(2).x = {4, 5}; +%! bb.y = {6, 7}; +%! bb.x = 8; +%! aa(2) = orderfields (bb, aa); +%! assert (aa(2).x, 8); +%! assert (aa(2).y{1}, 6); diff --git a/octave_packages/m/miscellaneous/pack.m b/octave_packages/m/miscellaneous/pack.m new file mode 100644 index 0000000..dd9c82a --- /dev/null +++ b/octave_packages/m/miscellaneous/pack.m @@ -0,0 +1,29 @@ +## Copyright (C) 1999-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pack () +## Consolidate workspace memory in @sc{matlab}. This function is provided for +## compatibility, but does nothing in Octave. +## @end deftypefn + +## Author: jwe + +function pack () + +endfunction diff --git a/octave_packages/m/miscellaneous/paren.m b/octave_packages/m/miscellaneous/paren.m new file mode 100644 index 0000000..85adfc2 --- /dev/null +++ b/octave_packages/m/miscellaneous/paren.m @@ -0,0 +1,27 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Operator} {} ( +## @deftypefnx {Operator} {} ) +## Array index or function argument delimeter. +## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) + diff --git a/octave_packages/m/miscellaneous/parseparams.m b/octave_packages/m/miscellaneous/parseparams.m new file mode 100644 index 0000000..e438c04 --- /dev/null +++ b/octave_packages/m/miscellaneous/parseparams.m @@ -0,0 +1,107 @@ +## Copyright (C) 2006-2012 Alexander Barth +## Copyright (C) 2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{reg}, @var{prop}] =} parseparams (@var{params}) +## @deftypefnx {Function File} {[@var{reg}, @var{var1}, @dots{}] =} parseparams (@var{params}, @var{name1}, @var{default1}, @dots{}) +## Return in @var{reg} the cell elements of @var{param} up to the first +## string element and in @var{prop} all remaining elements beginning +## with the first string element. For example: +## +## @example +## @group +## [reg, prop] = parseparams (@{1, 2, "linewidth", 10@}) +## reg = +## @{ +## [1,1] = 1 +## [1,2] = 2 +## @} +## prop = +## @{ +## [1,1] = linewidth +## [1,2] = 10 +## @} +## @end group +## @end example +## +## The parseparams function may be used to separate 'regular' +## arguments and additional arguments given as property/value pairs of +## the @var{varargin} cell array. +## +## In the second form of the call, available options are specified directly +## with their default values given as name-value pairs. +## If @var{params} do not form name-value pairs, or if an option occurs +## that does not match any of the available options, an error occurs. +## When called from an m-file function, the error is prefixed with the +## name of the caller function. +## The matching of options is case-insensitive. +## +## @seealso{varargin} +## @end deftypefn + +## Author: Alexander Barth +## Author: Aida Alvera Azcarate + +function [reg, varargout] = parseparams (params, varargin) + + strs = cellfun ("isclass", params, "char"); + i = find (strs, 1); + if (i) + reg = params(1:i-1); + prop = params(i:end); + else + reg = params; + prop = {}; + endif + + if (nargin == 1) + varargout = {prop}; + else + names = varargin(1:2:end); + defaults = varargin(2:2:end); + if (! size_equal (names, defaults)) + error ("parseparams: needs odd number of arguments"); + endif + [names, sidx] = sort (names); + + varargout = defaults; + if (i) + ## Let's parse the properties. + pnames = prop(1:2:end); + values = prop(2:2:end); + if (! size_equal (pnames, values) || ! all (strs(i:2:end))) + error_as_caller ("options must be given as name-value pairs"); + endif + idx = lookup (toupper(names), toupper(pnames), "m"); + if (! all (idx)) + error_as_caller ("unrecognized option: %s", pnames{find (idx == 0, 1)}); + else + varargout(sidx(idx)) = values; + endif + endif + endif + +endfunction + +function error_as_caller (msg, varargin) + stack = dbstack (1); # omit me + fname = stack(min (2, end)).name; + error ([fname, ": ", msg], varargin{:}); +endfunction + diff --git a/octave_packages/m/miscellaneous/perl.m b/octave_packages/m/miscellaneous/perl.m new file mode 100644 index 0000000..4be4df6 --- /dev/null +++ b/octave_packages/m/miscellaneous/perl.m @@ -0,0 +1,44 @@ +## Copyright (C) 2008-2012 Julian Schnidder +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{output}, @var{status}] =} perl (@var{scriptfile}) +## @deftypefnx {Function File} {[@var{output}, @var{status}] =} perl (@var{scriptfile}, @var{argument1}, @var{argument2}, @dots{}) +## Invoke Perl script @var{scriptfile} with possibly a list of +## command line arguments. +## Returns output in @var{output} and status +## in @var{status}. +## @seealso{system} +## @end deftypefn + +function [output, status] = perl (scriptfile = "-e ''", varargin) + + ## VARARGIN is intialized to {}(1x0) if no additional arguments are + ## supplied, so there is no need to check for it, or provide an + ## initial value in the argument list of the function definition. + + if (ischar (scriptfile) + && ((nargin != 1 && iscellstr (varargin)) + || (nargin == 1 && ! isempty (scriptfile)))) + [status, output] = system (cstrcat ("perl ", scriptfile, + sprintf (" %s", varargin{:}))); + else + error ("perl: invalid arguments"); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/private/__xzip__.m b/octave_packages/m/miscellaneous/private/__xzip__.m new file mode 100644 index 0000000..c2e1fc6 --- /dev/null +++ b/octave_packages/m/miscellaneous/private/__xzip__.m @@ -0,0 +1,138 @@ +## Copyright (C) 2008-2012 Thorsten Meyer +## based on the original gzip function by David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{entries} =} __xzip__ (@var{commandname}, @var{extension}, @var{commandtemplate}, @var{files}, @var{outdir}) +## Undocumented internal function. +## @end deftypefn + +## Compress the list of files and/or directories specified in @var{files} +## with the external compression command @var{commandname}. The template +## @var{commandtemplate} is used to actually start the command. Each file +## is compressed separately and a new file with the extension @var{extension} +## is created and placed into the directory @var{outdir}. The original files +## are not touched. Existing compressed files are silently overwritten. +## This is an internal function. Do not use directly. + +function entries = __xzip__ (commandname, extension, + commandtemplate, files, outdir) + + if (nargin != 4 && nargin != 5) + print_usage (); + endif + + if (! ischar (extension) || length (extension) == 0) + error ("__xzip__: EXTENSION must be a string with finite length"); + endif + + if (nargin == 5 && ! exist (outdir, "dir")) + error ("__xzip__: OUTDIR output directory does not exist"); + endif + + if (ischar (files)) + files = cellstr (files); + endif + if (! iscellstr (files)) + error ("__xzip__: FILES must be a character array or cellstr"); + endif + + if (nargin == 4) + outdir = tmpnam (); + mkdir (outdir); + endif + + cwd = pwd (); + unwind_protect + files = glob (files); + + ## Ignore any file with the compress extension + files(cellfun (@(x) length(x) > length(extension) + && strcmp (x((end - length(extension) + 1):end), extension), + files)) = []; + + copyfile (files, outdir); + + [d, f] = myfileparts(files); + + cd (outdir); + + cmd = sprintf (commandtemplate, sprintf (" %s", f{:})); + + [status, output] = system (cmd); + if (status) + error ("__xzip__: %s command failed with exit status = %d", + commandname, status); + endif + + if (nargin == 5) + if (nargout > 0) + entries = cellfun( + @(x) fullfile (outdir, sprintf ("%s.%s", x, extension)), + f, "uniformoutput", false); + endif + else + movefile (cellfun(@(x) sprintf ("%s.%s", x, extension), f, + "uniformoutput", false), cwd); + if (nargout > 0) + ## FIXME this does not work when you try to compress directories + entries = cellfun(@(x) sprintf ("%s.%s", x, extension), + files, "uniformoutput", false); + endif + endif + + unwind_protect_cleanup + cd (cwd); + if (nargin == 4) + confirm_recursive_rmdir (false, "local"); + rmdir (outdir, "s"); + endif + end_unwind_protect + +endfunction + +function [d, f] = myfileparts (files) + [d, f, ext] = cellfun ("fileparts", files, "uniformoutput", false); + f = cellfun (@(x, y) sprintf ("%s%s", x, y), f, ext, + "uniformoutput", false); + idx = cellfun ("isdir", files); + d(idx) = ""; + f(idx) = files(idx); +endfunction + +## FIXME -- reinstate these tests if we invent a way to test private +## functions directly. +## +## %!error +## %! __xzip__("gzip", "", "gzip -r %s", "bla"); +## %!error +## %! __xzip__("gzip", ".gz", "gzip -r %s", tmpnam); +## %!error +## %! # test __xzip__ with invalid compression command +## %! unwind_protect +## %! filename = tmpnam; +## %! dummy = 1; +## %! save(filename, "dummy"); +## %! dirname = tmpnam; +## %! mkdir(dirname); +## %! entry = __xzip__("gzip", ".gz", "xxxzipxxx -r %s 2>/dev/null", +## %! filename, dirname); +## %! unwind_protect_cleanup +## %! delete(filename); +## %! rmdir(dirname); +## %! end_unwind_protect diff --git a/octave_packages/m/miscellaneous/python.m b/octave_packages/m/miscellaneous/python.m new file mode 100644 index 0000000..8d3978a --- /dev/null +++ b/octave_packages/m/miscellaneous/python.m @@ -0,0 +1,47 @@ +## Copyright (C) 2008-2012 Julian Schnidder +## Copyright (C) 2012 Carnë Draug +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{output}, @var{status}] =} python (@var{scriptfile}) +## @deftypefnx {Function File} {[@var{output}, @var{status}] =} python (@var{scriptfile}, @var{argument1}, @var{argument2}, @dots{}) +## Invoke python script @var{scriptfile} with possibly a list of +## command line arguments. +## Returns output in @var{output} and status +## in @var{status}. +## @seealso{system} +## @end deftypefn + +## Author: Carnë Draug + +function [output, status] = python (scriptfile = "-c ''", varargin) + + ## VARARGIN is intialized to {}(1x0) if no additional arguments are + ## supplied, so there is no need to check for it, or provide an + ## initial value in the argument list of the function definition. + + if (ischar (scriptfile) + && ((nargin != 1 && iscellstr (varargin)) + || (nargin == 1 && ! isempty (scriptfile)))) + [status, output] = system (cstrcat ("python ", scriptfile, + sprintf (" %s", varargin{:}))); + else + error ("python: invalid arguments"); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/recycle.m b/octave_packages/m/miscellaneous/recycle.m new file mode 100644 index 0000000..7528856 --- /dev/null +++ b/octave_packages/m/miscellaneous/recycle.m @@ -0,0 +1,66 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{current_state}} recycle () +## @deftypefnx {Function File} {@var{old_state}} recycle (@var{new_state}) +## Query or set the preference for recycling deleted files. +## +## Recycling files instead of permanently deleting them is currently not +## implemented in Octave. To help avoid accidental data loss it +## is an error to attempt enable file recycling. +## @seealso{delete} +## @end deftypefn + +## Author: jwe + +function retval = recycle (state) + + persistent current_state = "off"; + + if (nargin > 1) + print_usage (); + endif + + if (nargin == 0 || nargout > 0) + retval = current_state; + endif + + if (nargin == 1) + if (ischar (state)) + if (strcmpi (state, "on")) + error ("recycle: recycling files is not implemented"); + elseif (strcmpi (state, "off")) + current_state = "off"; + else + error ("recycle: invalid value of STATE = `%s'", state); + endif + else + error ("recycle: expecting STATE to be a character string"); + endif + endif + +endfunction + +%!error recycle ("on"); +%!error recycle ("on", "and I mean it"); +%!error recycle (1); + +%!test +%! recycle ("off"); +%! assert (recycle ("off"), "off"); diff --git a/octave_packages/m/miscellaneous/rmappdata.m b/octave_packages/m/miscellaneous/rmappdata.m new file mode 100644 index 0000000..5d46d3c --- /dev/null +++ b/octave_packages/m/miscellaneous/rmappdata.m @@ -0,0 +1,44 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## 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 Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rmappdata (@var{h}, @var{name}) +## Delete the named application data for the object(s) with +## handle(s) @var{h}. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-07-15 + +function rmappdata (h, varargin) + + if (! (all (ishandle (h)) && iscellstr (varargin))) + error ("rmappdata: invalid input"); + endif + + for nh = 1:numel(h) + appdata = get (h(nh), "__appdata__"); + appdata = rmfield (appdata, varargin); + set (h(nh), "__appdata__", appdata); + endfor + +endfunction + +%!test +%! setappdata (0, "hello", "world") +%! rmappdata (0, "hello") +%! assert (isappdata (0, "hello"), false) + diff --git a/octave_packages/m/miscellaneous/run.m b/octave_packages/m/miscellaneous/run.m new file mode 100644 index 0000000..3a7cf21 --- /dev/null +++ b/octave_packages/m/miscellaneous/run.m @@ -0,0 +1,61 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} run @var{script} +## @deftypefnx {Function File} {} run (@var{script}) +## Run scripts in the current workspace that are not necessarily on the +## path. If @var{script} is the script to run, including its path, then +## @code{run} changes the directory to the directory where @var{script} is +## found. @code{run} then executes the script, and returns to the original +## directory. +## @seealso{system} +## @end deftypefn + +function run (script) + + if (nargin != 1) + print_usage (); + endif + + [d, f, ext] = fileparts (script); + if (! isempty (d)) + if (exist (d, "dir")) + wd = pwd (); + unwind_protect + cd (d); + if (! exist (cstrcat (f, ext), "file")) + error ("run: file SCRIPT must exist and be a valid Octave scriptfile"); + endif + evalin ("caller", sprintf ("source (\"%s%s\");", f, ext), + "rethrow (lasterror ())"); + unwind_protect_cleanup + cd (wd); + end_unwind_protect + else + error ("run: the path %s doesn't exist", d); + endif + else + if (exist (script, "file")) + evalin ("caller", sprintf ("source (\"%s\");", script), + "rethrow (lasterror ())"); + else + error ("run: %s not found", script); + endif + endif +endfunction diff --git a/octave_packages/m/miscellaneous/semicolon.m b/octave_packages/m/miscellaneous/semicolon.m new file mode 100644 index 0000000..a8da6b3 --- /dev/null +++ b/octave_packages/m/miscellaneous/semicolon.m @@ -0,0 +1,27 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Operator} {} ; +## Array row or command separator. +## @seealso{comma} +## @end deftypefn + +## Mark file as being tested. No real test needed for a documentation .m file +%!assert (1) + diff --git a/octave_packages/m/miscellaneous/setappdata.m b/octave_packages/m/miscellaneous/setappdata.m new file mode 100644 index 0000000..40d5c34 --- /dev/null +++ b/octave_packages/m/miscellaneous/setappdata.m @@ -0,0 +1,59 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## 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 Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} setappdata (@var{h}, @var{name}, @var{value}) +## Set the named application data to @var{value} for the object(s) with +## handle(s) @var{h}. If the application data with the specified name does +## not exist, it is created. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-07-15 + +function setappdata (h, varargin) + + if (! (all (ishandle (h)) && mod (numel (varargin), 2) == 0)) + error ("setappdata: invalid input"); + endif + + for nh = 1:numel(h) + if (! isfield (get (h(nh)), "__appdata__")) + addproperty ("__appdata__", h(nh), "any", struct ()); + endif + appdata = get (h(nh), "__appdata__"); + for narg = 1:2:numel(varargin) + if (iscellstr (varargin{narg})) + ## Handle cell arrays like set() does. + set (h(nh), "__appdata__", appdata); + setappdata (h(nh), vertcat (varargin{narg}', varargin{narg+1}'){:}); + appdata = get (h(nh), "__appdata__"); + elseif (ischar (varargin{narg})) + appdata.(varargin{narg}) = varargin{narg+1}; + else + error ("setappdata: invalid input"); + endif + endfor + set (h(nh), "__appdata__", appdata); + endfor + +endfunction + +%!test +%! setappdata (0, "hello", "world") +%! assert (isappdata (0, "hello"), true) +%!assert (getappdata (0, "hello"), "world") + diff --git a/octave_packages/m/miscellaneous/setfield.m b/octave_packages/m/miscellaneous/setfield.m new file mode 100644 index 0000000..79d751f --- /dev/null +++ b/octave_packages/m/miscellaneous/setfield.m @@ -0,0 +1,71 @@ +## Copyright (C) 2000-2012 Etienne Grossmann +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{k1}, @dots{}, @var{v1}] =} setfield (@var{s}, @var{k1}, @var{v1}, @dots{}) +## Set a field member in a (nested) structure array. For example: +## +## @example +## @group +## oo(1,1).f0 = 1; +## oo = setfield (oo, @{1,2@}, "fd", @{3@}, "b", 6); +## oo(1,2).fd(3).b == 6 +## @result{} ans = 1 +## @end group +## @end example +## +## Note that the same result as in the above example could be achieved by: +## +## @example +## @group +## i1 = @{1,2@}; i2 = "fd"; i3 = @{3@}; i4 = "b"; +## oo(i1@{:@}).(i2)(i3@{:@}).(i4) == 6 +## @result{} ans = 1 +## @end group +## @end example +## @seealso{getfield, rmfield, isfield, isstruct, fieldnames, struct} +## @end deftypefn + +## Author: Etienne Grossmann + +function obj = setfield (obj, varargin) + if (nargin < 3) + print_usage (); + endif + subs = varargin(1:end-1); + rhs = varargin{end}; + flds = cellfun ("isclass", subs, "char"); + idxs = cellfun ("isclass", subs, "cell"); + if (all (flds | idxs)) + typs = merge (flds, {"."}, {"()"}); + obj = subsasgn (obj, struct ("type", typs, "subs", subs), rhs); + else + error ("setfield: invalid index"); + endif +endfunction + +%!test +%! x.a = "hello"; +%! x = setfield(x,"b","world"); +%! y = struct("a","hello","b","world"); +%! assert(x,y); +%!test +%! oo(1,1).f0= 1; +%! oo = setfield(oo,{1,2},"fd",{3},"b", 6); +%! assert (oo(1,2).fd(3).b, 6) diff --git a/octave_packages/m/miscellaneous/substruct.m b/octave_packages/m/miscellaneous/substruct.m new file mode 100644 index 0000000..6216391 --- /dev/null +++ b/octave_packages/m/miscellaneous/substruct.m @@ -0,0 +1,89 @@ +## Copyright (C) 2006-2012 John W. Eaton +## Copyright (C) 2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} substruct (@var{type}, @var{subs}, @dots{}) +## Create a subscript structure for use with @code{subsref} or +## @code{subsasgn}. For example: +## +## @example +## @group +## idx = substruct ("()", @{3, ":"@}) +## @result{} +## idx = +## @{ +## type = () +## subs = +## @{ +## [1,1] = 3 +## [1,2] = : +## @} +## @} +## x = [1, 2, 3; 4, 5, 6; 7, 8, 9]; +## subsref (x, idx) +## @result{} 7 8 9 +## @end group +## @end example +## @seealso{subsref, subsasgn} +## @end deftypefn + +## Author: jwe + +function retval = substruct (varargin) + + nargs = nargin; + + if (nargs > 1 && mod (nargs, 2) == 0) + typ = varargin(1:2:nargs); + sub = varargin(2:2:nargs); + braces = strcmp (typ, "()") | strcmp (typ, "{}"); + dots = strcmp (typ, "."); + if (all (braces | dots)) + cells = cellfun ("isclass", sub, "cell"); + chars = cellfun ("isclass", sub, "char"); + if (any (braces &! cells)) + error ("substruct: for TYPE == () or {}, SUBS must be a cell array"); + elseif (any (dots &! chars)) + error ("substruct: for TYPE == ., SUBS must be a character string"); + endif + else + error ("substruct: expecting TYPE to be one of \"()\", \"{}\", or \".\""); + endif + + retval = struct ("type", typ, "subs", sub); + else + print_usage (); + endif + +endfunction + +%!test +%! x(1,1).type = "()"; +%! x(1,2).type = "{}"; +%! x(1,3).type = "."; +%! x(1,1).subs = {1,2,3}; +%! x(1,2).subs = {":"}; +%! x(1,3).subs = "foo"; +%! y = substruct ("()", {1,2,3}, "{}", {":"}, ".", "foo"); +%! assert(x,y); +%!error assert(substruct); +%!error assert(substruct (1, 2, 3)); +%!error assert(substruct ("x", 1)); +%!error assert(substruct ("()", [1,2,3])); +%!error assert(substruct (".", {1,2,3})); diff --git a/octave_packages/m/miscellaneous/swapbytes.m b/octave_packages/m/miscellaneous/swapbytes.m new file mode 100644 index 0000000..57042c1 --- /dev/null +++ b/octave_packages/m/miscellaneous/swapbytes.m @@ -0,0 +1,64 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} swapbytes (@var{x}) +## Swap the byte order on values, converting from little endian to big +## endian and vice versa. For example: +## +## @example +## @group +## swapbytes (uint16 (1:4)) +## @result{} [ 256 512 768 1024] +## @end group +## @end example +## +## @seealso{typecast, cast} +## @end deftypefn + +function y = swapbytes (x) + + if (nargin != 1) + print_usage (); + endif + + clx = class (x); + if (strcmp (clx, "int8") || strcmp (clx, "uint8") || isempty (x)) + y = x; + else + if (strcmp (clx, "int16") || strcmp (clx, "uint16")) + nb = 2; + elseif (strcmp (clx, "int32") || strcmp (clx, "uint32")) + nb = 4; + elseif (strcmp (clx, "int64") || strcmp (clx, "uint64") + || strcmp (clx, "double")) + nb = 8; + else + error ("swapbytes: invalid class of object"); + endif + y = reshape (typecast (reshape (typecast (x(:), "uint8"), nb, numel (x)) + ([nb : -1 : 1], :) (:), clx), size(x)); + endif + +endfunction + + +%!assert (double (swapbytes (uint16 (1:4))), [256 512 768 1024]) +%!error (swapbytes ()) +%!error (swapbytes (1, 2)) + diff --git a/octave_packages/m/miscellaneous/symvar.m b/octave_packages/m/miscellaneous/symvar.m new file mode 100644 index 0000000..6503676 --- /dev/null +++ b/octave_packages/m/miscellaneous/symvar.m @@ -0,0 +1,33 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} symvar (@var{s}) +## Identify the argument names in the function defined by a string. +## Common constant names such as @code{pi}, @code{NaN}, @code{Inf}, +## @code{eps}, @code{i} or @code{j} are ignored. The arguments that are +## found are returned in a cell array of strings. If no variables are +## found then the returned cell array is empty. +## @end deftypefn + +function args = symvar (s) + args = argnames (inline (s)); +endfunction + +## This function is tested by the tests for argnames(). +%!assert (1) diff --git a/octave_packages/m/miscellaneous/tar.m b/octave_packages/m/miscellaneous/tar.m new file mode 100644 index 0000000..8b8be41 --- /dev/null +++ b/octave_packages/m/miscellaneous/tar.m @@ -0,0 +1,66 @@ +## Copyright (C) 2005-2012 Søren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{entries} =} tar (@var{tarfile}, @var{files}) +## @deftypefnx {Function File} {@var{entries} =} tar (@var{tarfile}, @var{files}, @var{root}) +## Pack @var{files} @var{files} into the TAR archive @var{tarfile}. The +## list of files must be a string or a cell array of strings. +## +## The optional argument @var{root} changes the relative path of @var{files} +## from the current directory. +## +## If an output argument is requested the entries in the archive are +## returned in a cell array. +## @seealso{untar, bzip2, gzip, zip} +## @end deftypefn + +## Author: Søren Hauberg + +function entries = tar (tarfile, files, root = ".") + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (ischar (files)) + files = cellstr (files); + endif + + if (! (ischar (tarfile) && iscellstr (files) && ischar (root))) + error ("tar: all arguments must be character strings"); + endif + + cmd = sprintf ("tar cvf %s -C %s %s", tarfile, root, + sprintf (" %s", files{:})); + + [status, output] = system (cmd); + + if (status) + error ("tar: tar exited with status = %d", status); + endif + + if (nargout > 0) + if (output(end) == "\n") + output(end) = []; + endif + entries = strsplit (output, "\n"); + entries = entries'; + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/tempdir.m b/octave_packages/m/miscellaneous/tempdir.m new file mode 100644 index 0000000..bfe91df --- /dev/null +++ b/octave_packages/m/miscellaneous/tempdir.m @@ -0,0 +1,55 @@ +## Copyright (C) 2003-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dir} =} tempdir () +## Return the name of the system's directory for temporary files. +## @end deftypefn + +function dirname = tempdir () + + dirname = getenv ("TMPDIR"); + if (isempty (dirname)) + dirname = P_tmpdir; + endif + + if (! strcmp (dirname(end), filesep)) + dirname = cstrcat (dirname, filesep); + endif + + if (! isdir (dirname)) + warning ("tempdir: `%s' does not exist or is not a directory", dirname); + endif + +endfunction + + +%!assert (ischar (tempdir ())) + +%!test +%! old_wstate = warning ("query"); +%! warning ("off"); +%! old_tmpdir = getenv ("TMPDIR"); +%! unwind_protect +%! setenv ("TMPDIR", "__MY_TMP_DIR__"); +%! assert (tempdir (), ["__MY_TMP_DIR__" filesep()]); +%! unwind_protect_cleanup +%! setenv ("TMPDIR", old_tmpdir); +%! warning (old_wstate); +%! end_unwind_protect + diff --git a/octave_packages/m/miscellaneous/tempname.m b/octave_packages/m/miscellaneous/tempname.m new file mode 100644 index 0000000..e10422b --- /dev/null +++ b/octave_packages/m/miscellaneous/tempname.m @@ -0,0 +1,35 @@ +## Copyright (C) 2003-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} tempname () +## @deftypefnx {Function File} {} tempname (@var{dir}) +## @deftypefnx {Function File} {} tempname (@var{dir}, @var{prefix}) +## This function is an alias for @code{tmpnam}. +## @seealso{tmpnam} +## @end deftypefn + +function filename = tempname (varargin) + + filename = tmpnam (varargin{:}); + +endfunction + + +%% No tests needed for alias. +%!assert (1) diff --git a/octave_packages/m/miscellaneous/unix.m b/octave_packages/m/miscellaneous/unix.m new file mode 100644 index 0000000..c7ef24b --- /dev/null +++ b/octave_packages/m/miscellaneous/unix.m @@ -0,0 +1,70 @@ +## Copyright (C) 2004-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unix ("@var{command}") +## @deftypefnx {Function File} {@var{status} =} unix ("@var{command}") +## @deftypefnx {Function File} {[@var{status}, @var{text}] =} unix ("@var{command}") +## @deftypefnx {Function File} {[@dots{}] =} unix ("@var{command}", "-echo") +## Execute a system command if running under a Unix-like operating +## system, otherwise do nothing. Return the exit status of the program +## in @var{status} and any output from the command in @var{text}. +## When called with no output argument, or the "-echo" argument is +## given, then @var{text} is also sent to standard output. +## @seealso{dos, system, isunix, ispc} +## @end deftypefn + +## Author: octave-forge ??? +## Adapted by: jwe + +function [status, text] = unix (command, echo_arg) + + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (isunix ()) + [status, text] = system (command); + if (nargin > 1 || nargout == 0) + printf ("%s\n", text); + endif + endif + +endfunction + + +%!test +%! cmd = ls_command (); +%! old_wstate = warning ("query"); +%! warning ("off", "Octave:undefined-return-values"); +%! unwind_protect +%! [status, output] = unix (cmd); +%! unwind_protect_cleanup +%! warning (old_wstate); +%! end_unwind_protect +%! +%! if (isunix ()) +%! assert (status, 0); +%! assert (ischar (output)); +%! assert (! isempty (output)); +%! else +%! assert (status, []); +%! assert (output, []); +%! endif + +%!error unix () +%!error unix (1, 2, 3) + diff --git a/octave_packages/m/miscellaneous/unpack.m b/octave_packages/m/miscellaneous/unpack.m new file mode 100644 index 0000000..a954e9a --- /dev/null +++ b/octave_packages/m/miscellaneous/unpack.m @@ -0,0 +1,275 @@ +## Copyright (C) 2006-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{files} =} unpack (@var{file}) +## @deftypefnx {Function File} {@var{files} =} unpack (@var{file}, @var{dir}) +## @deftypefnx {Function File} {@var{files} =} unpack (@var{file}, @var{dir}, @var{filetype}) +## Unpack the archive @var{file} based on its extension to the directory +## @var{dir}. If @var{file} is a list of strings, then each file is +## unpacked individually. If @var{dir} is not specified, it defaults to +## the current directory. If a directory is in the file list, then the +## @var{filetype} must also be specified. +## +## The optional return value is a list of @var{files} unpacked. +## @seealso{bzip2, gzip, zip, tar} +## @end deftypefn + +## Author: Bill Denney + +function filelist = unpack (file, dir = ".", filetype = "") + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (! ischar (file) && ! iscellstr (file)) + error ("unpack: invalid input file class, %s", class(file)); + endif + + ## character arrays of more than one string must be treated as cell strings + if (ischar (file) && ! isvector (file)) + file = cellstr (file); + endif + + ## Recursively unpack cellstr arrays one file at a time + if (iscellstr (file)) + files = {}; + for i = 1:numel (file) + tmpfiles = unpack (file{i}, dir); + files = {files{:} tmpfiles{:}}; + endfor + + ## Return output if requested. + if (nargout > 0) + filelist = files; + endif + + return; + endif + + if (isdir (file)) + if (isempty (filetype)) + error ("unpack: FILETYPE must be given for a directory"); + elseif (! any (strcmpi (filetype, "gunzip"))) + error ("unpack: FILETYPE must be gunzip for a directory"); + endif + ext = ".gz"; + else + [pathstr, name, ext] = fileparts (file); + + ## Check to see if it's .tar.gz, .tar.Z, etc. + if (any (strcmpi ({".gz" ".Z" ".bz2" ".bz"}, ext))) + [tmppathstr, tmpname, tmpext] = fileparts (name); + if (strcmpi (tmpext, ".tar")) + name = tmpname; + ext = cstrcat (tmpext, ext); + endif + endif + + ## If the file is a URL, download it and then work with that file. + if (! isempty (strfind (file, "://"))) + ## FIXME -- the above is not a perfect test for a URL + urlfile = file; + ## FIXME -- should we name the file that we download with the + ## same file name as the URL requests? + tmpfile = cstrcat (tmpnam (), ext); + [file, success, msg] = urlwrite (urlfile, tmpfile); + if (! success) + error ("unpack: could not get \"%s\": %s", urlfile, msg); + endif + endif + + endif + + ## canonicalize_file_name returns empty if the file isn't found, so + ## use that to check for existence. + cfile = canonicalize_file_name (file); + + if (isempty (cfile)) + error ("unpack: file \"%s\" not found", file); + else + file = cfile; + endif + + ## Instructions on what to do for any extension. + ## + ## The field names are the file extension without periods. + ## The first cell is what is executed to unpack an archive verbosely. + ## The second cell is what is executed to unpack an archive quietly. + ## The third cell is the function to execute on output to get the + ## files list. + ## The fourth cell indicates if the files may need to be manually moved + ## (i.e. tar and unzip decompress into the current directory while + ## bzip2 and gzip decompress the file at its location). + persistent commandlist; + if (isempty (commandlist)) + commandlist.gz = {"gzip -d -v -r \"%s\"", ... + "gzip -d -r \"%s\"", ... + @__parse_gzip__, true}; + commandlist.z = commandlist.gz; + commandlist.bz2 = {"bzip2 -d -v \"%s\"", ... + "bzip2 -d \"%s\"", ... + @__parse_bzip2__, true}; + commandlist.bz = commandlist.bz2; + commandlist.tar = {"tar xvf \"%s\"", ... + "tar xf \"%s\"", ... + @__parse_tar__, false}; + commandlist.targz = {"gzip -d -c \"%s\" | tar xvf -", ... + "gzip -d -c \"%s\" | tar xf -", ... + @__parse_tar__, false}; + commandlist.tgz = commandlist.targz; + commandlist.tarbz2 = {"bzip2 -d -c \"%s\" | tar xvf -", ... + "bzip2 -d -c \"%s\" | tar xf -", ... + @__parse_tar__, false}; + commandlist.tarbz = commandlist.tarbz2; + commandlist.tbz2 = commandlist.tarbz2; + commandlist.tbz = commandlist.tarbz2; + commandlist.zip = {"unzip \"%s\"", ... + "unzip -q \"%s\"", ... + @__parse_zip__, false}; + endif + + nodotext = ext(! ismember (ext, ".")); + + origdir = pwd (); + + if (isfield (commandlist, nodotext)) + [commandv, commandq, parser, move] = deal (commandlist.(nodotext){:}); + cstartdir = canonicalize_file_name (origdir); + cenddir = canonicalize_file_name (dir); + needmove = move && ! strcmp (cstartdir, cenddir); + if (nargout > 0 || needmove) + command = commandv; + else + command = commandq; + endif + else + warning ("unpack:filetype", "unrecognized file type, %s", ext); + files = file; + return; + endif + + ## Create the directory if necessary. + s = stat (dir); + if (isempty (s)) + [status, msg] = mkdir (dir); + if (! status) + error ("unpack: mkdir failed to create %s: %s", dir, msg); + endif + elseif (! S_ISDIR (s.mode)) + error ("unpack: %s: not a directory", dir); + endif + + unwind_protect + cd (dir); + [status, output] = system (sprintf (cstrcat (command, " 2>&1"), file)); + unwind_protect_cleanup + cd (origdir); + end_unwind_protect + + if (status) + error ("unpack: unarchiving program exited with status: %d\n%s", + status, output); + endif + + if (nargout > 0 || needmove) + ## Trim the last cr if needed. + ## FIXME -- will this need to change to a check for "\r\n" for windows? + if (output(length (output)) == "\n") + output(length (output)) = []; + endif + files = parser (strsplit (output, "\n"))'; + + ## Move files if necessary + if (needmove) + [st, msg, msgid] = movefile (files, dir); + if (! st) + error ("unpack: unable to move files to \"%s\": %s", + dir, msg); + endif + + ## Fix the names for the files since they were moved. + for i = 1:numel (files) + files{i} = strrep (files{i}, cstartdir, cenddir); + endfor + endif + + ## Return output if requested. + if (nargout > 0) + filelist = files; + endif + endif + +endfunction + +function files = __parse_zip__ (output) + ## Parse the output from zip and unzip. + + ## Skip first line which is Archive header + output(1) = []; + for i = 1:length (output) + files{i} = output{i}(14:length(output{i})); + endfor +endfunction + +function output = __parse_tar__ (output) + ## This is a noop, but it makes things simpler for other cases. +endfunction + +function files = __parse_gzip__ (output) + ## Parse the output from gzip and gunzip returning the files + ## commpressed (or decompressed). + + files = {}; + ## The middle ": " should indicate a good place to start looking for + ## the filename. + for i = 1:length (output) + colons = strfind (output{i}, ":"); + if (isempty (colons)) + warning ("unpack:parsing", + "Unable to parse line (gzip missing colon):\n%s", output{i}); + else + midcolon = colons(ceil (length (colons)/2)); + thisstr = output{i}(midcolon+2:length(output{i})); + idx = index (thisstr, "with") + 5; + if (isempty (idx)) + warning ("unpack:parsing", + "Unable to parse line (gzip missing with):\n%s", output{i}); + else + files{i} = thisstr(idx:length (thisstr)); + endif + endif + endfor +endfunction + +function files = __parse_bzip2__ (output) + ## Parse the output from bzip2 and bunzip2 returning the files + ## commpressed (or decompressed). + + files = {}; + for i = 1:length (output) + ## the -5 is to remove the ".bz2:" + endoffilename = rindex (output{i}, ": ") - 5; + if (isempty (endoffilename)) + warning ("unpack:parsing", "Unable to parse line:\n%s", output{i}); + else + files{i} = output{i}(3:endoffilename); + endif + endfor +endfunction diff --git a/octave_packages/m/miscellaneous/untar.m b/octave_packages/m/miscellaneous/untar.m new file mode 100644 index 0000000..a4c2100 --- /dev/null +++ b/octave_packages/m/miscellaneous/untar.m @@ -0,0 +1,43 @@ +## Copyright (C) 2005-2012 Søren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} untar (@var{tarfile}) +## @deftypefnx {Function File} {} untar (@var{tarfile}, @var{dir}) +## Unpack the TAR archive @var{tarfile} to the directory @var{dir}. +## If @var{dir} is not specified, it defaults to the current directory. +## @seealso{tar, unpack, bunzip2, gunzip, unzip} +## @end deftypefn + +## Author: Søren Hauberg +## Adapted-By: jwe, Bill Denney + +function varargout = untar (tarfile, dir = ".") + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (nargout > 0) + varargout = cell (1, nargout); + [varargout{:}] = unpack (tarfile, dir, mfilename ()); + else + unpack (tarfile, dir, mfilename ()); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/unzip.m b/octave_packages/m/miscellaneous/unzip.m new file mode 100644 index 0000000..4de65fc --- /dev/null +++ b/octave_packages/m/miscellaneous/unzip.m @@ -0,0 +1,43 @@ +## Copyright (C) 2005-2012 Søren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unzip (@var{zipfile}) +## @deftypefnx {Function File} {} unzip (@var{zipfile}, @var{dir}) +## Unpack the ZIP archive @var{zipfile} to the directory @var{dir}. +## If @var{dir} is not specified, it defaults to the current directory. +## @seealso{zip, unpack, bunzip2, gunzip, untar} +## @end deftypefn + +## Author: Søren Hauberg +## Adapted-By: jwe, Bill Denney + +function varargout = unzip (zipfile, dir = ".") + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (nargout > 0) + varargout = cell (1, nargout); + [varargout{:}] = unpack (zipfile, dir, mfilename ()); + else + unpack (zipfile, dir, mfilename ()); + endif + +endfunction diff --git a/octave_packages/m/miscellaneous/usejava.m b/octave_packages/m/miscellaneous/usejava.m new file mode 100644 index 0000000..0c0f01f --- /dev/null +++ b/octave_packages/m/miscellaneous/usejava.m @@ -0,0 +1,67 @@ +## Copyright (C) 2012 Rik Wehbring +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} usejava (@var{feature}) +## Return true if the specific Sun Java element @var{feature} is available. +## +## Possible features are: +## +## @table @asis +## @item "awt" +## Abstract Window Toolkit for GUIs. +## +## @item "desktop" +## Interactive desktop is running. +## +## @item "jvm" +## Java Virtual Machine. +## +## @item "swing" +## Swing components for lightweight GUIs. +## @end table +## +## This function is provided for compatibility with @sc{matlab} scripts which +## may alter their behavior based on the availability of Java. Octave does +## not implement an interface to Java and this function always returns +## @code{false}. +## @end deftypefn + +function retval = usejava (feature) + + if (nargin != 1 || ! ischar (feature)) + print_usage (); + endif + + if (! any (strcmp (feature, {"awt", "desktop", "jvm", "swing"}))) + error ("usejava: unrecognized feature '%s'", feature); + endif + + retval = false; + +endfunction + + +%!assert (usejava ("awt"), false) + +%% Test input validation +%!error usejava () +%!error usejava (1, 2) +%!error usejava (1) +%!error usejava ("abc") + diff --git a/octave_packages/m/miscellaneous/ver.m b/octave_packages/m/miscellaneous/ver.m new file mode 100644 index 0000000..a97710a --- /dev/null +++ b/octave_packages/m/miscellaneous/ver.m @@ -0,0 +1,128 @@ +## Copyright (C) 2005-2012 William Poetra Yoga Hadisoeseno +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ver () +## Display a header containing the current Octave version number, license +## string and operating system, followed by the installed package names, +## versions, and installation directories. +## +## @deftypefnx {Function File} {v =} ver () +## Return a vector of structures, respecting Octave and each installed package. +## The structure includes the following fields. +## +## @table @code +## @item Name +## Package name. +## +## @item Version +## Version of the package. +## +## @item Revision +## Revision of the package. +## +## @item Date +## Date respecting the version/revision. +## @end table +## +## @deftypefnx {Function File} {v =} ver ("Octave") +## Return version information for Octave only. +## +## @deftypefnx {Function File} {v =} ver (@var{package}) +## Return version information for @var{package}. +## +## @seealso{version, octave_config_info} +## @end deftypefn + +## Author: William Poetra Yoga Hadisoeseno + +function varargout = ver (package = "") + + if (nargin > 1) + print_usage (); + endif + + ## Start with the version info for Octave + ret = struct ("Name", "Octave", "Version", version, + "Release", [], "Date", []); + + ## Add the installed packages + lst = pkg ("list"); + for i = 1:length (lst) + ret(end+1) = struct ("Name", lst{i}.name, "Version", lst{i}.version, + "Release", [], "Date", lst{i}.date); + endfor + + if (nargout == 0) + octave_license = license (); + + [unm, status] = uname (); + + if (status < 0) + os_string = "unknown"; + else + os_string = sprintf ("%s %s %s %s", unm.sysname, unm.release, + unm.version, unm.machine); + endif + + hbar(1:70) = "-"; + ver_line1 = "GNU Octave Version "; + ver_line2 = "GNU Octave License: "; + ver_line3 = "Operating System: "; + + ver_desc = sprintf ("%s\n%s%s\n%s%s\n%s%s\n%s\n", hbar, ver_line1, version, + ver_line2, octave_license, ver_line3, os_string, hbar); + + puts (ver_desc); + + pkg ("list"); + else + if (! isempty (package)) + n = []; + for r = 1:numel(ret) + if (strcmpi (ret(r).Name, package)) + n = r; + break; + endif + endfor + ret = ret(n); + endif + varargout{1} = ret; + endif + +endfunction + +%!test +%! result = ver; +%! assert (result(1).Name, "Octave") +%! assert (result(1).Version, version) +%! result = ver ("octave"); +%! assert (result(1).Name, "Octave") +%! assert (result(1).Version, version) + +%!test +%! lst = pkg ("list"); +%! for n=1:numel(lst) +%! expected = lst{n}.name; +%! result = ver (expected); +%! assert (result.Name, expected); +%! assert (isfield (result, "Version"), true); +%! assert (isfield (result, "Release"), true); +%! assert (isfield (result, "Date"), true); +%! endfor + diff --git a/octave_packages/m/miscellaneous/version.m b/octave_packages/m/miscellaneous/version.m new file mode 100644 index 0000000..dfdf7c0 --- /dev/null +++ b/octave_packages/m/miscellaneous/version.m @@ -0,0 +1,43 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} version () +## Return the version number of Octave, as a string. +## +## This is an alias for the function @w{@env{OCTAVE_VERSION}} provided for +## compatibility +## @seealso{OCTAVE_VERSION}. +## @end deftypefn + +## Author: jwe + +function vs = version () + + if (nargin != 0) + warning ("version: ignoring extra arguments"); + endif + + vs = OCTAVE_VERSION; + +endfunction + +%!assert(ischar (version ()) && strcmp (version (), OCTAVE_VERSION)); + +%!warning version (1); + diff --git a/octave_packages/m/miscellaneous/warning_ids.m b/octave_packages/m/miscellaneous/warning_ids.m new file mode 100644 index 0000000..6d8ac67 --- /dev/null +++ b/octave_packages/m/miscellaneous/warning_ids.m @@ -0,0 +1,324 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @cindex warning ids +## @table @code +## @item Octave:abbreviated-property-match +## By default, the @code{Octave:abbreviated-property-match} warning is enabled. +## +## @item Octave:array-to-scalar +## If the @code{Octave:array-to-scalar} warning is enabled, Octave will +## warn when an implicit conversion from an array to a scalar value is +## attempted. +## By default, the @code{Octave:array-to-scalar} warning is disabled. +## +## @item Octave:array-to-vector +## If the @code{Octave:array-to-vector} warning is enabled, Octave will +## warn when an implicit conversion from an array to a vector value is +## attempted. +## By default, the @code{Octave:array-to-vector} warning is disabled. +## +## @item Octave:assign-as-truth-value +## If the @code{Octave:assign-as-truth-value} warning is +## enabled, a warning is issued for statements like +## +## @example +## @group +## if (s = t) +## @dots{} +## @end group +## @end example +## +## @noindent +## since such statements are not common, and it is likely that the intent +## was to write +## +## @example +## @group +## if (s == t) +## @dots{} +## @end group +## @end example +## +## @noindent +## instead. +## +## There are times when it is useful to write code that contains +## assignments within the condition of a @code{while} or @code{if} +## statement. For example, statements like +## +## @example +## @group +## while (c = getc ()) +## @dots{} +## @end group +## @end example +## +## @noindent +## are common in C programming. +## +## It is possible to avoid all warnings about such statements by +## disabling the @code{Octave:assign-as-truth-value} warning, +## but that may also let real errors like +## +## @example +## @group +## if (x = 1) # intended to test (x == 1)! +## @dots{} +## @end group +## @end example +## +## @noindent +## slip by. +## +## In such cases, it is possible suppress errors for specific statements by +## writing them with an extra set of parentheses. For example, writing the +## previous example as +## +## @example +## @group +## while ((c = getc ())) +## @dots{} +## @end group +## @end example +## +## @noindent +## will prevent the warning from being printed for this statement, while +## allowing Octave to warn about other assignments used in conditional +## contexts. +## +## By default, the @code{Octave:assign-as-truth-value} warning is enabled. +## +## @item Octave:associativity-change +## If the @code{Octave:associativity-change} warning is +## enabled, Octave will warn about possible changes in the meaning of +## some code due to changes in associativity for some operators. +## Associativity changes have typically been made for @sc{matlab} +## compatibility. +## By default, the @code{Octave:associativity-change} warning is enabled. +## +## @item Octave:autoload-relative-file-name +## If the @code{Octave:autoload-relative-file-name} is enabled, +## Octave will warn when parsing autoload() function calls with relative +## paths to function files. This usually happens when using autoload() +## calls in PKG_ADD files, when the PKG_ADD file is not in the same +## directory as the .oct file referred to by the autoload() command. +## By default, the @code{Octave:autoload-relative-file-name} warning is enabled. +## +## @item Octave:broadcast +## Warn when performing broadcasting operations. By default, this is +## enabled. See @ref{Broadcasting} in the chapter Vectorization and Faster +## Code Execution of the manual. +## +## @item Octave:built-in-variable-assignment +## By default, the @code{Octave:built-in-variable-assignment} warning is +## enabled. +## +## @item Octave:divide-by-zero +## If the @code{Octave:divide-by-zero} warning is enabled, a +## warning is issued when Octave encounters a division by zero. +## By default, the @code{Octave:divide-by-zero} warning is enabled. +## +## @item Octave:fopen-file-in-path +## By default, the @code{Octave:fopen-file-in-path} warning is enabled. +## +## @item Octave:function-name-clash +## If the @code{Octave:function-name-clash} warning is enabled, a +## warning is issued when Octave finds that the name of a function +## defined in a function file differs from the name of the file. (If +## the names disagree, the name declared inside the file is ignored.) +## By default, the @code{Octave:function-name-clash} warning is enabled. +## +## @item Octave:future-time-stamp +## If the @code{Octave:future-time-stamp} warning is enabled, Octave +## will print a warning if it finds a function file with a time stamp +## that is in the future. +## By default, the @code{Octave:future-time-stamp} warning is enabled. +## +## @item Octave:glyph-render +## By default, the @code{Octave:glyph-render} warning is enabled. +## +## @item Octave:imag-to-real +## If the @code{Octave:imag-to-real} warning is enabled, a warning is +## printed for implicit conversions of complex numbers to real numbers. +## By default, the @code{Octave:imag-to-real} warning is disabled. +## +## @item Octave:load-file-in-path +## By default, the @code{Octave:load-file-in-path} warning is enabled. +## +## @item Octave:logical-conversion +## By default, the @code{Octave:logical-conversion} warning is enabled. +## +## @item Octave:matlab-incompatible +## Print warnings for Octave language features that may cause +## compatibility problems with @sc{matlab}. +## By default, the @code{Octave:matlab-incompatible} warning is disabled. +## +## @item Octave:md5sum-file-in-path +## By default, the @code{Octave:md5sum-file-in-path} warning is enabled. +## +## @item Octave:missing-glyph +## By default, the @code{Octave:missing-glyph} warning is enabled. +## +## @item Octave:missing-semicolon +## If the @code{Octave:missing-semicolon} warning is enabled, Octave +## will warn when statements in function definitions don't end in +## semicolons. +## By default the @code{Octave:missing-semicolon} warning is disabled. +## +## @item Octave:mixed-string-concat +## If the @code{Octave:mixed-string-concat} warning is enabled, print a +## warning when concatenating a mixture of double and single quoted strings. +## By default, the @code{Octave:mixed-string-concat} warning is disabled. +## +## @item Octave:neg-dim-as-zero +## If the @code{Octave:neg-dim-as-zero} warning is enabled, print a warning +## for expressions like +## +## @example +## eye (-1) +## @end example +## +## @noindent +## By default, the @code{Octave:neg-dim-as-zero} warning is disabled. +## +## @item Octave:nested-functions-coerced +## By default, the @code{Octave:nested-functions-coerced} warning is enabled. +## +## @item Octave:noninteger-range-as-index +## By default, the @code{Octave:noninteger-range-as-index} warning is enabled. +## +## @item Octave:num-to-str +## If the @code{Octave:num-to-str} warning is enable, a warning is +## printed for implicit conversions of numbers to their ASCII character +## equivalents when strings are constructed using a mixture of strings and +## numbers in matrix notation. For example, +## +## @example +## @group +## [ "f", 111, 111 ] +## @result{} "foo" +## @end group +## @end example +## +## @noindent +## elicits a warning if the @code{Octave:num-to-str} warning is +## enabled. By default, the @code{Octave:num-to-str} warning is enabled. +## +## @item Octave:possible-matlab-short-circuit-operator +## If the @code{Octave:possible-matlab-short-circuit-operator} warning +## is enabled, Octave will warn about using the not short circuiting +## operators @code{&} and @code{|} inside @code{if} or @code{while} +## conditions. They normally never short circuit, but @sc{matlab} always +## short circuits if any logical operators are used in a condition. You +## can turn on the option +## +## @example +## @group +## do_braindead_shortcircuit_evaluation (1) +## @end group +## @end example +## +## @noindent +## if you would like to enable this short-circuit evaluation in +## Octave. Note that the @code{&&} and @code{||} operators always short +## circuit in both Octave and @sc{matlab}, so it's only necessary to +## enable @sc{matlab}-style short-circuiting it's too arduous to modify +## existing code that relies on this behavior. +## By default, the @code{Octave:possible-matlab-short-circuit-operator} warning +## is enabled. +## +## @item Octave:precedence-change +## If the @code{Octave:precedence-change} warning is enabled, Octave +## will warn about possible changes in the meaning of some code due to +## changes in precedence for some operators. Precedence changes have +## typically been made for @sc{matlab} compatibility. +## By default, the @code{Octave:precedence-change} warning is enabled. +## +## @item Octave:recursive-path-search +## By default, the @code{Octave:recursive-path-search} warning is enabled. +## +## @item Octave:reload-forces-clear +## If several functions have been loaded from the same file, Octave must +## clear all the functions before any one of them can be reloaded. If +## the @code{Octave:reload-forces-clear} warning is enabled, Octave will +## warn you when this happens, and print a list of the additional +## functions that it is forced to clear. +## By default, the @code{Octave:reload-forces-clear} warning is enabled. +## +## @item Octave:resize-on-range-error +## If the @code{Octave:resize-on-range-error} warning is enabled, print a +## warning when a matrix is resized by an indexed assignment with +## indices outside the current bounds. +## By default, the ## @code{Octave:resize-on-range-error} warning is disabled. +## +## @item Octave:separator-insert +## Print warning if commas or semicolons might be inserted +## automatically in literal matrices. +## By default, the @code{Octave:separator-insert} warning is disabled. +## +## @item Octave:shadowed-function +## By default, the @code{Octave:shadowed-function} warning is enabled. +## +## @item Octave:single-quote-string +## Print warning if a single quote character is used to introduce a +## string constant. +## By default, the @code{Octave:single-quote-string} warning is disabled. +## +## @item Octave:singular-matrix-div +## By default, the @code{Octave:singular-matrix-div} warning is enabled. +## +## @item Octave:sqrtm:SingularMatrix +## By default, the @code{Octave:sqrtm:SingularMatrix} warning is enabled. +## +## @item Octave:str-to-num +## If the @code{Octave:str-to-num} warning is enabled, a warning is printed +## for implicit conversions of strings to their numeric ASCII equivalents. +## For example, +## +## @example +## @group +## "abc" + 0 +## @result{} 97 98 99 +## @end group +## @end example +## +## @noindent +## elicits a warning if the @code{Octave:str-to-num} warning is enabled. +## By default, the @code{Octave:str-to-num} warning is disabled. +## +## @item Octave:undefined-return-values +## If the @code{Octave:undefined-return-values} warning is disabled, +## print a warning if a function does not define all the values in +## the return list which are expected. +## By default, the @code{Octave:undefined-return-values} warning is enabled. +## +## @item Octave:variable-switch-label +## If the @code{Octave:variable-switch-label} warning is enabled, Octave +## will print a warning if a switch label is not a constant or constant +## expression. +## By default, the @code{Octave:variable-switch-label} warning is disabled. +## @end table + +function warning_ids () + help ("warning_ids"); +endfunction + +## Remove from test statistics. No real tests possible +%!assert (1) diff --git a/octave_packages/m/miscellaneous/what.m b/octave_packages/m/miscellaneous/what.m new file mode 100644 index 0000000..aa0a76b --- /dev/null +++ b/octave_packages/m/miscellaneous/what.m @@ -0,0 +1,110 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} what +## @deftypefnx {Command} {} what @var{dir} +## @deftypefnx {Function File} {w =} what (@var{dir}) +## List the Octave specific files in directory @var{dir}. If @var{dir} is +## not specified then the current directory is used. If a return argument is +## requested, the files found are returned in the structure @var{w}. +## @seealso{which} +## @end deftypefn + +function ret = what (d) + + if (nargin == 0) + d = pwd (); + elseif (isempty (strfind (d, filesep ()))) + ## Find the appropriate directory on the path. + p = strtrim (strsplit (path (), pathsep())); + d = p{find (cellfun (@(x) ! isempty (strfind (x, d)), p))(end)}; + else + [status, msg, msgid] = fileattrib (d); + if (status != 1) + error ("what: could not find the file or path %s", d); + else + d = msg.Name; + endif + endif + + files = dir (d); + w.path = d; + w.m = cell (0, 1); + w.mex = cell (0, 1); + w.oct = cell (0, 1); + w.mat = cell (0, 1); + w.mdl = cell (0, 1); + w.p = cell (0, 1); + w.classes = cell (0, 1); + + for i = 1 : length (files) + n = files(i).name; + ## Ignore . and .. + if (strcmp (n, ".") || strcmp (n, "..")) + continue; + else + ## Ignore mdl and p files + [dummy, f, e] = fileparts (n); + if (strcmp (e, ".m")) + w.m{end+1} = n; + elseif (strcmp (e, mexext ())) + w.mex{end+1} = n; + elseif (strcmp (e, ".oct")) + w.oct{end+1} = n; + elseif (strcmp (e, ".mat")) + w.mat{end+1} = n; + elseif(strcmp (n(1), "@")) + w.classes{end+1} = n; + endif + endif + endfor + + if (nargout == 0) + __display_filenames__ ("M-files in directory", w.path, w.m); + __display_filenames__ ("\nMEX-files in directory", w.path, w.mex); + __display_filenames__ ("\nOCT-files in directory", w.path, w.oct); + __display_filenames__ ("\nMAT-files in directory", w.path, w.mat); + __display_filenames__ ("\nClasses in directory", w.path, w.classes); + else + ret = w; + endif +endfunction + +function __display_filenames__ (msg, p, f) + if (length (f) > 0) + printf ("%s %s:\n\n", msg, p); + + maxlen = max (cellfun ("length", f)); + ncols = max (1, floor (terminal_size()(2) / (maxlen + 3))); + fmt = ""; + for i = 1: ncols + fmt = sprintf ("%s %%-%ds", fmt, maxlen); + endfor + fmt = [fmt, "\n"]; + + nrows = ceil (length (f) / ncols); + for i = 1 : nrows + args = f(i:nrows:end); + if (length (args) < ncols) + args(end + 1 : ncols) = {""}; + endif + printf (fmt, args{:}); + endfor + endif +endfunction diff --git a/octave_packages/m/miscellaneous/xor.m b/octave_packages/m/miscellaneous/xor.m new file mode 100644 index 0000000..ab8e295 --- /dev/null +++ b/octave_packages/m/miscellaneous/xor.m @@ -0,0 +1,71 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {@var{z} =} xor (@var{x}, @var{y}) +## Return the `exclusive or' of the entries of @var{x} and @var{y}. +## For boolean expressions @var{x} and @var{y}, +## @code{xor (@var{x}, @var{y})} is true if and only if one of @var{x} or +## @var{y} is true. Otherwise, for @var{x} and @var{y} both true or both +## false, @code{xor} returns false. +## +## The truth table for the xor operation is +## +## @multitable @columnfractions 0.44 .03 .05 .03 0.44 +## @item @tab @var{x} @tab @var{y} @tab @var{z} @tab +## @item @tab 0 @tab 0 @tab 0 @tab +## @item @tab 1 @tab 0 @tab 1 @tab +## @item @tab 0 @tab 1 @tab 1 @tab +## @item @tab 1 @tab 1 @tab 0 @tab +## @end multitable +## +## @seealso{and, or, not} +## @end deftypefn + +## Author: KH +## Created: 16 September 1994 +## Adapted-By: jwe + +function z = xor (x, y) + + if (nargin == 2) + if (isscalar (x) || isscalar (y) || size_equal (x, y)) + ## Typecast to logicals is necessary for other numeric types. + z = logical (x) != logical (y); + else + try + z = bsxfun (@xor, x, y); + catch + error ("xor: X and Y must be of compatible size or scalars"); + end_try_catch + endif + else + print_usage (); + endif + +endfunction + +%!assert((xor ([1, 1, 0, 0], [0, 1, 0, 1]) == [1, 0, 0, 1] +%! && xor ([i, i, 0, 0], [1, 0, 1, 0]) == [0, 1, 1, 0])); + +%!assert(all (all (xor (eye (2), fliplr (eye (2))) == ones (2)))); + +%!error xor (); + +%!error xor (1, 2, 3); + diff --git a/octave_packages/m/miscellaneous/zip.m b/octave_packages/m/miscellaneous/zip.m new file mode 100644 index 0000000..b23298d --- /dev/null +++ b/octave_packages/m/miscellaneous/zip.m @@ -0,0 +1,68 @@ +## Copyright (C) 2006-2012 Sylvain Pelissier +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{entries} =} zip (@var{zipfile}, @var{files}) +## @deftypefnx {Function File} {@var{entries} =} zip (@var{zipfile}, @var{files}, @var{rootdir}) +## Compress the list of files and/or directories specified in @var{files} +## into the archive @var{zipfile} in the same directory. If @var{rootdir} +## is defined the @var{files} are located relative to @var{rootdir} rather +## than the current directory. +## @seealso{unzip, bzip2, gzip, tar} +## @end deftypefn + +## Author: Sylvain Pelissier + +function entries = zip (zipfile, files, rootdir = ".") + + if (nargin != 2 && nargin != 3) + print_usage (); + endif + + rootdir = tilde_expand (rootdir); + + if (ischar (files)) + files = cellstr (files); + endif + + if (! ischar (zipfile) && ! iscellstr (files)) + error ("zip: expecting all arguments to be character strings"); + endif + + cmd = sprintf ("cd %s; zip -r %s/%s %s", rootdir, pwd (), zipfile, + sprintf (" %s", files{:})); + + [status, output] = system (cmd); + + if (status) + error ("zip: zip failed with exit status = %d", status); + endif + + if (nargout > 0) + cmd = sprintf ("unzip -Z -1 %s", zipfile); + [status, entries] = system (cmd); + if (status) + error ("zip: zipinfo failed with exit status = %d", status); + endif + if (entries(end) == "\n") + entries(end) = []; + endif + entries = strsplit (entries, "\n"); + endif + +endfunction diff --git a/octave_packages/m/optimization/PKG_ADD b/octave_packages/m/optimization/PKG_ADD new file mode 100644 index 0000000..883d526 --- /dev/null +++ b/octave_packages/m/optimization/PKG_ADD @@ -0,0 +1,14 @@ +## Discard result to avoid polluting workspace with ans at startup. +[~] = __all_opts__ ("fminbnd"); +## Discard result to avoid polluting workspace with ans at startup. +[~] = __all_opts__ ("fminunc"); +## Discard result to avoid polluting workspace with ans at startup. +[~] = __all_opts__ ("fsolve"); +## Discard result to avoid polluting workspace with ans at startup. +[~] = __all_opts__ ("fzero"); +## Discard result to avoid polluting workspace with ans at startup. +[~] = __all_opts__ ("lsqnonneg"); +## Discard result to avoid polluting workspace with ans at startup. +[~] = __all_opts__ ("pqpnonneg"); +## Discard result to avoid polluting workspace with ans at startup. +[~] = __all_opts__ ("qp"); diff --git a/octave_packages/m/optimization/__all_opts__.m b/octave_packages/m/optimization/__all_opts__.m new file mode 100644 index 0000000..74c362c --- /dev/null +++ b/octave_packages/m/optimization/__all_opts__.m @@ -0,0 +1,73 @@ +## Copyright (C) 2009-2012 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{names} =} __all_opts__ (@dots{}) +## Undocumented internal function. +## @end deftypefn + +## Query all options from all known optimization functions and return a +## list of possible values. + +function names = __all_opts__ (varargin) + + persistent saved_names = {}; + + ## do not clear this function + mlock (); + + ## guard against recursive calls. + persistent recursive = false; + + if (recursive) + names = {}; + elseif (nargin == 0) + names = saved_names; + else + ## query all options from all known functions. These will call optimset, + ## which will in turn call us, but we won't answer. + recursive = true; + names = saved_names; + for i = 1:nargin + try + opts = optimset (varargin{i}); + fn = fieldnames (opts).'; + names = [names, fn]; + catch + # throw the error as a warning. + warning (lasterr ()); + end_try_catch + endfor + names = unique (names); + [lnames, idx] = unique (tolower (names)); + if (length (lnames) < length (names)) + ## This is bad. + error ("__all_opts__: duplicate options with inconsistent case"); + else + names = names(idx); + endif + saved_names = names; + recursive = false; + endif + +endfunction + + +## No test needed for internal helper function. +%!assert (1) + diff --git a/octave_packages/m/optimization/fminbnd.m b/octave_packages/m/optimization/fminbnd.m new file mode 100644 index 0000000..36294f6 --- /dev/null +++ b/octave_packages/m/optimization/fminbnd.m @@ -0,0 +1,213 @@ +## Copyright (C) 2008-2012 VZLU Prague, a.s. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Author: Jaroslav Hajek + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{fval}, @var{info}, @var{output}] =} fminbnd (@var{fun}, @var{a}, @var{b}, @var{options}) +## Find a minimum point of a univariate function. @var{fun} should be a +## function +## handle or name. @var{a}, @var{b} specify a starting interval. @var{options} +## is a +## structure specifying additional options. Currently, @code{fminbnd} +## recognizes these options: @code{"FunValCheck"}, @code{"OutputFcn"}, +## @code{"TolX"}, @code{"MaxIter"}, @code{"MaxFunEvals"}. +## For description of these options, see @ref{doc-optimset,,optimset}. +## +## On exit, the function returns @var{x}, the approximate minimum point +## and @var{fval}, the function value thereof. +## @var{info} is an exit flag that can have these values: +## +## @itemize +## @item 1 +## The algorithm converged to a solution. +## +## @item 0 +## Maximum number of iterations or function evaluations has been exhausted. +## +## @item -1 +## The algorithm has been terminated from user output function. +## @end itemize +## @seealso{optimset, fzero, fminunc} +## @end deftypefn + +## This is patterned after opt/fmin.f from Netlib, which in turn is taken from +## Richard Brent: Algorithms For Minimization Without Derivatives, Prentice-Hall (1973) + +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fminbnd"); + +function [x, fval, info, output] = fminbnd (fun, xmin, xmax, options = struct ()) + + ## Get default options if requested. + if (nargin == 1 && ischar (fun) && strcmp (fun, 'defaults')) + x = optimset ("MaxIter", Inf, "MaxFunEvals", Inf, "TolX", 1e-8, \ + "OutputFcn", [], "FunValCheck", "off"); + return; + endif + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (ischar (fun)) + fun = str2func (fun, "global"); + endif + + ## TODO + ## displev = optimget (options, "Display", "notify"); + funvalchk = strcmpi (optimget (options, "FunValCheck", "off"), "on"); + outfcn = optimget (options, "OutputFcn"); + tolx = optimget (options, "TolX", 1e-8); + maxiter = optimget (options, "MaxIter", Inf); + maxfev = optimget (options, "MaxFunEvals", Inf); + + if (funvalchk) + ## Replace fun with a guarded version. + fun = @(x) guarded_eval (fun, x); + endif + + ## The default exit flag if exceeded number of iterations. + info = 0; + niter = 0; + nfev = 0; + sqrteps = eps (class (xmin + xmax)); + + c = 0.5*(3-sqrt(5)); + a = xmin; b = xmax; + v = a + c*(b-a); + w = x = v; + e = 0; + fv = fw = fval = fun (x); + nfev++; + + while (niter < maxiter && nfev < maxfev) + xm = 0.5*(a+b); + ## FIXME: the golden section search can actually get closer than sqrt(eps)... + ## sometimes. Sometimes not, it depends on the function. This is the strategy + ## from the Netlib code. Something yet smarter would be good. + tol = 2 * sqrteps * abs (x) + tolx / 3; + if (abs (x - xm) <= (2*tol - 0.5*(b-a))) + info = 1; + break; + endif + + if (abs (e) > tol) + dogs = false; + ## Try inverse parabolic step. + r = (x - w)*(fval - fv); + q = (x - v)*(fval - fw); + p = (x - v)*q - (x - w)*r; + q = 2*(q - r); + p *= -sign (q); + q = abs (q); + r = e; + e = d; + + if (abs (p) < abs (0.5*q*r) && p > q*(a-x) && p < q*(b-x)) + ## The parabolic step is acceptable. + d = p / q; + u = x + d; + + ## f must not be evaluated too close to ax or bx. + if (min (u-a, b-u) < 2*tol) + d = tol * (sign (xm - x) + (xm == x)); + endif + else + dogs = true; + endif + else + dogs = true; + endif + if (dogs) + ## Default to golden section step. + e = ifelse (x >= xm, a - x, b - x); + d = c * e; + endif + + ## f must not be evaluated too close to x. + u = x + max (abs (d), tol) * (sign (d) + (d == 0)); + + fu = fun (u); + nfev++; + niter++; + + ## update a, b, v, w, and x + + if (fu <= fval) + if (u < x) + b = x; + else + a = x; + endif + v = w; fv = fw; + w = x; fw = fval; + x = u; fval = fu; + else + ## The following if-statement was originally executed even if fu == fval. + if (u < x) + a = u; + else + b = u; + endif + if (fu <= fw || w == x) + v = w; fv = fw; + w = u; fw = fu; + elseif (fu <= fv || v == x || v == w) + v = u; + fv = fu; + endif + endif + + ## If there's an output function, use it now. + if (outfcn) + optv.funccount = nfev; + optv.fval = fval; + optv.iteration = niter; + if (outfcn (x, optv, "iter")) + info = -1; + break; + endif + endif + endwhile + + output.iterations = niter; + output.funcCount = nfev; + output.bracket = [a, b]; + ## FIXME: bracketf possibly unavailable. + +endfunction + +## An assistant function that evaluates a function handle and checks for +## bad results. +function fx = guarded_eval (fun, x) + fx = fun (x); + fx = fx(1); + if (! isreal (fx)) + error ("fminbnd:notreal", "fminbnd: non-real value encountered"); + elseif (isnan (fx)) + error ("fminbnd:isnan", "fminbnd: NaN value encountered"); + endif +endfunction + +%!shared opt0 +%! opt0 = optimset ("tolx", 0); +%!assert (fminbnd (@cos, pi/2, 3*pi/2, opt0), pi, 10*sqrt(eps)) +%!assert (fminbnd (@(x) (x - 1e-3)^4, -1, 1, opt0), 1e-3, 10e-3*sqrt(eps)) +%!assert (fminbnd (@(x) abs(x-1e7), 0, 1e10, opt0), 1e7, 10e7*sqrt(eps)) +%!assert (fminbnd (@(x) x^2 + sin(2*pi*x), 0.4, 1, opt0), fzero (@(x) 2*x + 2*pi*cos(2*pi*x), [0.4, 1], opt0), sqrt(eps)) diff --git a/octave_packages/m/optimization/fminunc.m b/octave_packages/m/optimization/fminunc.m new file mode 100644 index 0000000..0b5360f --- /dev/null +++ b/octave_packages/m/optimization/fminunc.m @@ -0,0 +1,416 @@ +## Copyright (C) 2008-2012 VZLU Prague, a.s. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Author: Jaroslav Hajek + +## -*- texinfo -*- +## @deftypefn {Function File} {} fminunc (@var{fcn}, @var{x0}) +## @deftypefnx {Function File} {} fminunc (@var{fcn}, @var{x0}, @var{options}) +## @deftypefnx {Function File} {[@var{x}, @var{fvec}, @var{info}, @var{output}, @var{grad}, @var{hess}] =} fminunc (@var{fcn}, @dots{}) +## Solve an unconstrained optimization problem defined by the function +## @var{fcn}. +## @var{fcn} should accepts a vector (array) defining the unknown variables, +## and return the objective function value, optionally with gradient. +## In other words, this function attempts to determine a vector @var{x} such +## that @code{@var{fcn} (@var{x})} is a local minimum. +## @var{x0} determines a starting guess. The shape of @var{x0} is preserved +## in all calls to @var{fcn}, but otherwise is treated as a column vector. +## @var{options} is a structure specifying additional options. +## Currently, @code{fminunc} recognizes these options: +## @code{"FunValCheck"}, @code{"OutputFcn"}, @code{"TolX"}, +## @code{"TolFun"}, @code{"MaxIter"}, @code{"MaxFunEvals"}, +## @code{"GradObj"}, @code{"FinDiffType"}, +## @code{"TypicalX"}, @code{"AutoScaling"}. +## +## If @code{"GradObj"} is @code{"on"}, it specifies that @var{fcn}, +## called with 2 output arguments, also returns the Jacobian matrix +## of right-hand sides at the requested point. @code{"TolX"} specifies +## the termination tolerance in the unknown variables, while +## @code{"TolFun"} is a tolerance for equations. Default is @code{1e-7} +## for both @code{"TolX"} and @code{"TolFun"}. +## +## For description of the other options, see @code{optimset}. +## +## On return, @var{fval} contains the value of the function @var{fcn} +## evaluated at @var{x}, and @var{info} may be one of the following values: +## +## @table @asis +## @item 1 +## Converged to a solution point. Relative gradient error is less than +## specified +## by TolFun. +## +## @item 2 +## Last relative step size was less that TolX. +## +## @item 3 +## Last relative decrease in function value was less than TolF. +## +## @item 0 +## Iteration limit exceeded. +## +## @item -3 +## The trust region radius became excessively small. +## @end table +## +## Optionally, fminunc can also yield a structure with convergence statistics +## (@var{output}), the output gradient (@var{grad}) and approximate Hessian +## (@var{hess}). +## +## Note: If you only have a single nonlinear equation of one variable, using +## @code{fminbnd} is usually a much better idea. +## @seealso{fminbnd, optimset} +## @end deftypefn + +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fminunc"); + +function [x, fval, info, output, grad, hess] = fminunc (fcn, x0, options = struct ()) + + ## Get default options if requested. + if (nargin == 1 && ischar (fcn) && strcmp (fcn, 'defaults')) + x = optimset ("MaxIter", 400, "MaxFunEvals", Inf, \ + "GradObj", "off", "TolX", 1e-7, "TolFun", 1e-7, + "OutputFcn", [], "FunValCheck", "off", + "FinDiffType", "central", + "TypicalX", [], "AutoScaling", "off"); + return; + endif + + if (nargin < 2 || nargin > 3 || ! ismatrix (x0)) + print_usage (); + endif + + if (ischar (fcn)) + fcn = str2func (fcn, "global"); + endif + + xsiz = size (x0); + n = numel (x0); + + has_grad = strcmpi (optimget (options, "GradObj", "off"), "on"); + cdif = strcmpi (optimget (options, "FinDiffType", "central"), "central"); + maxiter = optimget (options, "MaxIter", 400); + maxfev = optimget (options, "MaxFunEvals", Inf); + outfcn = optimget (options, "OutputFcn"); + + ## Get scaling matrix using the TypicalX option. If set to "auto", the + ## scaling matrix is estimated using the jacobian. + typicalx = optimget (options, "TypicalX"); + if (isempty (typicalx)) + typicalx = ones (n, 1); + endif + autoscale = strcmpi (optimget (options, "AutoScaling", "off"), "on"); + if (! autoscale) + dg = 1 ./ typicalx; + endif + + funvalchk = strcmpi (optimget (options, "FunValCheck", "off"), "on"); + + if (funvalchk) + ## Replace fcn with a guarded version. + fcn = @(x) guarded_eval (fcn, x); + endif + + ## These defaults are rather stringent. I think that normally, user + ## prefers accuracy to performance. + + macheps = eps (class (x0)); + + tolx = optimget (options, "TolX", 1e-7); + tolf = optimget (options, "TolFun", 1e-7); + + factor = 0.1; + ## FIXME: TypicalX corresponds to user scaling (???) + autodg = true; + + niter = 1; + nfev = 0; + + x = x0(:); + info = 0; + + ## Initial evaluation. + fval = fcn (reshape (x, xsiz)); + n = length (x); + + if (! isempty (outfcn)) + optimvalues.iter = niter; + optimvalues.funccount = nfev; + optimvalues.fval = fval; + optimvalues.searchdirection = zeros (n, 1); + state = 'init'; + stop = outfcn (x, optimvalues, state); + if (stop) + info = -1; + break; + endif + endif + + nsuciter = 0; + lastratio = 0; + + grad = []; + + ## Outer loop. + while (niter < maxiter && nfev < maxfev && ! info) + + grad0 = grad; + + ## Calculate function value and gradient (possibly via FD). + if (has_grad) + [fval, grad] = fcn (reshape (x, xsiz)); + grad = grad(:); + nfev ++; + else + grad = __fdjac__ (fcn, reshape (x, xsiz), fval, typicalx, cdif)(:); + nfev += (1 + cdif) * length (x); + endif + + if (niter == 1) + ## Initialize by identity matrix. + hesr = eye (n); + else + ## Use the damped BFGS formula. + y = grad - grad0; + sBs = sumsq (w); + Bs = hesr'*w; + sy = y'*s; + theta = 0.8 / max (1 - sy / sBs, 0.8); + r = theta * y + (1-theta) * Bs; + hesr = cholupdate (hesr, r / sqrt (s'*r), "+"); + [hesr, info] = cholupdate (hesr, Bs / sqrt (sBs), "-"); + if (info) + hesr = eye (n); + endif + endif + + if (autoscale) + ## Second derivatives approximate the hessian. + d2f = norm (hesr, 'columns').'; + if (niter == 1) + dg = d2f; + else + ## FIXME: maybe fixed lower and upper bounds? + dg = max (0.1*dg, d2f); + endif + endif + + if (niter == 1) + xn = norm (dg .* x); + ## FIXME: something better? + delta = factor * max (xn, 1); + endif + + ## FIXME -- why tolf*n*xn? If abs (e) ~ abs(x) * eps is a vector + ## of perturbations of x, then norm (hesr*e) <= eps*xn, i.e. by + ## tolf ~ eps we demand as much accuracy as we can expect. + if (norm (grad) <= tolf*n*xn) + info = 1; + break; + endif + + suc = false; + decfac = 0.5; + + ## Inner loop. + while (! suc && niter <= maxiter && nfev < maxfev && ! info) + + s = - __doglegm__ (hesr, grad, dg, delta); + + sn = norm (dg .* s); + if (niter == 1) + delta = min (delta, sn); + endif + + fval1 = fcn (reshape (x + s, xsiz)) (:); + nfev ++; + + if (fval1 < fval) + ## Scaled actual reduction. + actred = (fval - fval1) / (abs (fval1) + abs (fval)); + else + actred = -1; + endif + + w = hesr*s; + ## Scaled predicted reduction, and ratio. + t = 1/2 * sumsq (w) + grad'*s; + if (t < 0) + prered = -t/(abs (fval) + abs (fval + t)); + ratio = actred / prered; + else + prered = 0; + ratio = 0; + endif + + ## Update delta. + if (ratio < min(max(0.1, 0.8*lastratio), 0.9)) + delta *= decfac; + decfac ^= 1.4142; + if (delta <= 1e1*macheps*xn) + ## Trust region became uselessly small. + info = -3; + break; + endif + else + lastratio = ratio; + decfac = 0.5; + if (abs (1-ratio) <= 0.1) + delta = 1.4142*sn; + elseif (ratio >= 0.5) + delta = max (delta, 1.4142*sn); + endif + endif + + if (ratio >= 1e-4) + ## Successful iteration. + x += s; + xn = norm (dg .* x); + fval = fval1; + nsuciter ++; + suc = true; + endif + + niter ++; + + ## FIXME: should outputfcn be only called after a successful iteration? + if (! isempty (outfcn)) + optimvalues.iter = niter; + optimvalues.funccount = nfev; + optimvalues.fval = fval; + optimvalues.searchdirection = s; + state = 'iter'; + stop = outfcn (x, optimvalues, state); + if (stop) + info = -1; + break; + endif + endif + + ## Tests for termination conditions. A mysterious place, anything + ## can happen if you change something here... + + ## The rule of thumb (which I'm not sure M*b is quite following) + ## is that for a tolerance that depends on scaling, only 0 makes + ## sense as a default value. But 0 usually means uselessly long + ## iterations, so we need scaling-independent tolerances wherever + ## possible. + + ## The following tests done only after successful step. + if (ratio >= 1e-4) + ## This one is classic. Note that we use scaled variables again, + ## but compare to scaled step, so nothing bad. + if (sn <= tolx*xn) + info = 2; + ## Again a classic one. + elseif (actred < tolf) + info = 3; + endif + endif + + endwhile + endwhile + + ## Restore original shapes. + x = reshape (x, xsiz); + + output.iterations = niter; + output.successful = nsuciter; + output.funcCount = nfev; + + if (nargout > 5) + hess = hesr'*hesr; + endif + +endfunction + +## An assistant function that evaluates a function handle and checks for +## bad results. +function [fx, gx] = guarded_eval (fun, x) + if (nargout > 1) + [fx, gx] = fun (x); + else + fx = fun (x); + gx = []; + endif + + if (! (isreal (fx) && isreal (gx))) + error ("fminunc:notreal", "fminunc: non-real value encountered"); + elseif (any (isnan (fx(:)))) + error ("fminunc:isnan", "fminunc: NaN value encountered"); + endif +endfunction + +%!function f = __rosenb (x) +%! n = length (x); +%! f = sumsq (1 - x(1:n-1)) + 100 * sumsq (x(2:n) - x(1:n-1).^2); +%!endfunction +%!test +%! [x, fval, info, out] = fminunc (@__rosenb, [5, -5]); +%! tol = 2e-5; +%! assert (info > 0); +%! assert (x, ones (1, 2), tol); +%! assert (fval, 0, tol); +%!test +%! [x, fval, info, out] = fminunc (@__rosenb, zeros (1, 4)); +%! tol = 2e-5; +%! assert (info > 0); +%! assert (x, ones (1, 4), tol); +%! assert (fval, 0, tol); + +## Solve the double dogleg trust-region minimization problem: +## Minimize 1/2*norm(r*x)^2 subject to the constraint norm(d.*x) <= delta, +## x being a convex combination of the gauss-newton and scaled gradient. + +## TODO: error checks +## TODO: handle singularity, or leave it up to mldivide? + +function x = __doglegm__ (r, g, d, delta) + ## Get Gauss-Newton direction. + b = r' \ g; + x = r \ b; + xn = norm (d .* x); + if (xn > delta) + ## GN is too big, get scaled gradient. + s = g ./ d; + sn = norm (s); + if (sn > 0) + ## Normalize and rescale. + s = (s / sn) ./ d; + ## Get the line minimizer in s direction. + tn = norm (r*s); + snm = (sn / tn) / tn; + if (snm < delta) + ## Get the dogleg path minimizer. + bn = norm (b); + dxn = delta/xn; snmd = snm/delta; + t = (bn/sn) * (bn/xn) * snmd; + t -= dxn * snmd^2 - sqrt ((t-dxn)^2 + (1-dxn^2)*(1-snmd^2)); + alpha = dxn*(1-snmd^2) / t; + else + alpha = 0; + endif + else + alpha = delta / xn; + snm = 0; + endif + ## Form the appropriate convex combination. + x = alpha * x + ((1-alpha) * min (snm, delta)) * s; + endif +endfunction diff --git a/octave_packages/m/optimization/fsolve.m b/octave_packages/m/optimization/fsolve.m new file mode 100644 index 0000000..cded127 --- /dev/null +++ b/octave_packages/m/optimization/fsolve.m @@ -0,0 +1,610 @@ +## Copyright (C) 2008-2012 VZLU Prague, a.s. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Author: Jaroslav Hajek + +## -*- texinfo -*- +## @deftypefn {Function File} {} fsolve (@var{fcn}, @var{x0}, @var{options}) +## @deftypefnx {Function File} {[@var{x}, @var{fvec}, @var{info}, @var{output}, @var{fjac}] =} fsolve (@var{fcn}, @dots{}) +## Solve a system of nonlinear equations defined by the function @var{fcn}. +## @var{fcn} should accept a vector (array) defining the unknown variables, +## and return a vector of left-hand sides of the equations. Right-hand sides +## are defined to be zeros. +## In other words, this function attempts to determine a vector @var{x} such +## that @code{@var{fcn} (@var{x})} gives (approximately) all zeros. +## @var{x0} determines a starting guess. The shape of @var{x0} is preserved +## in all calls to @var{fcn}, but otherwise it is treated as a column vector. +## @var{options} is a structure specifying additional options. +## Currently, @code{fsolve} recognizes these options: +## @code{"FunValCheck"}, @code{"OutputFcn"}, @code{"TolX"}, +## @code{"TolFun"}, @code{"MaxIter"}, @code{"MaxFunEvals"}, +## @code{"Jacobian"}, @code{"Updating"}, @code{"ComplexEqn"} +## @code{"TypicalX"}, @code{"AutoScaling"} and @code{"FinDiffType"}. +## +## If @code{"Jacobian"} is @code{"on"}, it specifies that @var{fcn}, +## called with 2 output arguments, also returns the Jacobian matrix +## of right-hand sides at the requested point. @code{"TolX"} specifies +## the termination tolerance in the unknown variables, while +## @code{"TolFun"} is a tolerance for equations. Default is @code{1e-7} +## for both @code{"TolX"} and @code{"TolFun"}. +## +## If @code{"AutoScaling"} is on, the variables will be automatically scaled +## according to the column norms of the (estimated) Jacobian. As a result, +## TolF becomes scaling-independent. By default, this option is off, because +## it may sometimes deliver unexpected (though mathematically correct) results. +## +## If @code{"Updating"} is "on", the function will attempt to use Broyden +## updates to update the Jacobian, in order to reduce the amount of Jacobian +## calculations. +## If your user function always calculates the Jacobian (regardless of number +## of output arguments), this option provides no advantage and should be set to +## false. +## +## @code{"ComplexEqn"} is @code{"on"}, @code{fsolve} will attempt to solve +## complex equations in complex variables, assuming that the equations possess a +## complex derivative (i.e., are holomorphic). If this is not what you want, +## should unpack the real and imaginary parts of the system to get a real +## system. +## +## For description of the other options, see @code{optimset}. +## +## On return, @var{fval} contains the value of the function @var{fcn} +## evaluated at @var{x}, and @var{info} may be one of the following values: +## +## @table @asis +## @item 1 +## Converged to a solution point. Relative residual error is less than +## specified by TolFun. +## +## @item 2 +## Last relative step size was less that TolX. +## +## @item 3 +## Last relative decrease in residual was less than TolF. +## +## @item 0 +## Iteration limit exceeded. +## +## @item -3 +## The trust region radius became excessively small. +## @end table +## +## Note: If you only have a single nonlinear equation of one variable, using +## @code{fzero} is usually a much better idea. +## +## Note about user-supplied Jacobians: +## As an inherent property of the algorithm, Jacobian is always requested for a +## solution vector whose residual vector is already known, and it is the last +## accepted successful step. Often this will be one of the last two calls, but +## not always. If the savings by reusing intermediate results from residual +## calculation in Jacobian calculation are significant, the best strategy is to +## employ OutputFcn: After a vector is evaluated for residuals, if OutputFcn is +## called with that vector, then the intermediate results should be saved for +## future Jacobian evaluation, and should be kept until a Jacobian evaluation +## is requested or until outputfcn is called with a different vector, in which +## case they should be dropped in favor of this most recent vector. A short +## example how this can be achieved follows: +## +## @example +## function [fvec, fjac] = user_func (x, optimvalues, state) +## persistent sav = [], sav0 = []; +## if (nargin == 1) +## ## evaluation call +## if (nargout == 1) +## sav0.x = x; # mark saved vector +## ## calculate fvec, save results to sav0. +## elseif (nargout == 2) +## ## calculate fjac using sav. +## endif +## else +## ## outputfcn call. +## if (all (x == sav0.x)) +## sav = sav0; +## endif +## ## maybe output iteration status, etc. +## endif +## endfunction +## +## ## @dots{} +## +## fsolve (@@user_func, x0, optimset ("OutputFcn", @@user_func, @dots{})) +## @end example +## @seealso{fzero, optimset} +## @end deftypefn + +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fsolve"); + +function [x, fvec, info, output, fjac] = fsolve (fcn, x0, options = struct ()) + + ## Get default options if requested. + if (nargin == 1 && ischar (fcn) && strcmp (fcn, 'defaults')) + x = optimset ("MaxIter", 400, "MaxFunEvals", Inf, \ + "Jacobian", "off", "TolX", 1e-7, "TolFun", 1e-7, + "OutputFcn", [], "Updating", "on", "FunValCheck", "off", + "ComplexEqn", "off", "FinDiffType", "central", + "TypicalX", [], "AutoScaling", "off"); + return; + endif + + if (nargin < 2 || nargin > 3 || ! ismatrix (x0)) + print_usage (); + endif + + if (ischar (fcn)) + fcn = str2func (fcn, "global"); + elseif (iscell (fcn)) + fcn = @(x) make_fcn_jac (x, fcn{1}, fcn{2}); + endif + + xsiz = size (x0); + n = numel (x0); + + has_jac = strcmpi (optimget (options, "Jacobian", "off"), "on"); + cdif = strcmpi (optimget (options, "FinDiffType", "central"), "central"); + maxiter = optimget (options, "MaxIter", 400); + maxfev = optimget (options, "MaxFunEvals", Inf); + outfcn = optimget (options, "OutputFcn"); + updating = strcmpi (optimget (options, "Updating", "on"), "on"); + complexeqn = strcmpi (optimget (options, "ComplexEqn", "off"), "on"); + + ## Get scaling matrix using the TypicalX option. If set to "auto", the + ## scaling matrix is estimated using the Jacobian. + typicalx = optimget (options, "TypicalX"); + if (isempty (typicalx)) + typicalx = ones (n, 1); + endif + autoscale = strcmpi (optimget (options, "AutoScaling", "off"), "on"); + if (! autoscale) + dg = 1 ./ typicalx; + endif + + funvalchk = strcmpi (optimget (options, "FunValCheck", "off"), "on"); + + if (funvalchk) + ## Replace fcn with a guarded version. + fcn = @(x) guarded_eval (fcn, x, complexeqn); + endif + + ## These defaults are rather stringent. I think that normally, user + ## prefers accuracy to performance. + + macheps = eps (class (x0)); + + tolx = optimget (options, "TolX", 1e-7); + tolf = optimget (options, "TolFun", 1e-7); + + factor = 1; + + niter = 1; + nfev = 1; + + x = x0(:); + info = 0; + + ## Initial evaluation. + ## Handle arbitrary shapes of x and f and remember them. + fvec = fcn (reshape (x, xsiz)); + fsiz = size (fvec); + fvec = fvec(:); + fn = norm (fvec); + m = length (fvec); + n = length (x); + + if (! isempty (outfcn)) + optimvalues.iter = niter; + optimvalues.funccount = nfev; + optimvalues.fval = fn; + optimvalues.searchdirection = zeros (n, 1); + state = 'init'; + stop = outfcn (x, optimvalues, state); + if (stop) + info = -1; + break; + endif + endif + + nsuciter = 0; + + ## Outer loop. + while (niter < maxiter && nfev < maxfev && ! info) + + ## Calculate function value and Jacobian (possibly via FD). + if (has_jac) + [fvec, fjac] = fcn (reshape (x, xsiz)); + ## If the Jacobian is sparse, disable Broyden updating. + if (issparse (fjac)) + updating = false; + endif + fvec = fvec(:); + nfev ++; + else + fjac = __fdjac__ (fcn, reshape (x, xsiz), fvec, typicalx, cdif); + nfev += (1 + cdif) * length (x); + endif + + ## For square and overdetermined systems, we update a QR + ## factorization of the Jacobian to avoid solving a full system in each + ## step. In this case, we pass a triangular matrix to __dogleg__. + useqr = updating && m >= n && n > 10; + + if (useqr) + ## FIXME: Currently, pivoting is mostly useless because the \ operator + ## cannot exploit the resulting props of the triangular factor. + ## Unpivoted QR is significantly faster so it doesn't seem right to pivot + ## just to get invariance. Original MINPACK didn't pivot either, at least + ## when qr updating was used. + [q, r] = qr (fjac, 0); + endif + + if (autoscale) + ## Get column norms, use them as scaling factors. + jcn = norm (fjac, 'columns').'; + if (niter == 1) + dg = jcn; + dg(dg == 0) = 1; + else + ## Rescale adaptively. + ## FIXME: the original minpack used the following rescaling strategy: + ## dg = max (dg, jcn); + ## but it seems not good if we start with a bad guess yielding Jacobian + ## columns with large norms that later decrease, because the corresponding + ## variable will still be overscaled. So instead, we only give the old + ## scaling a small momentum, but do not honor it. + + dg = max (0.1*dg, jcn); + endif + endif + + if (niter == 1) + xn = norm (dg .* x); + ## FIXME: something better? + delta = factor * max (xn, 1); + endif + + ## It also seems that in the case of fast (and inhomogeneously) changing + ## Jacobian, the Broyden updates are of little use, so maybe we could + ## skip them if a big disproportional change is expected. The question is, + ## of course, how to define the above terms :) + + lastratio = 0; + nfail = 0; + nsuc = 0; + decfac = 0.5; + + ## Inner loop. + while (niter <= maxiter && nfev < maxfev && ! info) + + ## Get trust-region model (dogleg) minimizer. + if (useqr) + qtf = q'*fvec; + s = - __dogleg__ (r, qtf, dg, delta); + w = qtf + r * s; + else + s = - __dogleg__ (fjac, fvec, dg, delta); + w = fvec + fjac * s; + endif + + sn = norm (dg .* s); + if (niter == 1) + delta = min (delta, sn); + endif + + fvec1 = fcn (reshape (x + s, xsiz)) (:); + fn1 = norm (fvec1); + nfev ++; + + if (fn1 < fn) + ## Scaled actual reduction. + actred = 1 - (fn1/fn)^2; + else + actred = -1; + endif + + ## Scaled predicted reduction, and ratio. + t = norm (w); + if (t < fn) + prered = 1 - (t/fn)^2; + ratio = actred / prered; + else + prered = 0; + ratio = 0; + endif + + ## Update delta. + if (ratio < min(max(0.1, 0.8*lastratio), 0.9)) + nsuc = 0; + nfail ++; + delta *= decfac; + decfac ^= 1.4142; + if (delta <= 1e1*macheps*xn) + ## Trust region became uselessly small. + info = -3; + break; + endif + else + lastratio = ratio; + decfac = 0.5; + nfail = 0; + nsuc ++; + if (abs (1-ratio) <= 0.1) + delta = 1.4142*sn; + elseif (ratio >= 0.5 || nsuc > 1) + delta = max (delta, 1.4142*sn); + endif + endif + + if (ratio >= 1e-4) + ## Successful iteration. + x += s; + xn = norm (dg .* x); + fvec = fvec1; + fn = fn1; + nsuciter ++; + endif + + niter ++; + + ## FIXME: should outputfcn be only called after a successful iteration? + if (! isempty (outfcn)) + optimvalues.iter = niter; + optimvalues.funccount = nfev; + optimvalues.fval = fn; + optimvalues.searchdirection = s; + state = 'iter'; + stop = outfcn (x, optimvalues, state); + if (stop) + info = -1; + break; + endif + endif + + ## Tests for termination conditions. A mysterious place, anything + ## can happen if you change something here... + + ## The rule of thumb (which I'm not sure M*b is quite following) + ## is that for a tolerance that depends on scaling, only 0 makes + ## sense as a default value. But 0 usually means uselessly long + ## iterations, so we need scaling-independent tolerances wherever + ## possible. + + ## FIXME -- why tolf*n*xn? If abs (e) ~ abs(x) * eps is a vector + ## of perturbations of x, then norm (fjac*e) <= eps*n*xn, i.e. by + ## tolf ~ eps we demand as much accuracy as we can expect. + if (fn <= tolf*n*xn) + info = 1; + ## The following tests done only after successful step. + elseif (ratio >= 1e-4) + ## This one is classic. Note that we use scaled variables again, + ## but compare to scaled step, so nothing bad. + if (sn <= tolx*xn) + info = 2; + ## Again a classic one. It seems weird to use the same tolf + ## for two different tests, but that's what M*b manual appears + ## to say. + elseif (actred < tolf) + info = 3; + endif + endif + + ## Criterion for recalculating Jacobian. + if (! updating || nfail == 2 || nsuciter < 2) + break; + endif + + ## Compute the scaled Broyden update. + if (useqr) + u = (fvec1 - q*w) / sn; + v = dg .* ((dg .* s) / sn); + + ## Update the QR factorization. + [q, r] = qrupdate (q, r, u, v); + else + u = (fvec1 - w); + v = dg .* ((dg .* s) / sn); + + ## update the Jacobian + fjac += u * v'; + endif + endwhile + endwhile + + ## Restore original shapes. + x = reshape (x, xsiz); + fvec = reshape (fvec, fsiz); + + output.iterations = niter; + output.successful = nsuciter; + output.funcCount = nfev; + +endfunction + +## An assistant function that evaluates a function handle and checks for +## bad results. +function [fx, jx] = guarded_eval (fun, x, complexeqn) + if (nargout > 1) + [fx, jx] = fun (x); + else + fx = fun (x); + jx = []; + endif + + if (! complexeqn && ! (isreal (fx) && isreal (jx))) + error ("fsolve:notreal", "fsolve: non-real value encountered"); + elseif (complexeqn && ! (isnumeric (fx) && isnumeric(jx))) + error ("fsolve:notnum", "fsolve: non-numeric value encountered"); + elseif (any (isnan (fx(:)))) + error ("fsolve:isnan", "fsolve: NaN value encountered"); + endif +endfunction + +function [fx, jx] = make_fcn_jac (x, fcn, fjac) + fx = fcn (x); + if (nargout == 2) + jx = fjac (x); + endif +endfunction + +%!function retval = __f (p) +%! x = p(1); +%! y = p(2); +%! z = p(3); +%! retval = zeros (3, 1); +%! retval(1) = sin(x) + y**2 + log(z) - 7; +%! retval(2) = 3*x + 2**y -z**3 + 1; +%! retval(3) = x + y + z - 5; +%!endfunction +%!test +%! x_opt = [ 0.599054; +%! 2.395931; +%! 2.005014 ]; +%! tol = 1.0e-5; +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ]); +%! assert (info > 0); +%! assert (norm (x - x_opt, Inf) < tol); +%! assert (norm (fval) < tol); + +%!function retval = __f (p) +%! x = p(1); +%! y = p(2); +%! z = p(3); +%! w = p(4); +%! retval = zeros (4, 1); +%! retval(1) = 3*x + 4*y + exp (z + w) - 1.007; +%! retval(2) = 6*x - 4*y + exp (3*z + w) - 11; +%! retval(3) = x^4 - 4*y^2 + 6*z - 8*w - 20; +%! retval(4) = x^2 + 2*y^3 + z - w - 4; +%!endfunction +%!test +%! x_opt = [ -0.767297326653401, 0.590671081117440, 1.47190018629642, -1.52719341133957 ]; +%! tol = 1.0e-5; +%! [x, fval, info] = fsolve (@__f, [-1, 1, 2, -1]); +%! assert (info > 0); +%! assert (norm (x - x_opt, Inf) < tol); +%! assert (norm (fval) < tol); + +%!function retval = __f (p) +%! x = p(1); +%! y = p(2); +%! z = p(3); +%! retval = zeros (3, 1); +%! retval(1) = sin(x) + y**2 + log(z) - 7; +%! retval(2) = 3*x + 2**y -z**3 + 1; +%! retval(3) = x + y + z - 5; +%! retval(4) = x*x + y - z*log(z) - 1.36; +%!endfunction +%!test +%! x_opt = [ 0.599054; +%! 2.395931; +%! 2.005014 ]; +%! tol = 1.0e-5; +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ]); +%! assert (info > 0); +%! assert (norm (x - x_opt, Inf) < tol); +%! assert (norm (fval) < tol); + +%!function retval = __f (p) +%! x = p(1); +%! y = p(2); +%! z = p(3); +%! retval = zeros (3, 1); +%! retval(1) = sin(x) + y**2 + log(z) - 7; +%! retval(2) = 3*x + 2**y -z**3 + 1; +%! retval(3) = x + y + z - 5; +%!endfunction +%!test +%! x_opt = [ 0.599054; +%! 2.395931; +%! 2.005014 ]; +%! tol = 1.0e-5; +%! opt = optimset ("Updating", "qrp"); +%! [x, fval, info] = fsolve (@__f, [ 0.5; 2.0; 2.5 ], opt); +%! assert (info > 0); +%! assert (norm (x - x_opt, Inf) < tol); +%! assert (norm (fval) < tol); + +%!test +%! b0 = 3; +%! a0 = 0.2; +%! x = 0:.5:5; +%! noise = 1e-5 * sin (100*x); +%! y = exp (-a0*x) + b0 + noise; +%! c_opt = [a0, b0]; +%! tol = 1e-5; +%! +%! [c, fval, info, output] = fsolve (@(c) (exp(-c(1)*x) + c(2) - y), [0, 0]); +%! assert (info > 0); +%! assert (norm (c - c_opt, Inf) < tol); +%! assert (norm (fval) < norm (noise)); + + +%!function y = cfun (x) +%! y(1) = (1+i)*x(1)^2 - (1-i)*x(2) - 2; +%! y(2) = sqrt (x(1)*x(2)) - (1-2i)*x(3) + (3-4i); +%! y(3) = x(1) * x(2) - x(3)^2 + (3+2i); +%!endfunction + +%!test +%! x_opt = [-1+i, 1-i, 2+i]; +%! x = [i, 1, 1+i]; +%! +%! [x, f, info] = fsolve (@cfun, x, optimset ("ComplexEqn", "on")); +%! tol = 1e-5; +%! assert (norm (f) < tol); +%! assert (norm (x - x_opt, Inf) < tol); + +## Solve the double dogleg trust-region least-squares problem: +## Minimize norm(r*x-b) subject to the constraint norm(d.*x) <= delta, +## x being a convex combination of the gauss-newton and scaled gradient. + +## TODO: error checks +## TODO: handle singularity, or leave it up to mldivide? + +function x = __dogleg__ (r, b, d, delta) + ## Get Gauss-Newton direction. + x = r \ b; + xn = norm (d .* x); + if (xn > delta) + ## GN is too big, get scaled gradient. + s = (r' * b) ./ d; + sn = norm (s); + if (sn > 0) + ## Normalize and rescale. + s = (s / sn) ./ d; + ## Get the line minimizer in s direction. + tn = norm (r*s); + snm = (sn / tn) / tn; + if (snm < delta) + ## Get the dogleg path minimizer. + bn = norm (b); + dxn = delta/xn; snmd = snm/delta; + t = (bn/sn) * (bn/xn) * snmd; + t -= dxn * snmd^2 - sqrt ((t-dxn)^2 + (1-dxn^2)*(1-snmd^2)); + alpha = dxn*(1-snmd^2) / t; + else + alpha = 0; + endif + else + alpha = delta / xn; + snm = 0; + endif + ## Form the appropriate convex combination. + x = alpha * x + ((1-alpha) * min (snm, delta)) * s; + endif +endfunction + diff --git a/octave_packages/m/optimization/fzero.m b/octave_packages/m/optimization/fzero.m new file mode 100644 index 0000000..8a3e9b6 --- /dev/null +++ b/octave_packages/m/optimization/fzero.m @@ -0,0 +1,363 @@ +## Copyright (C) 2008-2012 VZLU Prague, a.s. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Author: Jaroslav Hajek + +## -*- texinfo -*- +## @deftypefn {Function File} {} fzero (@var{fun}, @var{x0}) +## @deftypefnx {Function File} {} fzero (@var{fun}, @var{x0}, @var{options}) +## @deftypefnx {Function File} {[@var{x}, @var{fval}, @var{info}, @var{output}] =} fzero (@dots{}) +## Find a zero of a univariate function. +## +## @var{fun} is a function handle, inline function, or string +## containing the name of the function to evaluate. +## @var{x0} should be a two-element vector specifying two points which +## bracket a zero. In other words, there must be a change in sign of the +## function between @var{x0}(1) and @var{x0}(2). More mathematically, the +## following must hold +## +## @example +## sign (@var{fun}(@var{x0}(1))) * sign (@var{fun}(@var{x0}(2))) <= 0 +## @end example +## +## If @var{x0} is a single scalar then several nearby and distant +## values are probed in an attempt to obtain a valid bracketing. If this +## is not successful, the function fails. +## @var{options} is a structure specifying additional options. +## Currently, @code{fzero} +## recognizes these options: @code{"FunValCheck"}, @code{"OutputFcn"}, +## @code{"TolX"}, @code{"MaxIter"}, @code{"MaxFunEvals"}. +## For a description of these options, see @ref{doc-optimset,,optimset}. +## +## On exit, the function returns @var{x}, the approximate zero point +## and @var{fval}, the function value thereof. +## @var{info} is an exit flag that can have these values: +## +## @itemize +## @item 1 +## The algorithm converged to a solution. +## +## @item 0 +## Maximum number of iterations or function evaluations has been reached. +## +## @item -1 +## The algorithm has been terminated from user output function. +## +## @item -5 +## The algorithm may have converged to a singular point. +## @end itemize +## +## @var{output} is a structure containing runtime information about the +## @code{fzero} algorithm. Fields in the structure are: +## +## @itemize +## @item iterations +## Number of iterations through loop. +## +## @item nfev +## Number of function evaluations. +## +## @item bracketx +## A two-element vector with the final bracketing of the zero along the x-axis. +## +## @item brackety +## A two-element vector with the final bracketing of the zero along the y-axis. +## @end itemize +## @seealso{optimset, fsolve} +## @end deftypefn + +## This is essentially the ACM algorithm 748: Enclosing Zeros of +## Continuous Functions due to Alefeld, Potra and Shi, ACM Transactions +## on Mathematical Software, Vol. 21, No. 3, September 1995. Although +## the workflow should be the same, the structure of the algorithm has +## been transformed non-trivially; instead of the authors' approach of +## sequentially calling building blocks subprograms we implement here a +## FSM version using one interior point determination and one bracketing +## per iteration, thus reducing the number of temporary variables and +## simplifying the algorithm structure. Further, this approach reduces +## the need for external functions and error handling. The algorithm has +## also been slightly modified. + +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("fzero"); + +function [x, fval, info, output] = fzero (fun, x0, options = struct ()) + + ## Get default options if requested. + if (nargin == 1 && ischar (fun) && strcmp (fun, 'defaults')) + x = optimset ("MaxIter", Inf, "MaxFunEvals", Inf, "TolX", 1e-8, \ + "OutputFcn", [], "FunValCheck", "off"); + return; + endif + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (ischar (fun)) + fun = str2func (fun, "global"); + endif + + ## TODO + ## displev = optimget (options, "Display", "notify"); + funvalchk = strcmpi (optimget (options, "FunValCheck", "off"), "on"); + outfcn = optimget (options, "OutputFcn"); + tolx = optimget (options, "TolX", 1e-8); + maxiter = optimget (options, "MaxIter", Inf); + maxfev = optimget (options, "MaxFunEvals", Inf); + + persistent mu = 0.5; + + if (funvalchk) + ## Replace fun with a guarded version. + fun = @(x) guarded_eval (fun, x); + endif + + ## The default exit flag if exceeded number of iterations. + info = 0; + niter = 0; + nfev = 0; + + x = fval = a = fa = b = fb = NaN; + eps = eps (class (x0)); + + ## Prepare... + a = x0(1); + fa = fun (a); + nfev = 1; + if (length (x0) > 1) + b = x0(2); + fb = fun (b); + nfev += 1; + else + ## Try to get b. + if (a == 0) + aa = 1; + else + aa = a; + endif + for b = [0.9*aa, 1.1*aa, aa-1, aa+1, 0.5*aa 1.5*aa, -aa, 2*aa, -10*aa, 10*aa] + fb = fun (b); nfev += 1; + if (sign (fa) * sign (fb) <= 0) + break; + endif + endfor + endif + + if (b < a) + u = a; + a = b; + b = u; + + fu = fa; + fa = fb; + fb = fu; + endif + + if (! (sign (fa) * sign (fb) <= 0)) + error ("fzero:bracket", "fzero: not a valid initial bracketing"); + endif + + slope0 = (fb - fa) / (b - a); + + if (fa == 0) + b = a; + fb = fa; + elseif (fb == 0) + a = b; + fa = fb; + endif + + itype = 1; + + if (abs (fa) < abs (fb)) + u = a; fu = fa; + else + u = b; fu = fb; + endif + + d = e = u; + fd = fe = fu; + mba = mu*(b - a); + while (niter < maxiter && nfev < maxfev) + switch (itype) + case 1 + ## The initial test. + if (b - a <= 2*(2 * abs (u) * eps + tolx)) + x = u; fval = fu; + info = 1; + break; + endif + if (abs (fa) <= 1e3*abs (fb) && abs (fb) <= 1e3*abs (fa)) + ## Secant step. + c = u - (a - b) / (fa - fb) * fu; + else + ## Bisection step. + c = 0.5*(a + b); + endif + d = u; fd = fu; + itype = 5; + case {2, 3} + l = length (unique ([fa, fb, fd, fe])); + if (l == 4) + ## Inverse cubic interpolation. + q11 = (d - e) * fd / (fe - fd); + q21 = (b - d) * fb / (fd - fb); + q31 = (a - b) * fa / (fb - fa); + d21 = (b - d) * fd / (fd - fb); + d31 = (a - b) * fb / (fb - fa); + q22 = (d21 - q11) * fb / (fe - fb); + q32 = (d31 - q21) * fa / (fd - fa); + d32 = (d31 - q21) * fd / (fd - fa); + q33 = (d32 - q22) * fa / (fe - fa); + c = a + q31 + q32 + q33; + endif + if (l < 4 || sign (c - a) * sign (c - b) > 0) + ## Quadratic interpolation + newton. + a0 = fa; + a1 = (fb - fa)/(b - a); + a2 = ((fd - fb)/(d - b) - a1) / (d - a); + ## Modification 1: this is simpler and does not seem to be worse. + c = a - a0/a1; + if (a2 != 0) + c = a - a0/a1; + for i = 1:itype + pc = a0 + (a1 + a2*(c - b))*(c - a); + pdc = a1 + a2*(2*c - a - b); + if (pdc == 0) + c = a - a0/a1; + break; + endif + c -= pc/pdc; + endfor + endif + endif + itype += 1; + case 4 + ## Double secant step. + c = u - 2*(b - a)/(fb - fa)*fu; + ## Bisect if too far. + if (abs (c - u) > 0.5*(b - a)) + c = 0.5 * (b + a); + endif + itype = 5; + case 5 + ## Bisection step. + c = 0.5 * (b + a); + itype = 2; + endswitch + + ## Don't let c come too close to a or b. + delta = 2*0.7*(2 * abs (u) * eps + tolx); + if ((b - a) <= 2*delta) + c = (a + b)/2; + else + c = max (a + delta, min (b - delta, c)); + endif + + ## Calculate new point. + x = c; + fval = fc = fun (c); + niter ++; nfev ++; + + ## Modification 2: skip inverse cubic interpolation if + ## nonmonotonicity is detected. + if (sign (fc - fa) * sign (fc - fb) >= 0) + ## The new point broke monotonicity. + ## Disable inverse cubic. + fe = fc; + else + e = d; fe = fd; + endif + + ## Bracketing. + if (sign (fa) * sign (fc) < 0) + d = b; fd = fb; + b = c; fb = fc; + elseif (sign (fb) * sign (fc) < 0) + d = a; fd = fa; + a = c; fa = fc; + elseif (fc == 0) + a = b = c; fa = fb = fc; + info = 1; + break; + else + ## This should never happen. + error ("fzero:bracket", "fzero: zero point is not bracketed"); + endif + + ## If there's an output function, use it now. + if (outfcn) + optv.funccount = nfev; + optv.fval = fval; + optv.iteration = niter; + if (outfcn (x, optv, "iter")) + info = -1; + break; + endif + endif + + if (abs (fa) < abs (fb)) + u = a; fu = fa; + else + u = b; fu = fb; + endif + if (b - a <= 2*(2 * abs (u) * eps + tolx)) + info = 1; + break; + endif + + ## Skip bisection step if successful reduction. + if (itype == 5 && (b - a) <= mba) + itype = 2; + endif + if (itype == 2) + mba = mu * (b - a); + endif + endwhile + + ## Check solution for a singularity by examining slope + if (info == 1) + if ((b - a) != 0 && abs ((fb - fa)/(b - a) / slope0) > max (1e6, 0.5/(eps+tolx))) + info = -5; + endif + endif + + output.iterations = niter; + output.funcCount = nfev; + output.bracketx = [a, b]; + output.brackety = [fa, fb]; + +endfunction + +## An assistant function that evaluates a function handle and checks for +## bad results. +function fx = guarded_eval (fun, x) + fx = fun (x); + fx = fx(1); + if (! isreal (fx)) + error ("fzero:notreal", "fzero: non-real value encountered"); + elseif (isnan (fx)) + error ("fzero:isnan", "fzero: NaN value encountered"); + endif +endfunction + +%!shared opt0 +%! opt0 = optimset ("tolx", 0); +%!assert(fzero(@cos, [0, 3], opt0), pi/2, 10*eps) +%!assert(fzero(@(x) x^(1/3) - 1e-8, [0,1], opt0), 1e-24, 1e-22*eps) diff --git a/octave_packages/m/optimization/glpk.m b/octave_packages/m/optimization/glpk.m new file mode 100644 index 0000000..1afd5f0 --- /dev/null +++ b/octave_packages/m/optimization/glpk.m @@ -0,0 +1,597 @@ +## Copyright (C) 2005-2012 Nicolo' Giorgetti +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{xopt}, @var{fmin}, @var{status}, @var{extra}] =} glpk (@var{c}, @var{A}, @var{b}, @var{lb}, @var{ub}, @var{ctype}, @var{vartype}, @var{sense}, @var{param}) +## Solve a linear program using the GNU @sc{glpk} library. Given three +## arguments, @code{glpk} solves the following standard LP: +## @tex +## $$ +## \min_x C^T x +## $$ +## @end tex +## @ifnottex +## +## @example +## min C'*x +## @end example +## +## @end ifnottex +## subject to +## @tex +## $$ +## Ax = b \qquad x \geq 0 +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## A*x = b +## x >= 0 +## @end group +## @end example +## +## @end ifnottex +## but may also solve problems of the form +## @tex +## $$ +## [ \min_x | \max_x ] C^T x +## $$ +## @end tex +## @ifnottex +## +## @example +## [ min | max ] C'*x +## @end example +## +## @end ifnottex +## subject to +## @tex +## $$ +## Ax [ = | \leq | \geq ] b \qquad LB \leq x \leq UB +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## A*x [ "=" | "<=" | ">=" ] b +## x >= LB +## x <= UB +## @end group +## @end example +## +## @end ifnottex +## +## Input arguments: +## +## @table @var +## @item c +## A column array containing the objective function coefficients. +## +## @item A +## A matrix containing the constraints coefficients. +## +## @item b +## A column array containing the right-hand side value for each constraint +## in the constraint matrix. +## +## @item lb +## An array containing the lower bound on each of the variables. If +## @var{lb} is not supplied, the default lower bound for the variables is +## zero. +## +## @item ub +## An array containing the upper bound on each of the variables. If +## @var{ub} is not supplied, the default upper bound is assumed to be +## infinite. +## +## @item ctype +## An array of characters containing the sense of each constraint in the +## constraint matrix. Each element of the array may be one of the +## following values +## @table @asis +## @item "F" +## A free (unbounded) constraint (the constraint is ignored). +## +## @item "U" +## An inequality constraint with an upper bound (@code{A(i,:)*x <= b(i)}). +## +## @item "S" +## An equality constraint (@code{A(i,:)*x = b(i)}). +## +## @item "L" +## An inequality with a lower bound (@code{A(i,:)*x >= b(i)}). +## +## @item "D" +## An inequality constraint with both upper and lower bounds +## (@code{A(i,:)*x >= -b(i)} @emph{and} (@code{A(i,:)*x <= b(i)}). +## @end table +## +## @item vartype +## A column array containing the types of the variables. +## @table @asis +## @item "C" +## A continuous variable. +## +## @item "I" +## An integer variable. +## @end table +## +## @item sense +## If @var{sense} is 1, the problem is a minimization. If @var{sense} is +## -1, the problem is a maximization. The default value is 1. +## +## @item param +## A structure containing the following parameters used to define the +## behavior of solver. Missing elements in the structure take on default +## values, so you only need to set the elements that you wish to change +## from the default. +## +## Integer parameters: +## +## @table @code +## @item msglev (@w{@code{LPX_K_MSGLEV}}, default: 1) +## Level of messages output by solver routines: +## @table @asis +## @item 0 +## No output. +## +## @item 1 +## Error messages only. +## +## @item 2 +## Normal output. +## +## @item 3 +## Full output (includes informational messages). +## @end table +## +## @item scale (@w{@code{LPX_K_SCALE}}, default: 1) +## Scaling option: +## @table @asis +## @item 0 +## No scaling. +## +## @item 1 +## Equilibration scaling. +## +## @item 2 +## Geometric mean scaling, then equilibration scaling. +## @end table +## +## @item dual (@w{@code{LPX_K_DUAL}}, default: 0) +## Dual simplex option: +## @table @asis +## @item 0 +## Do not use the dual simplex. +## +## @item 1 +## If initial basic solution is dual feasible, use the dual simplex. +## @end table +## +## @item price (@w{@code{LPX_K_PRICE}}, default: 1) +## Pricing option (for both primal and dual simplex): +## @table @asis +## @item 0 +## Textbook pricing. +## +## @item 1 +## Steepest edge pricing. +## @end table +## +## @item round (@w{@code{LPX_K_ROUND}}, default: 0) +## Solution rounding option: +## @table @asis +## @item 0 +## Report all primal and dual values "as is". +## +## @item 1 +## Replace tiny primal and dual values by exact zero. +## @end table +## +## @item itlim (@w{@code{LPX_K_ITLIM}}, default: -1) +## Simplex iterations limit. If this value is positive, it is decreased by +## one each time when one simplex iteration has been performed, and +## reaching zero value signals the solver to stop the search. Negative +## value means no iterations limit. +## +## @item itcnt (@w{@code{LPX_K_OUTFRQ}}, default: 200) +## Output frequency, in iterations. This parameter specifies how +## frequently the solver sends information about the solution to the +## standard output. +## +## @item branch (@w{@code{LPX_K_BRANCH}}, default: 2) +## Branching heuristic option (for MIP only): +## @table @asis +## @item 0 +## Branch on the first variable. +## +## @item 1 +## Branch on the last variable. +## +## @item 2 +## Branch using a heuristic by Driebeck and Tomlin. +## @end table +## +## @item btrack (@w{@code{LPX_K_BTRACK}}, default: 2) +## Backtracking heuristic option (for MIP only): +## @table @asis +## @item 0 +## Depth first search. +## +## @item 1 +## Breadth first search. +## +## @item 2 +## Backtrack using the best projection heuristic. +## @end table +## +## @item presol (@w{@code{LPX_K_PRESOL}}, default: 1) +## If this flag is set, the routine lpx_simplex solves the problem using +## the built-in LP presolver. Otherwise the LP presolver is not used. +## +## @item lpsolver (default: 1) +## Select which solver to use. If the problem is a MIP problem this flag +## will be ignored. +## @table @asis +## @item 1 +## Revised simplex method. +## +## @item 2 +## Interior point method. +## @end table +## +## @item save (default: 0) +## If this parameter is nonzero, save a copy of the problem in +## CPLEX LP format to the file @file{"outpb.lp"}. There is currently no +## way to change the name of the output file. +## @end table +## +## Real parameters: +## +## @table @code +## @item relax (@w{@code{LPX_K_RELAX}}, default: 0.07) +## Relaxation parameter used in the ratio test. If it is zero, the textbook +## ratio test is used. If it is non-zero (should be positive), Harris' +## two-pass ratio test is used. In the latter case on the first pass of the +## ratio test basic variables (in the case of primal simplex) or reduced +## costs of non-basic variables (in the case of dual simplex) are allowed +## to slightly violate their bounds, but not more than +## @code{relax*tolbnd} or @code{relax*toldj (thus, @code{relax} is a +## percentage of @code{tolbnd} or @code{toldj}}. +## +## @item tolbnd (@w{@code{LPX_K_TOLBND}}, default: 10e-7) +## Relative tolerance used to check if the current basic solution is primal +## feasible. It is not recommended that you change this parameter unless you +## have a detailed understanding of its purpose. +## +## @item toldj (@w{@code{LPX_K_TOLDJ}}, default: 10e-7) +## Absolute tolerance used to check if the current basic solution is dual +## feasible. It is not recommended that you change this parameter unless you +## have a detailed understanding of its purpose. +## +## @item tolpiv (@w{@code{LPX_K_TOLPIV}}, default: 10e-9) +## Relative tolerance used to choose eligible pivotal elements of the +## simplex table. It is not recommended that you change this parameter unless +## you have a detailed understanding of its purpose. +## +## @item objll (@w{@code{LPX_K_OBJLL}}, default: -DBL_MAX) +## Lower limit of the objective function. If on the phase II the objective +## function reaches this limit and continues decreasing, the solver stops +## the search. This parameter is used in the dual simplex method only. +## +## @item objul (@w{@code{LPX_K_OBJUL}}, default: +DBL_MAX) +## Upper limit of the objective function. If on the phase II the objective +## function reaches this limit and continues increasing, the solver stops +## the search. This parameter is used in the dual simplex only. +## +## @item tmlim (@w{@code{LPX_K_TMLIM}}, default: -1.0) +## Searching time limit, in seconds. If this value is positive, it is +## decreased each time when one simplex iteration has been performed by the +## amount of time spent for the iteration, and reaching zero value signals +## the solver to stop the search. Negative value means no time limit. +## +## @item outdly (@w{@code{LPX_K_OUTDLY}}, default: 0.0) +## Output delay, in seconds. This parameter specifies how long the solver +## should delay sending information about the solution to the standard +## output. Non-positive value means no delay. +## +## @item tolint (@w{@code{LPX_K_TOLINT}}, default: 10e-5) +## Relative tolerance used to check if the current basic solution is integer +## feasible. It is not recommended that you change this parameter unless +## you have a detailed understanding of its purpose. +## +## @item tolobj (@w{@code{LPX_K_TOLOBJ}}, default: 10e-7) +## Relative tolerance used to check if the value of the objective function +## is not better than in the best known integer feasible solution. It is +## not recommended that you change this parameter unless you have a +## detailed understanding of its purpose. +## @end table +## @end table +## +## Output values: +## +## @table @var +## @item xopt +## The optimizer (the value of the decision variables at the optimum). +## +## @item fopt +## The optimum value of the objective function. +## +## @item status +## Status of the optimization. +## +## Simplex Method: +## @table @asis +## @item 180 (@w{@code{LPX_OPT}}) +## Solution is optimal. +## +## @item 181 (@w{@code{LPX_FEAS}}) +## Solution is feasible. +## +## @item 182 (@w{@code{LPX_INFEAS}}) +## Solution is infeasible. +## +## @item 183 (@w{@code{LPX_NOFEAS}}) +## Problem has no feasible solution. +## +## @item 184 (@w{@code{LPX_UNBND}}) +## Problem has no unbounded solution. +## +## @item 185 (@w{@code{LPX_UNDEF}}) +## Solution status is undefined. +## @end table +## Interior Point Method: +## @table @asis +## @item 150 (@w{@code{LPX_T_UNDEF}}) +## The interior point method is undefined. +## +## @item 151 (@w{@code{LPX_T_OPT}}) +## The interior point method is optimal. +## @end table +## Mixed Integer Method: +## @table @asis +## @item 170 (@w{@code{LPX_I_UNDEF}}) +## The status is undefined. +## +## @item 171 (@w{@code{LPX_I_OPT}}) +## The solution is integer optimal. +## +## @item 172 (@w{@code{LPX_I_FEAS}}) +## Solution integer feasible but its optimality has not been proven +## +## @item 173 (@w{@code{LPX_I_NOFEAS}}) +## No integer feasible solution. +## @end table +## @noindent +## If an error occurs, @var{status} will contain one of the following +## codes: +## +## @table @asis +## @item 204 (@w{@code{LPX_E_FAULT}}) +## Unable to start the search. +## +## @item 205 (@w{@code{LPX_E_OBJLL}}) +## Objective function lower limit reached. +## +## @item 206 (@w{@code{LPX_E_OBJUL}}) +## Objective function upper limit reached. +## +## @item 207 (@w{@code{LPX_E_ITLIM}}) +## Iterations limit exhausted. +## +## @item 208 (@w{@code{LPX_E_TMLIM}}) +## Time limit exhausted. +## +## @item 209 (@w{@code{LPX_E_NOFEAS}}) +## No feasible solution. +## +## @item 210 (@w{@code{LPX_E_INSTAB}}) +## Numerical instability. +## +## @item 211 (@w{@code{LPX_E_SING}}) +## Problems with basis matrix. +## +## @item 212 (@w{@code{LPX_E_NOCONV}}) +## No convergence (interior). +## +## @item 213 (@w{@code{LPX_E_NOPFS}}) +## No primal feasible solution (LP presolver). +## +## @item 214 (@w{@code{LPX_E_NODFS}}) +## No dual feasible solution (LP presolver). +## @end table +## +## @item extra +## A data structure containing the following fields: +## @table @code +## @item lambda +## Dual variables. +## +## @item redcosts +## Reduced Costs. +## +## @item time +## Time (in seconds) used for solving LP/MIP problem. +## +## @item mem +## Memory (in bytes) used for solving LP/MIP problem (this is not +## available if the version of @sc{glpk} is 4.15 or later). +## @end table +## @end table +## +## Example: +## +## @example +## @group +## c = [10, 6, 4]'; +## A = [ 1, 1, 1; +## 10, 4, 5; +## 2, 2, 6]; +## b = [100, 600, 300]'; +## lb = [0, 0, 0]'; +## ub = []; +## ctype = "UUU"; +## vartype = "CCC"; +## s = -1; +## +## param.msglev = 1; +## param.itlim = 100; +## +## [xmin, fmin, status, extra] = ... +## glpk (c, A, b, lb, ub, ctype, vartype, s, param); +## @end group +## @end example +## @end deftypefn + +## Author: Nicolo' Giorgetti +## Adapted-by: jwe + +function [xopt, fmin, status, extra] = glpk (c, A, b, lb, ub, ctype, vartype, sense, param) + + ## If there is no input output the version and syntax + if (nargin < 3 || nargin > 9) + print_usage (); + return; + endif + + if (all (size (c) > 1) || iscomplex (c) || ischar (c)) + error ("glpk:C must be a real vector"); + return; + endif + nx = length (c); + ## Force column vector. + c = c(:); + + ## 2) Matrix constraint + + if (isempty (A)) + error ("glpk: A cannot be an empty matrix"); + return; + endif + [nc, nxa] = size(A); + if (! isreal (A) || nxa != nx) + error ("glpk: A must be a real valued %d by %d matrix", nc, nx); + return; + endif + + ## 3) RHS + + if (isempty (b)) + error ("glpk: B cannot be an empty vector"); + return; + endif + if (! isreal (b) || length (b) != nc) + error ("glpk: B must be a real valued %d by 1 vector", nc); + return; + endif + + ## 4) Vector with the lower bound of each variable + + if (nargin > 3) + if (isempty (lb)) + lb = zeros (nx, 1); + elseif (! isreal (lb) || all (size (lb) > 1) || length (lb) != nx) + error ("glpk: LB must be a real valued %d by 1 column vector", nx); + return; + endif + else + lb = zeros (nx, 1); + endif + + ## 5) Vector with the upper bound of each variable + + if (nargin > 4) + if (isempty (ub)) + ub = Inf (nx, 1); + elseif (! isreal (ub) || all (size (ub) > 1) || length (ub) != nx) + error ("glpk: UB must be a real valued %d by 1 column vector", nx); + return; + endif + else + ub = Inf (nx, 1); + endif + + ## 6) Sense of each constraint + + if (nargin > 5) + if (isempty (ctype)) + ctype = repmat ("S", nc, 1); + elseif (! ischar (ctype) || all (size (ctype) > 1) || length (ctype) != nc) + error ("glpk: CTYPE must be a char valued vector of length %d", nc); + return; + elseif (! all (ctype == "F" | ctype == "U" | ctype == "S" + | ctype == "L" | ctype == "D")) + error ("glpk: CTYPE must contain only F, U, S, L, or D"); + return; + endif + else + ctype = repmat ("S", nc, 1); + endif + + ## 7) Vector with the type of variables + + if (nargin > 6) + if (isempty (vartype)) + vartype = repmat ("C", nx, 1); + elseif (! ischar (vartype) || all (size (vartype) > 1) + || length (vartype) != nx) + error ("glpk: VARTYPE must be a char valued vector of length %d", nx); + return; + elseif (! all (vartype == "C" | vartype == "I")) + error ("glpk: VARTYPE must contain only C or I"); + return; + endif + else + ## As default we consider continuous vars + vartype = repmat ("C", nx, 1); + endif + + ## 8) Sense of optimization + + if (nargin > 7) + if (isempty (sense)) + sense = 1; + elseif (ischar (sense) || all (size (sense) > 1) || ! isreal (sense)) + error ("glpk: SENSE must be an integer value"); + elseif (sense >= 0) + sense = 1; + else + sense = -1; + endif + else + sense = 1; + endif + + ## 9) Parameters vector + + if (nargin > 8) + if (! isstruct (param)) + error ("glpk: PARAM must be a structure"); + return; + endif + else + param = struct (); + endif + + [xopt, fmin, status, extra] = ... + __glpk__ (c, A, b, lb, ub, ctype, vartype, sense, param); + +endfunction diff --git a/octave_packages/m/optimization/lsqnonneg.m b/octave_packages/m/optimization/lsqnonneg.m new file mode 100644 index 0000000..0b1524b --- /dev/null +++ b/octave_packages/m/optimization/lsqnonneg.m @@ -0,0 +1,211 @@ +## Copyright (C) 2008-2012 Bill Denney +## Copyright (C) 2008 Jaroslav Hajek +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} lsqnonneg (@var{c}, @var{d}) +## @deftypefnx {Function File} {@var{x} =} lsqnonneg (@var{c}, @var{d}, @var{x0}) +## @deftypefnx {Function File} {[@var{x}, @var{resnorm}] =} lsqnonneg (@dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{resnorm}, @var{residual}] =} lsqnonneg (@dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{resnorm}, @var{residual}, @var{exitflag}] =} lsqnonneg (@dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{resnorm}, @var{residual}, @var{exitflag}, @var{output}] =} lsqnonneg (@dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{resnorm}, @var{residual}, @var{exitflag}, @var{output}, @var{lambda}] =} lsqnonneg (@dots{}) +## Minimize @code{norm (@var{c}*@var{x} - d)} subject to +## @code{@var{x} >= 0}. @var{c} and @var{d} must be real. @var{x0} is an +## optional initial guess for @var{x}. +## +## Outputs: +## @itemize @bullet +## @item resnorm +## +## The squared 2-norm of the residual: norm(@var{c}*@var{x}-@var{d})^2 +## +## @item residual +## +## The residual: @var{d}-@var{c}*@var{x} +## +## @item exitflag +## +## An indicator of convergence. 0 indicates that the iteration count +## was exceeded, and therefore convergence was not reached; >0 indicates +## that the algorithm converged. (The algorithm is stable and will +## converge given enough iterations.) +## +## @item output +## +## A structure with two fields: +## @itemize @bullet +## @item "algorithm": The algorithm used ("nnls") +## +## @item "iterations": The number of iterations taken. +## @end itemize +## +## @item lambda +## +## Not implemented. +## @end itemize +## @seealso{optimset, pqpnonneg} +## @end deftypefn + +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("lsqnonneg"); + +## This is implemented from Lawson and Hanson's 1973 algorithm on page +## 161 of Solving Least Squares Problems. + +function [x, resnorm, residual, exitflag, output, lambda] = lsqnonneg (c, d, x = [], options = struct ()) + + if (nargin == 1 && ischar (c) && strcmp (c, 'defaults')) + x = optimset ("MaxIter", 1e5); + return + endif + + if (! (nargin >= 2 && nargin <= 4 && ismatrix (c) && ismatrix (d) && isstruct (options))) + print_usage (); + endif + + ## Lawson-Hanson Step 1 (LH1): initialize the variables. + m = rows (c); + n = columns (c); + if (isempty (x)) + ## Initial guess is 0s. + x = zeros (n, 1); + else + ## ensure nonnegative guess. + x = max (x, 0); + endif + + useqr = m >= n; + max_iter = optimget (options, "MaxIter", 1e5); + + ## Initialize P, according to zero pattern of x. + p = find (x > 0).'; + if (useqr) + ## Initialize the QR factorization, economized form. + [q, r] = qr (c(:,p), 0); + endif + + iter = 0; + + ## LH3: test for completion. + while (iter < max_iter) + while (iter < max_iter) + iter++; + + ## LH6: compute the positive matrix and find the min norm solution + ## of the positive problem. + if (useqr) + xtmp = r \ q'*d; + else + xtmp = c(:,p) \ d; + endif + idx = find (xtmp < 0); + + if (isempty (idx)) + ## LH7: tmp solution found, iterate. + x(:) = 0; + x(p) = xtmp; + break; + else + ## LH8, LH9: find the scaling factor. + pidx = p(idx); + sf = x(pidx)./(x(pidx) - xtmp(idx)); + alpha = min (sf); + ## LH10: adjust X. + xx = zeros (n, 1); + xx(p) = xtmp; + x += alpha*(xx - x); + ## LH11: move from P to Z all X == 0. + ## This corresponds to those indices where minimum of sf is attained. + idx = idx (sf == alpha); + p(idx) = []; + if (useqr) + ## update the QR factorization. + [q, r] = qrdelete (q, r, idx); + endif + endif + endwhile + + ## compute the gradient. + w = c'*(d - c*x); + w(p) = []; + if (! any (w > 0)) + if (useqr) + ## verify the solution achieved using qr updating. + ## in the best case, this should only take a single step. + useqr = false; + continue; + else + ## we're finished. + break; + endif + endif + + ## find the maximum gradient. + idx = find (w == max (w)); + if (numel (idx) > 1) + warning ("lsqnonneg:nonunique", + "a non-unique solution may be returned due to equal gradients"); + idx = idx(1); + endif + ## move the index from Z to P. Keep P sorted. + z = [1:n]; z(p) = []; + zidx = z(idx); + jdx = 1 + lookup (p, zidx); + p = [p(1:jdx-1), zidx, p(jdx:end)]; + if (useqr) + ## insert the column into the QR factorization. + [q, r] = qrinsert (q, r, jdx, c(:,zidx)); + endif + + endwhile + ## LH12: complete. + + ## Generate the additional output arguments. + if (nargout > 1) + resnorm = norm (c*x - d) ^ 2; + endif + if (nargout > 2) + residual = d - c*x; + endif + exitflag = iter; + if (nargout > 3 && iter >= max_iter) + exitflag = 0; + endif + if (nargout > 4) + output = struct ("algorithm", "nnls", "iterations", iter); + endif + if (nargout > 5) + lambda = zeros (size (x)); + lambda(p) = w; + endif + +endfunction + +## Tests +%!test +%! C = [1 0;0 1;2 1]; +%! d = [1;3;-2]; +%! assert (lsqnonneg (C, d), [0;0.5], 100*eps) + +%!test +%! C = [0.0372 0.2869;0.6861 0.7071;0.6233 0.6245;0.6344 0.6170]; +%! d = [0.8587;0.1781;0.0747;0.8405]; +%! xnew = [0;0.6929]; +%! assert (lsqnonneg (C, d), xnew, 0.0001) diff --git a/octave_packages/m/optimization/optimget.m b/octave_packages/m/optimization/optimget.m new file mode 100644 index 0000000..a9fe2af --- /dev/null +++ b/octave_packages/m/optimization/optimget.m @@ -0,0 +1,52 @@ +## Copyright (C) 2008-2012 Jaroslav Hajek +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} optimget (@var{options}, @var{parname}) +## @deftypefnx {Function File} {} optimget (@var{options}, @var{parname}, @var{default}) +## Return a specific option from a structure created by +## @code{optimset}. If @var{parname} is not a field of the @var{options} +## structure, return @var{default} if supplied, otherwise return an +## empty matrix. +## @end deftypefn + +function retval = optimget (options, parname, default) + + if (nargin < 2 || nargin > 4 || ! isstruct (options) || ! ischar (parname)) + print_usage (); + endif + + opts = __all_opts__ (); + idx = lookup (tolower (opts), tolower (parname), "m"); + + if (idx) + parname = opts{idx}; + else + warning ("unrecognized option: %s", parname); + endif + if (isfield (options, parname)) + retval = options.(parname); + elseif (nargin > 2) + retval = default; + else + retval = []; + endif + +endfunction + diff --git a/octave_packages/m/optimization/optimset.m b/octave_packages/m/optimization/optimset.m new file mode 100644 index 0000000..a7aaa79 --- /dev/null +++ b/octave_packages/m/optimization/optimset.m @@ -0,0 +1,148 @@ +## Copyright (C) 2007-2012 John W. Eaton +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} optimset () +## @deftypefnx {Function File} {} optimset (@var{par}, @var{val}, @dots{}) +## @deftypefnx {Function File} {} optimset (@var{old}, @var{par}, @var{val}, @dots{}) +## @deftypefnx {Function File} {} optimset (@var{old}, @var{new}) +## Create options struct for optimization functions. +## +## Valid parameters are: +## @itemize @bullet +## @item AutoScaling +## +## @item ComplexEqn +## +## @item FinDiffType +## +## @item FunValCheck +## When enabled, display an error if the objective function returns a complex +## value or NaN@. Must be set to "on" or "off" [default]. +## +## @item GradObj +## When set to "on", the function to be minimized must return a second argument +## which is the gradient, or first derivative, of the function at the point +## @var{x}. If set to "off" [default], the gradient is computed via finite +## differences. +## +## @item Jacobian +## When set to "on", the function to be minimized must return a second argument +## which is the Jacobian, or first derivative, of the function at the point +## @var{x}. If set to "off" [default], the Jacobian is computed via finite +## differences. +## +## @item MaxFunEvals +## Maximum number of function evaluations before optimization stops. +## Must be a positive integer. +## +## @item MaxIter +## Maximum number of algorithm iterations before optimization stops. +## Must be a positive integer. +## +## @item OutputFcn +## A user-defined function executed once per algorithm iteration. +## +## @item TolFun +## Termination criterion for the function output. If the difference in the +## calculated objective function between one algorithm iteration and the next +## is less than @code{TolFun} the optimization stops. Must be a positive +## scalar. +## +## @item TolX +## Termination criterion for the function input. If the difference in @var{x}, +## the current search point, between one algorithm iteration and the next is +## less than @code{TolX} the optimization stops. Must be a positive scalar. +## +## @item TypicalX +## +## @item Updating +## @end itemize +## @end deftypefn + +function retval = optimset (varargin) + + nargs = nargin (); + + ## Add more as needed. + opts = __all_opts__ (); + + if (nargs == 0) + if (nargout == 0) + ## Display possibilities. + puts ("\nAll possible optimization options:\n\n"); + printf (" %s\n", opts{:}); + puts ("\n"); + else + ## Return struct with all options initialized to [] + retval = cell2struct (repmat ({[]}, size (opts)), opts, 2); + endif + elseif (nargs == 1 && ischar (varargin{1})) + ## Return defaults for named function. + fcn = varargin{1}; + try + retval = feval (fcn, "defaults"); + catch + error ("optimset: no defaults for function `%s'", fcn); + end_try_catch + elseif (nargs == 2 && isstruct (varargin{1}) && isstruct (varargin{2})) + ## Set slots in old from nonempties in new. Should we be checking + ## to ensure that the field names are expected? + old = varargin{1}; + new = varargin{2}; + fnames = fieldnames (old); + ## skip validation if we're in the internal query + validation = ! isempty (opts); + lopts = tolower (opts); + for [val, key] = new + if (validation) + ## Case insensitive lookup in all options. + i = lookup (lopts, tolower (key)); + ## Validate option. + if (i > 0 && strcmpi (opts{i}, key)) + ## Use correct case. + key = opts{i}; + else + warning ("unrecognized option: %s", key); + endif + endif + old.(key) = val; + endfor + retval = old; + elseif (rem (nargs, 2) && isstruct (varargin{1})) + ## Set values in old from name/value pairs. + pairs = reshape (varargin(2:end), 2, []); + retval = optimset (varargin{1}, cell2struct (pairs(2, :), pairs(1, :), 2)); + elseif (rem (nargs, 2) == 0) + ## Create struct. Default values are replaced by those specified by + ## name/value pairs. + pairs = reshape (varargin, 2, []); + retval = optimset (struct (), cell2struct (pairs(2, :), pairs(1, :), 2)); + else + print_usage (); + endif + +endfunction + + +%!assert (optimget (optimset ('tolx', 1e-2), 'tOLx'), 1e-2) +%!assert (isfield (optimset ('tolFun', 1e-3), 'TolFun')) + +%!error (optimset ("%NOT_A_REAL_FUNCTION_NAME%")) + diff --git a/octave_packages/m/optimization/pqpnonneg.m b/octave_packages/m/optimization/pqpnonneg.m new file mode 100644 index 0000000..3b6a8f2 --- /dev/null +++ b/octave_packages/m/optimization/pqpnonneg.m @@ -0,0 +1,211 @@ +## Copyright (C) 2008-2012 Bill Denney +## Copyright (C) 2008 Jaroslav Hajek +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} pqpnonneg (@var{c}, @var{d}) +## @deftypefnx {Function File} {@var{x} =} pqpnonneg (@var{c}, @var{d}, @var{x0}) +## @deftypefnx {Function File} {[@var{x}, @var{minval}] =} pqpnonneg (@dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{minval}, @var{exitflag}] =} pqpnonneg (@dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{minval}, @var{exitflag}, @var{output}] =} pqpnonneg (@dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{minval}, @var{exitflag}, @var{output}, @var{lambda}] =} pqpnonneg (@dots{}) +## Minimize @code{1/2*x'*c*x + d'*x} subject to @code{@var{x} >= 0}. @var{c} +## and @var{d} must be real, and @var{c} must be symmetric and positive +## definite. @var{x0} is an optional initial guess for @var{x}. +## +## Outputs: +## @itemize @bullet +## @item minval +## +## The minimum attained model value, 1/2*xmin'*c*xmin + d'*xmin +## +## @item exitflag +## +## An indicator of convergence. 0 indicates that the iteration count +## was exceeded, and therefore convergence was not reached; >0 indicates +## that the algorithm converged. (The algorithm is stable and will +## converge given enough iterations.) +## +## @item output +## +## A structure with two fields: +## @itemize @bullet +## @item "algorithm": The algorithm used ("nnls") +## +## @item "iterations": The number of iterations taken. +## @end itemize +## +## @item lambda +## +## Not implemented. +## @end itemize +## @seealso{optimset, lsqnonneg, qp} +## @end deftypefn + +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("pqpnonneg"); + +## This is analogical to the lsqnonneg implementation, which is +## implemented from Lawson and Hanson's 1973 algorithm on page +## 161 of Solving Least Squares Problems. +## It shares the convergence guarantees. + +function [x, minval, exitflag, output, lambda] = pqpnonneg (c, d, x = [], options = struct ()) + + if (nargin == 1 && ischar (c) && strcmp (c, 'defaults')) + x = optimset ("MaxIter", 1e5); + return + endif + + if (! (nargin >= 2 && nargin <= 4 && ismatrix (c) && ismatrix (d) && isstruct (options))) + print_usage (); + endif + + ## Lawson-Hanson Step 1 (LH1): initialize the variables. + m = rows (c); + n = columns (c); + if (m != n) + error ("pqpnonneg: matrix must be square"); + endif + + if (isempty (x)) + ## Initial guess is 0s. + x = zeros (n, 1); + else + ## ensure nonnegative guess. + x = max (x, 0); + endif + + max_iter = optimget (options, "MaxIter", 1e5); + + ## Initialize P, according to zero pattern of x. + p = find (x > 0).'; + ## Initialize the Cholesky factorization. + r = chol (c(p, p)); + usechol = true; + + iter = 0; + + ## LH3: test for completion. + while (iter < max_iter) + while (iter < max_iter) + iter++; + + ## LH6: compute the positive matrix and find the min norm solution + ## of the positive problem. + if (usechol) + xtmp = -(r \ (r' \ d(p))); + else + xtmp = -(c(p,p) \ d(p)); + endif + idx = find (xtmp < 0); + + if (isempty (idx)) + ## LH7: tmp solution found, iterate. + x(:) = 0; + x(p) = xtmp; + break; + else + ## LH8, LH9: find the scaling factor. + pidx = p(idx); + sf = x(pidx)./(x(pidx) - xtmp(idx)); + alpha = min (sf); + ## LH10: adjust X. + xx = zeros (n, 1); + xx(p) = xtmp; + x += alpha*(xx - x); + ## LH11: move from P to Z all X == 0. + ## This corresponds to those indices where minimum of sf is attained. + idx = idx (sf == alpha); + p(idx) = []; + if (usechol) + ## update the Cholesky factorization. + r = choldelete (r, idx); + endif + endif + endwhile + + ## compute the gradient. + w = -(d + c*x); + w(p) = []; + if (! any (w > 0)) + if (usechol) + ## verify the solution achieved using qr updating. + ## in the best case, this should only take a single step. + usechol = false; + continue; + else + ## we're finished. + break; + endif + endif + + ## find the maximum gradient. + idx = find (w == max (w)); + if (numel (idx) > 1) + warning ("pqpnonneg:nonunique", + "a non-unique solution may be returned due to equal gradients"); + idx = idx(1); + endif + ## move the index from Z to P. Keep P sorted. + z = [1:n]; z(p) = []; + zidx = z(idx); + jdx = 1 + lookup (p, zidx); + p = [p(1:jdx-1), zidx, p(jdx:end)]; + if (usechol) + ## insert the column into the Cholesky factorization. + [r, bad] = cholinsert (r, jdx, c(p,zidx)); + if (bad) + ## If the insertion failed, we switch off updates and go on. + usechol = false; + endif + endif + + endwhile + ## LH12: complete. + + ## Generate the additional output arguments. + if (nargout > 1) + minval = 1/2*(x'*c*x) + d'*x; + endif + exitflag = iter; + if (nargout > 2 && iter >= max_iter) + exitflag = 0; + endif + if (nargout > 3) + output = struct ("algorithm", "nnls-pqp", "iterations", iter); + endif + if (nargout > 4) + lambda = zeros (size (x)); + lambda(p) = w; + endif + +endfunction + +## Tests +%!test +%! C = [5 2;2 2]; +%! d = [3; -1]; +%! assert (pqpnonneg (C, d), [0;0.5], 100*eps) + +## Test equivalence of lsq and pqp +%!test +%! C = rand (20, 10); +%! d = rand (20, 1); +%! assert (pqpnonneg (C'*C, -C'*d), lsqnonneg (C, d), 100*eps) diff --git a/octave_packages/m/optimization/private/__fdjac__.m b/octave_packages/m/optimization/private/__fdjac__.m new file mode 100644 index 0000000..eca42e4 --- /dev/null +++ b/octave_packages/m/optimization/private/__fdjac__.m @@ -0,0 +1,48 @@ +## Copyright (C) 2008-2012 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __fdjac__ (@var{fcn}, @var{x}, @var{fvec}, @var{err}) +## Undocumented internal function. +## @end deftypefn + +function fjac = __fdjac__ (fcn, x, fvec, typicalx, cdif, err = 0) + if (cdif) + err = (max (eps, err)) ^ (1/3); + h = typicalx*err; + fjac = zeros (length (fvec), numel (x)); + for i = 1:numel (x) + x1 = x2 = x; + x1(i) += h(i); + x2(i) -= h(i); + fjac(:,i) = (fcn (x1)(:) - fcn (x2)(:)) / (x1(i) - x2(i)); + endfor + else + err = sqrt (max (eps, err)); + h = typicalx*err; + fjac = zeros (length (fvec), numel (x)); + for i = 1:numel (x) + x1 = x; + x1(i) += h(i); + fjac(:,i) = (fcn (x1)(:) - fvec) / (x1(i) - x(i)); + endfor + endif +endfunction + + + diff --git a/octave_packages/m/optimization/qp.m b/octave_packages/m/optimization/qp.m new file mode 100644 index 0000000..4ef5db5 --- /dev/null +++ b/octave_packages/m/optimization/qp.m @@ -0,0 +1,407 @@ +## Copyright (C) 2000-2012 Gabriele Pannocchia. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{obj}, @var{info}, @var{lambda}] =} qp (@var{x0}, @var{H}) +## @deftypefnx {Function File} {[@var{x}, @var{obj}, @var{info}, @var{lambda}] =} qp (@var{x0}, @var{H}, @var{q}) +## @deftypefnx {Function File} {[@var{x}, @var{obj}, @var{info}, @var{lambda}] =} qp (@var{x0}, @var{H}, @var{q}, @var{A}, @var{b}) +## @deftypefnx {Function File} {[@var{x}, @var{obj}, @var{info}, @var{lambda}] =} qp (@var{x0}, @var{H}, @var{q}, @var{A}, @var{b}, @var{lb}, @var{ub}) +## @deftypefnx {Function File} {[@var{x}, @var{obj}, @var{info}, @var{lambda}] =} qp (@var{x0}, @var{H}, @var{q}, @var{A}, @var{b}, @var{lb}, @var{ub}, @var{A_lb}, @var{A_in}, @var{A_ub}) +## @deftypefnx {Function File} {[@var{x}, @var{obj}, @var{info}, @var{lambda}] =} qp (@dots{}, @var{options}) +## Solve the quadratic program +## @tex +## $$ +## \min_x {1 \over 2} x^T H x + x^T q +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## min 0.5 x'*H*x + x'*q +## x +## @end group +## @end example +## +## @end ifnottex +## subject to +## @tex +## $$ +## Ax = b \qquad lb \leq x \leq ub \qquad A_{lb} \leq A_{in} \leq A_{ub} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## A*x = b +## lb <= x <= ub +## A_lb <= A_in*x <= A_ub +## @end group +## @end example +## +## @end ifnottex +## @noindent +## using a null-space active-set method. +## +## Any bound (@var{A}, @var{b}, @var{lb}, @var{ub}, @var{A_lb}, +## @var{A_ub}) may be set to the empty matrix (@code{[]}) if not +## present. If the initial guess is feasible the algorithm is faster. +## +## @table @var +## @item options +## An optional structure containing the following +## parameter(s) used to define the behavior of the solver. Missing elements +## in the structure take on default values, so you only need to set the +## elements that you wish to change from the default. +## +## @table @code +## @item MaxIter (default: 200) +## Maximum number of iterations. +## @end table +## @end table +## +## @table @var +## @item info +## Structure containing run-time information about the algorithm. The +## following fields are defined: +## +## @table @code +## @item solveiter +## The number of iterations required to find the solution. +## +## @item info +## An integer indicating the status of the solution. +## +## @table @asis +## @item 0 +## The problem is feasible and convex. Global solution found. +## +## @item 1 +## The problem is not convex. Local solution found. +## +## @item 2 +## The problem is not convex and unbounded. +## +## @item 3 +## Maximum number of iterations reached. +## +## @item 6 +## The problem is infeasible. +## @end table +## @end table +## @end table +## @end deftypefn + +## PKG_ADD: ## Discard result to avoid polluting workspace with ans at startup. +## PKG_ADD: [~] = __all_opts__ ("qp"); + +function [x, obj, INFO, lambda] = qp (x0, H, varargin) + + nargs = nargin; + + if (nargin == 1 && ischar (x0) && strcmp (x0, 'defaults')) + x = optimset ("MaxIter", 200); + return; + endif + + if (nargs > 2 && isstruct (varargin{end})) + options = varargin{end}; + nargs--; + else + options = struct (); + endif + + if (nargs >= 3) + q = varargin{1}; + else + q = []; + endif + + if (nargs >= 5) + A = varargin{2}; + b = varargin{3}; + else + A = []; + b = []; + endif + + if (nargs >= 7) + lb = varargin{4}; + ub = varargin{5}; + else + lb = []; + ub = []; + endif + + if (nargs == 10) + A_lb = varargin{6}; + A_in = varargin{7}; + A_ub = varargin{8}; + else + A_lb = []; + A_in = []; + A_ub = []; + endif + + if (nargs == 2 || nargs == 3 || nargs == 5 || nargs == 7 || nargs == 10) + + maxit = optimget (options, "MaxIter", 200); + + ## Checking the quadratic penalty + if (! issquare (H)) + error ("qp: quadratic penalty matrix not square"); + elseif (! ishermitian (H)) + ## warning ("qp: quadratic penalty matrix not hermitian"); + H = (H + H')/2; + endif + n = rows (H); + + ## Checking the initial guess (if empty it is resized to the + ## right dimension and filled with 0) + if (isempty (x0)) + x0 = zeros (n, 1); + elseif (numel (x0) != n) + error ("qp: the initial guess has incorrect length"); + endif + + ## Linear penalty. + if (isempty (q)) + q = zeros (n, 1); + elseif (numel (q) != n) + error ("qp: the linear term has incorrect length"); + endif + + ## Equality constraint matrices + if (isempty (A) || isempty (b)) + A = zeros (0, n); + b = zeros (0, 1); + n_eq = 0; + else + [n_eq, n1] = size (A); + if (n1 != n) + error ("qp: equality constraint matrix has incorrect column dimension"); + endif + if (numel (b) != n_eq) + error ("qp: equality constraint matrix and vector have inconsistent dimension"); + endif + endif + + ## Bound constraints + Ain = zeros (0, n); + bin = zeros (0, 1); + n_in = 0; + if (nargs > 5) + if (! isempty (lb)) + if (numel (lb) != n) + error ("qp: lower bound has incorrect length"); + elseif (isempty (ub)) + Ain = [Ain; eye(n)]; + bin = [bin; lb]; + endif + endif + + if (! isempty (ub)) + if (numel (ub) != n) + error ("qp: upper bound has incorrect length"); + elseif (isempty (lb)) + Ain = [Ain; -eye(n)]; + bin = [bin; -ub]; + endif + endif + + if (! isempty (lb) && ! isempty (ub)) + rtol = sqrt (eps); + for i = 1:n + if (abs(lb (i) - ub(i)) < rtol*(1 + max (abs (lb(i) + ub(i))))) + ## These are actually an equality constraint + tmprow = zeros(1,n); + tmprow(i) = 1; + A = [A;tmprow]; + b = [b; 0.5*(lb(i) + ub(i))]; + n_eq = n_eq + 1; + else + tmprow = zeros(1,n); + tmprow(i) = 1; + Ain = [Ain; tmprow; -tmprow]; + bin = [bin; lb(i); -ub(i)]; + n_in = n_in + 2; + endif + endfor + endif + endif + + ## Inequality constraints + if (nargs > 7) + [dimA_in, n1] = size (A_in); + if (n1 != n) + error ("qp: inequality constraint matrix has incorrect column dimension"); + else + if (! isempty (A_lb)) + if (numel (A_lb) != dimA_in) + error ("qp: inequality constraint matrix and lower bound vector inconsistent"); + elseif (isempty (A_ub)) + Ain = [Ain; A_in]; + bin = [bin; A_lb]; + endif + endif + if (! isempty (A_ub)) + if (numel (A_ub) != dimA_in) + error ("qp: inequality constraint matrix and upper bound vector inconsistent"); + elseif (isempty (A_lb)) + Ain = [Ain; -A_in]; + bin = [bin; -A_ub]; + endif + endif + + if (! isempty (A_lb) && ! isempty (A_ub)) + rtol = sqrt (eps); + for i = 1:dimA_in + if (abs (A_lb(i) - A_ub(i)) < rtol*(1 + max (abs (A_lb(i) + A_ub(i))))) + ## These are actually an equality constraint + tmprow = A_in(i,:); + A = [A;tmprow]; + b = [b; 0.5*(A_lb(i) + A_ub(i))]; + n_eq = n_eq + 1; + else + tmprow = A_in(i,:); + Ain = [Ain; tmprow; -tmprow]; + bin = [bin; A_lb(i); -A_ub(i)]; + n_in = n_in + 2; + endif + endfor + endif + endif + endif + + ## Now we should have the following QP: + ## + ## min_x 0.5*x'*H*x + x'*q + ## s.t. A*x = b + ## Ain*x >= bin + + ## Discard inequality constraints that have -Inf bounds since those + ## will never be active. + idx = isinf (bin) & bin < 0; + + bin(idx) = []; + Ain(idx,:) = []; + + n_in = numel (bin); + + ## Check if the initial guess is feasible. + if (isa (x0, "single") || isa (H, "single") || isa (q, "single") || isa (A, "single") + || isa (b, "single")) + rtol = sqrt (eps ("single")); + else + rtol = sqrt (eps); + endif + + eq_infeasible = (n_eq > 0 && norm (A*x0-b) > rtol*(1+abs (b))); + in_infeasible = (n_in > 0 && any (Ain*x0-bin < -rtol*(1+abs (bin)))); + + info = 0; + if (eq_infeasible || in_infeasible) + ## The initial guess is not feasible. + ## First define xbar that is feasible with respect to the equality + ## constraints. + if (eq_infeasible) + if (rank (A) < n_eq) + error ("qp: equality constraint matrix must be full row rank"); + endif + xbar = pinv (A) * b; + else + xbar = x0; + endif + + ## Check if xbar is feasible with respect to the inequality + ## constraints also. + if (n_in > 0) + res = Ain * xbar - bin; + if (any (res < -rtol * (1 + abs (bin)))) + ## xbar is not feasible with respect to the inequality + ## constraints. Compute a step in the null space of the + ## equality constraints, by solving a QP. If the slack is + ## small, we have a feasible initial guess. Otherwise, the + ## problem is infeasible. + if (n_eq > 0) + Z = null (A); + if (isempty (Z)) + ## The problem is infeasible because A is square and full + ## rank, but xbar is not feasible. + info = 6; + endif + endif + + if (info != 6) + ## Solve an LP with additional slack variables to find + ## a feasible starting point. + gamma = eye (n_in); + if (n_eq > 0) + Atmp = [Ain*Z, gamma]; + btmp = -res; + else + Atmp = [Ain, gamma]; + btmp = bin; + endif + ctmp = [zeros(n-n_eq, 1); ones(n_in, 1)]; + lb = [-Inf(n-n_eq,1); zeros(n_in,1)]; + ub = []; + ctype = repmat ("L", n_in, 1); + [P, dummy, status] = glpk (ctmp, Atmp, btmp, lb, ub, ctype); + if ((status == 180 || status == 181 || status == 151) + && all (abs (P(n-n_eq+1:end)) < rtol * (1 + norm (btmp)))) + ## We found a feasible starting point + if (n_eq > 0) + x0 = xbar + Z*P(1:n-n_eq); + else + x0 = P(1:n); + endif + else + ## The problem is infeasible + info = 6; + endif + endif + else + ## xbar is feasible. We use it a starting point. + x0 = xbar; + endif + else + ## xbar is feasible. We use it a starting point. + x0 = xbar; + endif + endif + + if (info == 0) + ## The initial (or computed) guess is feasible. + ## We call the solver. + [x, lambda, info, iter] = __qp__ (x0, H, q, A, b, Ain, bin, maxit); + else + iter = 0; + x = x0; + lambda = []; + endif + obj = 0.5 * x' * H * x + q' * x; + INFO.solveiter = iter; + INFO.info = info; + + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/optimization/sqp.m b/octave_packages/m/optimization/sqp.m new file mode 100644 index 0000000..c2f3f56 --- /dev/null +++ b/octave_packages/m/optimization/sqp.m @@ -0,0 +1,781 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{obj}, @var{info}, @var{iter}, @var{nf}, @var{lambda}] =} sqp (@var{x0}, @var{phi}) +## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}) +## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}) +## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}) +## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}, @var{maxiter}) +## @deftypefnx {Function File} {[@dots{}] =} sqp (@var{x0}, @var{phi}, @var{g}, @var{h}, @var{lb}, @var{ub}, @var{maxiter}, @var{tol}) +## Solve the nonlinear program +## @tex +## $$ +## \min_x \phi (x) +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## min phi (x) +## x +## @end group +## @end example +## +## @end ifnottex +## subject to +## @tex +## $$ +## g(x) = 0 \qquad h(x) \geq 0 \qquad lb \leq x \leq ub +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## g(x) = 0 +## h(x) >= 0 +## lb <= x <= ub +## @end group +## @end example +## +## @end ifnottex +## @noindent +## using a sequential quadratic programming method. +## +## The first argument is the initial guess for the vector @var{x0}. +## +## The second argument is a function handle pointing to the objective +## function @var{phi}. The objective function must accept one vector +## argument and return a scalar. +## +## The second argument may also be a 2- or 3-element cell array of +## function handles. The first element should point to the objective +## function, the second should point to a function that computes the +## gradient of the objective function, and the third should point to a +## function that computes the Hessian of the objective function. If the +## gradient function is not supplied, the gradient is computed by finite +## differences. If the Hessian function is not supplied, a BFGS update +## formula is used to approximate the Hessian. +## +## When supplied, the gradient function @code{@var{phi}@{2@}} must accept +## one vector argument and return a vector. When supplied, the Hessian +## function @code{@var{phi}@{3@}} must accept one vector argument and +## return a matrix. +## +## The third and fourth arguments @var{g} and @var{h} are function +## handles pointing to functions that compute the equality constraints +## and the inequality constraints, respectively. If the problem does +## not have equality (or inequality) constraints, then use an empty +## matrix ([]) for @var{g} (or @var{h}). When supplied, these equality +## and inequality constraint functions must accept one vector argument +## and return a vector. +## +## The third and fourth arguments may also be 2-element cell arrays of +## function handles. The first element should point to the constraint +## function and the second should point to a function that computes the +## gradient of the constraint function: +## @tex +## $$ +## \Bigg( {\partial f(x) \over \partial x_1}, +## {\partial f(x) \over \partial x_2}, \ldots, +## {\partial f(x) \over \partial x_N} \Bigg)^T +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## [ d f(x) d f(x) d f(x) ] +## transpose ( [ ------ ----- ... ------ ] ) +## [ dx_1 dx_2 dx_N ] +## @end group +## @end example +## +## @end ifnottex +## The fifth and sixth arguments, @var{lb} and @var{ub}, contain lower +## and upper bounds on @var{x}. These must be consistent with the +## equality and inequality constraints @var{g} and @var{h}. If the +## arguments are vectors then @var{x}(i) is bound by @var{lb}(i) and +## @var{ub}(i). A bound can also be a scalar in which case all elements +## of @var{x} will share the same bound. If only one bound (lb, ub) is +## specified then the other will default to (-@var{realmax}, +## +@var{realmax}). +## +## The seventh argument @var{maxiter} specifies the maximum number of +## iterations. The default value is 100. +## +## The eighth argument @var{tol} specifies the tolerance for the +## stopping criteria. The default value is @code{sqrt(eps)}. +## +## The value returned in @var{info} may be one of the following: +## +## @table @asis +## @item 101 +## The algorithm terminated normally. +## Either all constraints meet the requested tolerance, or the stepsize, +## @tex +## $\Delta x,$ +## @end tex +## @ifnottex +## delta @var{x}, +## @end ifnottex +## is less than @code{@var{tol} * norm (x)}. +## +## @item 102 +## The BFGS update failed. +## +## @item 103 +## The maximum number of iterations was reached. +## @end table +## +## An example of calling @code{sqp}: +## +## @example +## function r = g (x) +## r = [ sumsq(x)-10; +## x(2)*x(3)-5*x(4)*x(5); +## x(1)^3+x(2)^3+1 ]; +## endfunction +## +## function obj = phi (x) +## obj = exp (prod (x)) - 0.5*(x(1)^3+x(2)^3+1)^2; +## endfunction +## +## x0 = [-1.8; 1.7; 1.9; -0.8; -0.8]; +## +## [x, obj, info, iter, nf, lambda] = sqp (x0, @@phi, @@g, []) +## +## x = +## +## -1.71714 +## 1.59571 +## 1.82725 +## -0.76364 +## -0.76364 +## +## obj = 0.053950 +## info = 101 +## iter = 8 +## nf = 10 +## lambda = +## +## -0.0401627 +## 0.0379578 +## -0.0052227 +## @end example +## +## @seealso{qp} +## @end deftypefn + +function [x, obj, info, iter, nf, lambda] = sqp (x0, objf, cef, cif, lb, ub, maxiter, tolerance) + + global __sqp_nfun__; + global __sqp_obj_fun__; + global __sqp_ce_fun__; + global __sqp_ci_fun__; + global __sqp_cif__; + global __sqp_cifcn__; + + if (nargin < 2 || nargin > 8 || nargin == 5) + print_usage (); + endif + + if (!isvector (x0)) + error ("sqp: X0 must be a vector"); + endif + if (rows (x0) == 1) + x0 = x0'; + endif + + obj_grd = @fd_obj_grd; + have_hess = 0; + if (iscell (objf)) + switch (numel (objf)) + case 1 + obj_fun = objf{1}; + case 2 + obj_fun = objf{1}; + obj_grd = objf{2}; + case 3 + obj_fun = objf{1}; + obj_grd = objf{2}; + obj_hess = objf{3}; + have_hess = 1; + otherwise + error ("sqp: invalid objective function specification"); + endswitch + else + obj_fun = objf; # No cell array, only obj_fun set + endif + __sqp_obj_fun__ = obj_fun; + + ce_fun = @empty_cf; + ce_grd = @empty_jac; + if (nargin > 2) + ce_grd = @fd_ce_jac; + if (iscell (cef)) + switch (numel (cef)) + case 1 + ce_fun = cef{1}; + case 2 + ce_fun = cef{1}; + ce_grd = cef{2}; + otherwise + error ("sqp: invalid equality constraint function specification"); + endswitch + elseif (! isempty (cef)) + ce_fun = cef; # No cell array, only constraint equality function set + endif + endif + __sqp_ce_fun__ = ce_fun; + + ci_fun = @empty_cf; + ci_grd = @empty_jac; + if (nargin > 3) + ## constraint function given by user with possible gradient + __sqp_cif__ = cif; + ## constraint function given by user without gradient + __sqp_cifcn__ = @empty_cf; + if (iscell (cif)) + if (length (cif) > 0) + __sqp_cifcn__ = cif{1}; + endif + elseif (! isempty (cif)) + __sqp_cifcn__ = cif; + endif + + if (nargin < 5 || (nargin > 5 && isempty (lb) && isempty (ub))) + ## constraint inequality function only without any bounds + ci_grd = @fd_ci_jac; + if (iscell (cif)) + switch length (cif) + case {1} + ci_fun = cif{1}; + case {2} + ci_fun = cif{1}; + ci_grd = cif{2}; + otherwise + error ("sqp: invalid inequality constraint function specification"); + endswitch + elseif (! isempty (cif)) + ci_fun = cif; # No cell array, only constraint inequality function set + endif + else + ## constraint inequality function with bounds present + global __sqp_lb__; + lb_idx = ub_idx = true (size (x0)); + ub_grad = - (lb_grad = eye (rows (x0))); + if (isvector (lb)) + __sqp_lb__ = tmp_lb = lb(:); + lb_idx(:) = tmp_idx = (lb != -Inf); + __sqp_lb__ = __sqp_lb__(tmp_idx, 1); + lb_grad = lb_grad(lb_idx, :); + elseif (isempty (lb)) + if (isa (x0, "single")) + __sqp_lb__ = tmp_lb = -realmax ("single"); + else + __sqp_lb__ = tmp_lb = -realmax; + endif + else + error ("sqp: invalid lower bound"); + endif + + global __sqp_ub__; + if (isvector (ub)) + __sqp_ub__ = tmp_ub = ub(:); + ub_idx(:) = tmp_idx = (ub != Inf); + __sqp_ub__ = __sqp_ub__(tmp_idx, 1); + ub_grad = ub_grad(ub_idx, :); + elseif (isempty (ub)) + if (isa (x0, "single")) + __sqp_ub__ = tmp_ub = realmax ("single"); + else + __sqp_ub__ = tmp_ub = realmax; + endif + else + error ("sqp: invalid upper bound"); + endif + + if (any (tmp_lb > tmp_ub)) + error ("sqp: upper bound smaller than lower bound"); + endif + bounds_grad = [lb_grad; ub_grad]; + ci_fun = @ (x) cf_ub_lb (x, lb_idx, ub_idx); + ci_grd = @ (x) cigrad_ub_lb (x, bounds_grad); + endif + + __sqp_ci_fun__ = ci_fun; + endif # if (nargin > 3) + + iter_max = 100; + if (nargin > 6 && ! isempty (maxiter)) + if (isscalar (maxiter) && maxiter > 0 && fix (maxiter) == maxiter) + iter_max = maxiter; + else + error ("sqp: invalid number of maximum iterations"); + endif + endif + + tol = sqrt (eps); + if (nargin > 7 && ! isempty (tolerance)) + if (isscalar (tolerance) && tolerance > 0) + tol = tolerance; + else + error ("sqp: invalid value for TOLERANCE"); + endif + endif + + ## Initialize variables for search loop + ## Seed x with initial guess and evaluate objective function, constraints, + ## and gradients at initial value x0. + ## + ## obj_fun -- objective function + ## obj_grad -- objective gradient + ## ce_fun -- equality constraint functions + ## ci_fun -- inequality constraint functions + ## A == [grad_{x_1} cx_fun, grad_{x_2} cx_fun, ..., grad_{x_n} cx_fun]^T + x = x0; + + obj = feval (obj_fun, x0); + __sqp_nfun__ = 1; + + c = feval (obj_grd, x0); + + ## Choose an initial NxN symmetric positive definite Hessian approximation B. + n = length (x0); + if (have_hess) + B = feval (obj_hess, x0); + else + B = eye (n, n); + endif + + ce = feval (ce_fun, x0); + F = feval (ce_grd, x0); + + ci = feval (ci_fun, x0); + C = feval (ci_grd, x0); + + A = [F; C]; + + ## Choose an initial lambda (x is provided by the caller). + lambda = 100 * ones (rows (A), 1); + + qp_iter = 1; + alpha = 1; + + info = 0; + iter = 0; + # report (); # Called with no arguments to initialize reporting + # report (iter, qp_iter, alpha, __sqp_nfun__, obj); + + while (++iter < iter_max) + + ## Check convergence. This is just a simple check on the first + ## order necessary conditions. + nr_f = rows (F); + + lambda_e = lambda((1:nr_f)'); + lambda_i = lambda((nr_f+1:end)'); + + con = [ce; ci]; + + t0 = norm (c - A' * lambda); + t1 = norm (ce); + t2 = all (ci >= 0); + t3 = all (lambda_i >= 0); + t4 = norm (lambda .* con); + + if (t2 && t3 && max ([t0; t1; t4]) < tol) + info = 101; + break; + endif + + ## Compute search direction p by solving QP. + g = -ce; + d = -ci; + + [p, obj_qp, INFO, lambda] = qp (x, B, c, F, g, [], [], d, C, + Inf (size (d))); + + info = INFO.info; + + ## FIXME -- check QP solution and attempt to recover if it has + ## failed. For now, just warn about possible problems. + + id = "Octave:SQP-QP-subproblem"; + switch (info) + case 2 + warning (id, "sqp: QP subproblem is non-convex and unbounded"); + case 3 + warning (id, "sqp: QP subproblem failed to converge in %d iterations", + INFO.solveiter); + case 6 + warning (id, "sqp: QP subproblem is infeasible"); + endswitch + + ## Choose mu such that p is a descent direction for the chosen + ## merit function phi. + [x_new, alpha, obj_new] = linesearch_L1 (x, p, obj_fun, obj_grd, + ce_fun, ci_fun, lambda, obj); + + ## Evaluate objective function, constraints, and gradients at x_new. + c_new = feval (obj_grd, x_new); + + ce_new = feval (ce_fun, x_new); + F_new = feval (ce_grd, x_new); + + ci_new = feval (ci_fun, x_new); + C_new = feval (ci_grd, x_new); + + A_new = [F_new; C_new]; + + ## Set + ## + ## s = alpha * p + ## y = grad_x L (x_new, lambda) - grad_x L (x, lambda}) + + y = c_new - c; + + if (! isempty (A)) + t = ((A_new - A)'*lambda); + y -= t; + endif + + delx = x_new - x; + + if (norm (delx) < tol * norm (x)) + info = 101; + break; + endif + + if (have_hess) + + B = feval (obj_hess, x); + + else + ## Update B using a quasi-Newton formula. + delxt = delx'; + + ## Damped BFGS. Or maybe we would actually want to use the Hessian + ## of the Lagrangian, computed directly? + d1 = delxt*B*delx; + + t1 = 0.2 * d1; + t2 = delxt*y; + + if (t2 < t1) + theta = 0.8*d1/(d1 - t2); + else + theta = 1; + endif + + r = theta*y + (1-theta)*B*delx; + + d2 = delxt*r; + + if (d1 == 0 || d2 == 0) + info = 102; + break; + endif + + B = B - B*delx*delxt*B/d1 + r*r'/d2; + + endif + + x = x_new; + + obj = obj_new; + + c = c_new; + + ce = ce_new; + F = F_new; + + ci = ci_new; + C = C_new; + + A = A_new; + + # report (iter, qp_iter, alpha, __sqp_nfun__, obj); + + endwhile + + if (iter >= iter_max) + info = 103; + endif + + nf = __sqp_nfun__; + +endfunction + + +function [merit, obj] = phi_L1 (obj, obj_fun, ce_fun, ci_fun, x, mu) + + global __sqp_nfun__; + + ce = feval (ce_fun, x); + ci = feval (ci_fun, x); + + idx = ci < 0; + + con = [ce; ci(idx)]; + + if (isempty (obj)) + obj = feval (obj_fun, x); + __sqp_nfun__++; + endif + + merit = obj; + t = norm (con, 1) / mu; + + if (! isempty (t)) + merit += t; + endif + +endfunction + + +function [x_new, alpha, obj] = linesearch_L1 (x, p, obj_fun, obj_grd, + ce_fun, ci_fun, lambda, obj) + + ## Choose parameters + ## + ## eta in the range (0, 0.5) + ## tau in the range (0, 1) + + eta = 0.25; + tau = 0.5; + + delta_bar = sqrt (eps); + + if (isempty (lambda)) + mu = 1 / delta_bar; + else + mu = 1 / (norm (lambda, Inf) + delta_bar); + endif + + alpha = 1; + + c = feval (obj_grd, x); + ce = feval (ce_fun, x); + + [phi_x_mu, obj] = phi_L1 (obj, obj_fun, ce_fun, ci_fun, x, mu); + + D_phi_x_mu = c' * p; + d = feval (ci_fun, x); + ## only those elements of d corresponding + ## to violated constraints should be included. + idx = d < 0; + t = - norm ([ce; d(idx)], 1) / mu; + if (! isempty (t)) + D_phi_x_mu += t; + endif + + while (1) + [p1, obj] = phi_L1 ([], obj_fun, ce_fun, ci_fun, x+alpha*p, mu); + p2 = phi_x_mu+eta*alpha*D_phi_x_mu; + if (p1 > p2) + ## Reset alpha = tau_alpha * alpha for some tau_alpha in the + ## range (0, tau). + tau_alpha = 0.9 * tau; # ?? + alpha = tau_alpha * alpha; + else + break; + endif + endwhile + + x_new = x + alpha * p; + +endfunction + + +function grd = fdgrd (f, x) + + if (! isempty (f)) + y0 = feval (f, x); + nx = length (x); + grd = zeros (nx, 1); + deltax = sqrt (eps); + for i = 1:nx + t = x(i); + x(i) += deltax; + grd(i) = (feval (f, x) - y0) / deltax; + x(i) = t; + endfor + else + grd = zeros (0, 1); + endif + +endfunction + + +function jac = fdjac (f, x) + + nx = length (x); + if (! isempty (f)) + y0 = feval (f, x); + nf = length (y0); + nx = length (x); + jac = zeros (nf, nx); + deltax = sqrt (eps); + for i = 1:nx + t = x(i); + x(i) += deltax; + jac(:,i) = (feval (f, x) - y0) / deltax; + x(i) = t; + endfor + else + jac = zeros (0, nx); + endif + +endfunction + + +function grd = fd_obj_grd (x) + + global __sqp_obj_fun__; + + grd = fdgrd (__sqp_obj_fun__, x); + +endfunction + + +function res = empty_cf (x) + + res = zeros (0, 1); + +endfunction + + +function res = empty_jac (x) + + res = zeros (0, length (x)); + +endfunction + + +function jac = fd_ce_jac (x) + + global __sqp_ce_fun__; + + jac = fdjac (__sqp_ce_fun__, x); + +endfunction + + +function jac = fd_ci_jac (x) + + global __sqp_cifcn__; + ## __sqp_cifcn__ = constraint function without gradients and lb or ub + jac = fdjac (__sqp_cifcn__, x); + +endfunction + + +function res = cf_ub_lb (x, lbidx, ubidx) + + ## combine constraint function with ub and lb + global __sqp_cifcn__ __sqp_lb__ __sqp_ub__ + + if (isempty (__sqp_cifcn__)) + res = [x(lbidx,1)-__sqp_lb__; __sqp_ub__-x(ubidx,1)]; + else + res = [feval(__sqp_cifcn__,x); \ + x(lbidx,1)-__sqp_lb__; __sqp_ub__-x(ubidx,1)]; + endif + +endfunction + + +function res = cigrad_ub_lb (x, bgrad) + + global __sqp_cif__ + + cigradfcn = @fd_ci_jac; + + if (iscell (__sqp_cif__) && length (__sqp_cif__) > 1) + cigradfcn = __sqp_cif__{2}; + endif + + if (isempty (cigradfcn)) + res = bgrad; + else + res = [feval(cigradfcn,x); bgrad]; + endif + +endfunction + +# Utility function used to debug sqp +function report (iter, qp_iter, alpha, nfun, obj) + + if (nargin == 0) + printf (" Itn ItQP Step Nfun Objective\n"); + else + printf ("%5d %4d %8.1g %5d %13.6e\n", iter, qp_iter, alpha, nfun, obj); + endif + +endfunction + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Test Code + +%!function r = __g (x) +%! r = [sumsq(x)-10; +%! x(2)*x(3)-5*x(4)*x(5); +%! x(1)^3+x(2)^3+1 ]; +%!endfunction +%! +%!function obj = __phi (x) +%! obj = exp(prod(x)) - 0.5*(x(1)^3+x(2)^3+1)^2; +%!endfunction +%! +%!test +%! +%! x0 = [-1.8; 1.7; 1.9; -0.8; -0.8]; +%! +%! [x, obj, info, iter, nf, lambda] = sqp (x0, @__phi, @__g, []); +%! +%! x_opt = [-1.717143501952599; +%! 1.595709610928535; +%! 1.827245880097156; +%! -0.763643103133572; +%! -0.763643068453300]; +%! +%! obj_opt = 0.0539498477702739; +%! +%! assert (all (abs (x-x_opt) < 5*sqrt (eps)) && abs (obj-obj_opt) < sqrt (eps)); + +%% Test input validation +%!error sqp () +%!error sqp (1) +%!error sqp (1,2,3,4,5,6,7,8,9) +%!error sqp (1,2,3,4,5) +%!error sqp (ones(2,2)) +%!error sqp (1,cell(4,1)) +%!error sqp (1,cell(3,1),cell(3,1)) +%!error sqp (1,cell(3,1),cell(2,1),cell(3,1)) +%!error sqp (1,cell(3,1),cell(2,1),cell(2,1),ones(2,2),[]) +%!error sqp (1,cell(3,1),cell(2,1),cell(2,1),[],ones(2,2)) +%!error sqp (1,cell(3,1),cell(2,1),cell(2,1),1,-1) +%!error sqp (1,cell(3,1),cell(2,1),cell(2,1),[],[],ones(2,2)) +%!error sqp (1,cell(3,1),cell(2,1),cell(2,1),[],[],-1) +%!error sqp (1,cell(3,1),cell(2,1),cell(2,1),[],[],1.5) +%!error sqp (1,cell(3,1),cell(2,1),cell(2,1),[],[],[],ones(2,2)) +%!error sqp (1,cell(3,1),cell(2,1),cell(2,1),[],[],[],-1) diff --git a/octave_packages/m/path/matlabroot.m b/octave_packages/m/path/matlabroot.m new file mode 100644 index 0000000..571cf5f --- /dev/null +++ b/octave_packages/m/path/matlabroot.m @@ -0,0 +1,35 @@ +## Copyright (C) 2008-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} matlabroot () +## Return the name of the top-level Octave installation directory. +## +## This is an alias for the function @w{@code{OCTAVE_HOME}} provided +## for compatibility. +## @seealso{OCTAVE_HOME} +## @end deftypefn + +function val = matlabroot () + + val = OCTAVE_HOME; + +endfunction + +%!assert (matlabroot(), OCTAVE_HOME()) + diff --git a/octave_packages/m/path/pathdef.m b/octave_packages/m/path/pathdef.m new file mode 100644 index 0000000..fb8bfce --- /dev/null +++ b/octave_packages/m/path/pathdef.m @@ -0,0 +1,136 @@ +## Copyright (C) 2005-2012 Bill Denney +## Copyright (C) 2007-2009 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{val} =} pathdef () +## Return the default path for Octave. +## The path information is extracted from one of three sources. +## In order of preference, those are; +## +## @enumerate +## @item @file{~/.octaverc} +## +## @item @file{/@dots{}//m/startup/octaverc} +## +## @item Octave's path prior to changes by any octaverc. +## @end enumerate +## @seealso{path, addpath, rmpath, genpath, savepath, pathsep} +## @end deftypefn + +function val = pathdef () + + ## Locate the site octaverc file. + pathdir = octave_config_info ("localstartupfiledir"); + site_octaverc = fullfile (pathdir, "octaverc"); + + ## Locate the user ~\.octaverc file. + user_octaverc = fullfile ("~", ".octaverc"); + + ## Extract the specified paths from the site and user octaverc"s. + site_path = __extractpath__ (site_octaverc); + if (exist (user_octaverc, "file")) + user_path = __extractpath__ (user_octaverc); + else + user_path = ""; + endif + + ## A path definition in the user octaverc has precedence over the + ## site. + + if (! isempty (user_path)) + val = user_path; + elseif (! isempty (site_path)) + val = site_path; + else + val = __pathorig__ (); + endif + +endfunction + +## Extact the path information from the script/function @var{file}, +## created by @file{savepath.m}. If @var{file} is omitted, +## @file{~/.octaverc} is used. If successful, @code{__extractpath__} +## returns the path specified in @var{file}. + +## Author: Ben Abbott + +function specifiedpath = __extractpath__ (savefile) + + ## The majority of this code was borrowed from savepath.m. + ## FIXME -- is there some way to share the common parts instead of + ## duplicating? + + beginstring = "## Begin savepath auto-created section, do not edit"; + endstring = "## End savepath auto-created section"; + + if (nargin == 0) + savefile = tilde_expand ("~/.octaverc"); + endif + + ## Parse the file if it exists to see if we should replace a section + ## or create a section. + startline = 0; + endline = 0; + filelines = {}; + if (exist (savefile) == 2) + ## read in all lines of the file + [fid, msg] = fopen (savefile, "rt"); + if (fid < 0) + error ("__extractpath__: could not open savefile, %s: %s", savefile, msg); + endif + unwind_protect + linenum = 0; + while (linenum >= 0) + result = fgetl (fid); + if (isnumeric (result)) + ## End at the end of file. + linenum = -1; + else + linenum++; + filelines{linenum} = result; + ## Find the first and last lines if they exist in the file. + if (strcmp (result, beginstring)) + startline = linenum + 1; + elseif (strcmp (result, endstring)) + endline = linenum - 1; + endif + endif + endwhile + unwind_protect_cleanup + closeread = fclose (fid); + if (closeread < 0) + error ("__extractpath__: could not close savefile after reading, %s", + savefile); + endif + end_unwind_protect + endif + + ## Extract the path specifiation. + if (startline > endline || (startline > 0 && endline == 0)) + error ("__extractpath__: unable to parse file, %s", savefile); + elseif (startline > 0) + ## Undo doubling of single quote characters performed by savepath. + specifiedpath = strrep (regexprep (cstrcat (filelines(startline:endline){:}), + " *path *\\('(.*)'\\); *", "$1"), + "''", "'"); + else + specifiedpath = ""; + endif + +endfunction diff --git a/octave_packages/m/path/savepath.m b/octave_packages/m/path/savepath.m new file mode 100644 index 0000000..7ffd09c --- /dev/null +++ b/octave_packages/m/path/savepath.m @@ -0,0 +1,214 @@ +## Copyright (C) 2005-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} savepath (@var{file}) +## Save the portion of the current function search path, that is +## not set during Octave's initialization process, to @var{file}. +## If @var{file} is omitted, @file{~/.octaverc} is used. If successful, +## @code{savepath} returns 0. +## @seealso{path, addpath, rmpath, genpath, pathdef, pathsep} +## @end deftypefn + +## Author: Bill Denney + +function varargout = savepath (file) + + retval = 1; + + beginstring = "## Begin savepath auto-created section, do not edit"; + endstring = "## End savepath auto-created section"; + + if (nargin == 0) + file = fullfile ("~", ".octaverc"); + endif + + ## parse the file if it exists to see if we should replace a section + ## or create a section + startline = 0; + endline = 0; + filelines = {}; + if (exist (file) == 2) + ## read in all lines of the file + [fid, msg] = fopen (file, "rt"); + if (fid < 0) + error ("savepath: could not open file, %s: %s", file, msg); + endif + unwind_protect + linenum = 0; + while (linenum >= 0) + result = fgetl (fid); + if (isnumeric (result)) + ## end at the end of file + linenum = -1; + else + linenum = linenum + 1; + filelines{linenum} = result; + ## find the first and last lines if they exist in the file + if (strcmp (result, beginstring)) + startline = linenum; + elseif (strcmp (result, endstring)) + endline = linenum; + endif + endif + endwhile + unwind_protect_cleanup + closeread = fclose (fid); + if (closeread < 0) + error ("savepath: could not close file after reading, %s", + file); + endif + end_unwind_protect + endif + + if (startline > endline || (startline > 0 && endline == 0)) + error ("savepath: unable to parse file, %s", file); + endif + + ## put the current savepath lines into the file + if (isempty (filelines) + || (startline == 1 && endline == length (filelines))) + ## savepath is the entire file + pre = post = {}; + elseif (endline == 0) + ## drop the savepath statements at the end of the file + pre = filelines; + post = {}; + elseif (startline == 1) + pre = {}; + post = filelines(endline+1:end); + elseif (endline == length (filelines)) + pre = filelines(1:startline-1); + post = {}; + else + ## insert in the middle + pre = filelines(1:startline-1); + post = filelines(endline+1:end); + endif + + ## write the results + [fid, msg] = fopen (file, "wt"); + if (fid < 0) + error ("savepath: unable to open file for writing, %s, %s", file, msg); + endif + unwind_protect + for i = 1:length (pre) + fprintf (fid, "%s\n", pre{i}); + endfor + + ## Remove the portion of the path defined via the command line + ## and/or the environment. + workingpath = parsepath (path); + command_line_path = parsepath (command_line_path ()); + octave_path = parsepath (getenv ("OCTAVE_PATH")); + if (isempty (pathdef ())) + ## This occurs when running octave via run-octave. In this instance + ## the entire path is specified via the command line and pathdef() + ## is empty. + [tmp, n] = setdiff (workingpath, octave_path); + default_path = command_line_path; + else + [tmp, n] = setdiff (workingpath, union (command_line_path, octave_path)); + default_path = parsepath (pathdef ()); + endif + ## This is the path we'd like to preserve when octave is run. + path_to_preserve = workingpath (sort (n)); + + ## Determine the path to Octave's user and sytem wide pkgs. + [pkg_user, pkg_system] = pkg ("list"); + pkg_user_path = cell (1, numel (pkg_user)); + pkg_system_path = cell (1, numel (pkg_system)); + for n = 1:numel(pkg_user) + pkg_user_path{n} = pkg_user{n}.archprefix; + endfor + for n = 1:numel(pkg_system) + pkg_system_path{n} = pkg_system{n}.archprefix; + endfor + pkg_path = union (pkg_user_path, pkg_system_path); + + ## Rely on Octave's initialization to include the pkg path elements. + if (! isempty (pkg_path)) + [tmp, n] = setdiff (path_to_preserve, strcat (pkg_path, ":")); + path_to_preserve = path_to_preserve (sort (n)); + endif + + ## Split the path to be saved into two groups. Those path elements that + ## belong at the beginning and those at the end. + if (! isempty (default_path)) + n1 = strmatch (default_path{1}, path_to_preserve, "exact"); + n2 = strmatch (default_path{end}, path_to_preserve, "exact"); + n_middle = round (0.5*(n1+n2)); + [tmp, n] = setdiff (path_to_preserve, default_path); + path_to_save = path_to_preserve (sort (n)); + ## Remove pwd + path_to_save = path_to_save (! strcmpi (path_to_save, + strcat (".", pathsep))); + n = ones (size (path_to_save)); + for m = 1:numel(path_to_save) + n(m) = strmatch (path_to_save{m}, path_to_preserve); + endfor + path_to_save_begin = path_to_save(n <= n_middle); + path_to_save_end = path_to_save(n > n_middle); + else + path_to_save_begin = path_to_preserve; + path_to_save_end = {}; + endif + path_to_save_begin = cell2mat (path_to_save_begin); + path_to_save_end = cell2mat (path_to_save_end); + + ## Use single quotes for PATH argument to avoid string escape + ## processing. Since we are using single quotes around the arg, + ## double any single quote characters found in the string. + fprintf (fid, "%s\n", beginstring); + if (! isempty (path_to_save_begin)) + n = find (path_to_save_begin != pathsep, 1, "last"); + fprintf (fid, " addpath ('%s', '-begin');\n", + strrep (path_to_save_begin(1:n), "'", "''")); + endif + if (! isempty (path_to_save_end)) + n = find (path_to_save_end != pathsep, 1, "last"); + fprintf (fid, " addpath ('%s', '-end');\n", + strrep (path_to_save_end(1:n), "'", "''")); + endif + fprintf (fid, "%s\n", endstring); + + for i = 1:length (post) + fprintf (fid, "%s\n", post{i}); + endfor + unwind_protect_cleanup + closeread = fclose (fid); + if (closeread < 0) + error ("savepath: could not close savefile after writing, %s", file); + elseif (nargin == 0) + warning ("savepath: current path saved to %s", file); + endif + end_unwind_protect + + retval = 0; + + if (nargout == 1) + varargout{1} = retval; + endif + +endfunction + +function path_elements = parsepath (p) + pat = sprintf ('([^%s]+[%s$])', pathsep, pathsep); + [~, ~, ~, path_elements] = regexpi (strcat (p, pathsep), pat); +endfunction + diff --git a/octave_packages/m/pkg/pkg.m b/octave_packages/m/pkg/pkg.m new file mode 100644 index 0000000..2cd7e20 --- /dev/null +++ b/octave_packages/m/pkg/pkg.m @@ -0,0 +1,2443 @@ +## Copyright (C) 2005-2012 S�ren Hauberg +## Copyright (C) 2010 VZLU Prague, a.s. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} pkg @var{command} @var{pkg_name} +## @deftypefnx {Command} {} pkg @var{command} @var{option} @var{pkg_name} +## Manage packages (groups of add-on functions) for Octave. Different actions +## are available depending on the value of @var{command}. +## +## Available commands: +## +## @table @samp +## +## @item install +## Install named packages. For example, +## +## @example +## pkg install image-1.0.0.tar.gz +## @end example +## +## @noindent +## installs the package found in the file @file{image-1.0.0.tar.gz}. +## +## The @var{option} variable can contain options that affect the manner +## in which a package is installed. These options can be one or more of +## +## @table @code +## @item -nodeps +## The package manager will disable dependency checking. With this option it +## is possible to install a package even when it depends on another package +## which is not installed on the system. @strong{Use this option with care.} +## +## @item -noauto +## The package manager will not automatically load the installed package +## when starting Octave. This overrides any setting within the package. +## +## @item -auto +## The package manager will automatically load the installed package when +## starting Octave. This overrides any setting within the package. +## +## @item -local +## A local installation (package available only to current user) is forced, +## even if the user has system privileges. +## +## @item -global +## A global installation (package available to all users) is forced, even if +## the user doesn't normally have system privileges. +## +## @item -forge +## Install a package directly from the Octave-Forge repository. This +## requires an internet connection and the cURL library. +## +## @item -verbose +## The package manager will print the output of all commands as +## they are performed. +## @end table +## +## @item update +## Check installed Octave-Forge packages against repository and update any +## outdated items. This requires an internet connection and the cURL library. +## Usage: +## +## @example +## pkg update +## @end example +## +## @item uninstall +## Uninstall named packages. For example, +## +## @example +## pkg uninstall image +## @end example +## +## @noindent +## removes the @code{image} package from the system. If another installed +## package depends on the @code{image} package an error will be issued. +## The package can be uninstalled anyway by using the @option{-nodeps} option. +## +## @item load +## Add named packages to the path. After loading a package it is +## possible to use the functions provided by the package. For example, +## +## @example +## pkg load image +## @end example +## +## @noindent +## adds the @code{image} package to the path. It is possible to load all +## installed packages at once with the keyword @samp{all}. Usage: +## +## @example +## pkg load all +## @end example +## +## @item unload +## Remove named packages from the path. After unloading a package it is +## no longer possible to use the functions provided by the package. It is +## possible to unload all installed packages at once with the keyword +## @samp{all}. Usage: +## +## @example +## pkg unload all +## @end example +## +## @item list +## Show the list of currently installed packages. For example, +## +## @example +## installed_packages = pkg ("list") +## @end example +## +## @noindent +## returns a cell array containing a structure for each installed package. +## +## If two output arguments are requested @code{pkg} splits the list of +## installed packages into those which were installed by the current user, +## and those which were installed by the system administrator. +## +## @example +## [user_packages, system_packages] = pkg ("list") +## @end example +## +## The option '-forge' lists packages available at the Octave-Forge repository. +## This requires an internet connection and the cURL library. For example: +## +## @example +## oct_forge_pkgs = pkg ("list", "-forge") +## @end example +## +## @item describe +## Show a short description of the named installed packages, with the option +## '-verbose' also list functions provided by the package. For example, +## +## @example +## pkg describe -verbose all +## @end example +## +## @noindent +## will describe all installed packages and the functions they provide. +## If one output is requested a cell of structure containing the +## description and list of functions of each package is returned as +## output rather than printed on screen: +## +## @example +## desc = pkg ("describe", "secs1d", "image") +## @end example +## +## @noindent +## If any of the requested packages is not installed, pkg returns an +## error, unless a second output is requested: +## +## @example +## [desc, flag] = pkg ("describe", "secs1d", "image") +## @end example +## +## @noindent +## @var{flag} will take one of the values "Not installed", "Loaded" or +## "Not loaded" for each of the named packages. +## +## @item prefix +## Set the installation prefix directory. For example, +## +## @example +## pkg prefix ~/my_octave_packages +## @end example +## +## @noindent +## sets the installation prefix to @file{~/my_octave_packages}. +## Packages will be installed in this directory. +## +## It is possible to get the current installation prefix by requesting an +## output argument. For example: +## +## @example +## pfx = pkg ("prefix") +## @end example +## +## The location in which to install the architecture dependent files can be +## independently specified with an addition argument. For example: +## +## @example +## pkg prefix ~/my_octave_packages ~/my_arch_dep_pkgs +## @end example +## +## @item local_list +## Set the file in which to look for information on locally +## installed packages. Locally installed packages are those that are +## available only to the current user. For example: +## +## @example +## pkg local_list ~/.octave_packages +## @end example +## +## It is possible to get the current value of local_list with the following +## +## @example +## pkg local_list +## @end example +## +## @item global_list +## Set the file in which to look for information on globally +## installed packages. Globally installed packages are those that are +## available to all users. For example: +## +## @example +## pkg global_list /usr/share/octave/octave_packages +## @end example +## +## It is possible to get the current value of global_list with the following +## +## @example +## pkg global_list +## @end example +## +## @item build +## Build a binary form of a package or packages. The binary file produced +## will itself be an Octave package that can be installed normally with +## @code{pkg}. The form of the command to build a binary package is +## +## @example +## pkg build builddir image-1.0.0.tar.gz @dots{} +## @end example +## +## @noindent +## where @code{builddir} is the name of a directory where the temporary +## installation will be produced and the binary packages will be found. +## The options @option{-verbose} and @option{-nodeps} are respected, while +## all other options are ignored. +## +## @item rebuild +## Rebuild the package database from the installed directories. This can +## be used in cases where the package database has been corrupted. +## It can also take the @option{-auto} and @option{-noauto} options to allow the +## autoloading state of a package to be changed. For example, +## +## @example +## pkg rebuild -noauto image +## @end example +## +## @noindent +## will remove the autoloading status of the image package. +## +## @end table +## @end deftypefn + +function [local_packages, global_packages] = pkg (varargin) + ## Installation prefix (FIXME: what should these be on windows?) + persistent user_prefix = false; + persistent prefix = -1; + persistent archprefix = -1; + persistent local_list = tilde_expand (fullfile ("~", ".octave_packages")); + persistent global_list = fullfile (OCTAVE_HOME (), "share", "octave", + "octave_packages"); + mlock (); + + global_install = issuperuser (); + + if (prefix == -1) + if (global_install) + prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages"); + archprefix = fullfile (octave_config_info ("libdir"), + "octave", "packages"); + else + prefix = fullfile ("~", "octave"); + archprefix = prefix; + endif + prefix = tilde_expand (prefix); + archprefix = tilde_expand (archprefix); + endif + + available_actions = {"list", "install", "uninstall", "load", ... + "unload", "prefix", "local_list", ... + "global_list", "rebuild", "build", ... + "describe", "update"}; + ## Handle input + if (length (varargin) == 0 || ! iscellstr (varargin)) + print_usage (); + endif + files = {}; + deps = true; + auto = 0; + action = "none"; + verbose = false; + octave_forge = false; + for i = 1:length (varargin) + switch (varargin{i}) + case "-nodeps" + deps = false; + case "-noauto" + auto = -1; + case "-auto" + auto = 1; + case "-verbose" + verbose = true; + ## Send verbose output to pager immediately. Change setting locally. + page_output_immediately (true, "local"); + case "-forge" + octave_forge = true; + case "-local" + global_install = false; + if (! user_prefix) + prefix = tilde_expand (fullfile ("~", "octave")); + archprefix = prefix; + endif + case "-global" + global_install = true; + if (! user_prefix) + prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages"); + archprefix = fullfile (octave_config_info ("libdir"), + "octave", "packages"); + endif + case available_actions + if (strcmp (action, "none")) + action = varargin{i}; + else + error ("more than one action specified"); + endif + otherwise + files{end+1} = varargin{i}; + endswitch + endfor + + if (octave_forge && ! any (strcmp (action, {"install", "list"}))) + error ("-forge can only be used with install or list"); + endif + + ## Take action + switch (action) + case "list" + if (octave_forge) + if (nargout > 0) + local_packages = list_forge_packages (); + else + list_forge_packages (); + endif + else + if (nargout == 0) + installed_packages (local_list, global_list); + elseif (nargout == 1) + local_packages = installed_packages (local_list, global_list); + elseif (nargout == 2) + [local_packages, global_packages] = installed_packages (local_list, + global_list); + else + error ("too many output arguments requested"); + endif + endif + + case "install" + if (length (files) == 0) + error ("you must specify at least one filename when calling 'pkg install'"); + endif + + local_files = {}; + unwind_protect + + if (octave_forge) + [urls, local_files] = cellfun ("get_forge_download", files, "uniformoutput", false); + [files, succ] = cellfun ("urlwrite", urls, local_files, "uniformoutput", false); + succ = [succ{:}]; + if (! all (succ)) + i = find (! succ, 1); + error ("could not download file %s from url %s", local_files{i}, urls{i}); + endif + endif + + install (files, deps, auto, prefix, archprefix, verbose, local_list, + global_list, global_install); + + unwind_protect_cleanup + cellfun ("unlink", local_files); + end_unwind_protect + + case "uninstall" + if (length (files) == 0) + error ("you must specify at least one package when calling 'pkg uninstall'"); + endif + uninstall (files, deps, verbose, local_list, + global_list, global_install); + + case "load" + if (length (files) == 0) + error ("you must specify at least one package, 'all' or 'auto' when calling 'pkg load'"); + endif + load_packages (files, deps, local_list, global_list); + + case "unload" + if (length (files) == 0) + error ("you must specify at least one package or 'all' when calling 'pkg unload'"); + endif + unload_packages (files, deps, local_list, global_list); + + case "prefix" + if (length (files) == 0 && nargout == 0) + printf ("Installation prefix: %s\n", prefix); + printf ("Architecture dependent prefix: %s\n", archprefix); + elseif (length (files) == 0 && nargout >= 1) + local_packages = prefix; + global_packages = archprefix; + elseif (length (files) >= 1 && nargout <= 2 && ischar (files{1})) + prefix = files{1}; + prefix = absolute_pathname (prefix); + local_packages = prefix; + user_prefix = true; + if (length (files) >= 2 && ischar (files{2})) + archprefix = files{2}; + try + archprefix = absolute_pathname (archprefix); + catch + mkdir (archprefix); + warning ("creating the directory %s\n", archprefix); + archprefix = absolute_pathname (archprefix); + end_try_catch + global_packages = archprefix; + endif + else + error ("you must specify a prefix directory, or request an output argument"); + endif + + case "local_list" + if (length (files) == 0 && nargout == 0) + disp (local_list); + elseif (length (files) == 0 && nargout == 1) + local_packages = local_list; + elseif (length (files) == 1 && nargout == 0 && ischar (files{1})) + try + local_list = absolute_pathname (files{1}); + catch + ## Force file to be created + fclose (fopen (files{1}, "wt")); + local_list = absolute_pathname (files{1}); + end_try_catch + else + error ("you must specify a local_list file, or request an output argument"); + endif + + case "global_list" + if (length (files) == 0 && nargout == 0) + disp(global_list); + elseif (length (files) == 0 && nargout == 1) + local_packages = global_list; + elseif (length (files) == 1 && nargout == 0 && ischar (files{1})) + try + global_list = absolute_pathname (files{1}); + catch + ## Force file to be created + fclose (fopen (files{1}, "wt")); + global_list = absolute_pathname (files{1}); + end_try_catch + else + error ("you must specify a global_list file, or request an output argument"); + endif + + case "rebuild" + if (global_install) + global_packages = rebuild (prefix, archprefix, global_list, files, + auto, verbose); + global_packages = save_order (global_packages); + save (global_list, "global_packages"); + if (nargout > 0) + local_packages = global_packages; + endif + else + local_packages = rebuild (prefix, archprefix, local_list, files, auto, + verbose); + local_packages = save_order (local_packages); + save (local_list, "local_packages"); + if (nargout == 0) + clear ("local_packages"); + endif + endif + + case "build" + if (length (files) < 2) + error ("you must specify at least the build directory and one filename\nwhen calling 'pkg build'"); + endif + build (files, deps, auto, verbose); + + case "describe" + if (length (files) == 0) + error ("you must specify at least one package or 'all' when calling 'pkg describe'"); + endif + ## FIXME: the name of the output variables is inconsistent + ## with their content + switch (nargout) + case 0 + describe (files, verbose, local_list, global_list); + case 1 + pkg_desc_list = describe (files, verbose, local_list, ... + global_list); + local_packages = pkg_desc_list; + case 2 + [pkg_desc_list, flag] = describe (files, verbose, local_list, ... + global_list); + local_packages = pkg_desc_list; + global_packages = flag; + otherwise + error ("you can request at most two outputs when calling 'pkg describe'"); + endswitch + + case "update" + if (nargout == 0) + installed_pkgs_lst = installed_packages (local_list, global_list); + for i = 1:length (installed_pkgs_lst) + installed_pkg_name = installed_pkgs_lst{i}.name; + installed_pkg_version = installed_pkgs_lst{i}.version; + forge_pkg_version = get_forge_pkg (installed_pkg_name); + if (compare_versions (forge_pkg_version, installed_pkg_version, ">")) + feval (@pkg, "install", "-forge", installed_pkg_name); + endif + endfor + else + error ("no output arguments available"); + endif + + otherwise + error ("you must specify a valid action for 'pkg'. See 'help pkg' for details"); + endswitch +endfunction + +function descriptions = rebuild (prefix, archprefix, list, files, auto, verbose) + if (isempty (files)) + [dirlist, err, msg] = readdir (prefix); + if (err) + error ("couldn't read directory %s: %s", prefix, msg); + endif + ## the two first entries of dirlist are "." and ".." + dirlist([1,2]) = []; + else + old_descriptions = installed_packages (list, list); + wd = pwd (); + unwind_protect + cd (prefix); + dirlist = glob (cellfun(@(x) cstrcat(x, '-*'), files, 'uniformoutput', 0)); + unwind_protect_cleanup + cd (wd); + end_unwind_protect + endif + descriptions = {}; + for k = 1:length (dirlist) + descfile = fullfile (prefix, dirlist{k}, "packinfo", "DESCRIPTION"); + if (verbose) + printf ("recreating package description from %s\n", dirlist{k}); + endif + if (exist (descfile, "file")) + desc = get_description (descfile); + desc.dir = fullfile (prefix, dirlist{k}); + desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-", + desc.version)); + if (auto != 0) + if (exist (fullfile (desc.dir, "packinfo", ".autoload"), "file")) + unlink (fullfile (desc.dir, "packinfo", ".autoload")); + endif + if (auto < 0) + desc.autoload = 0; + elseif (auto > 0) + desc.autoload = 1; + fclose (fopen (fullfile (desc.dir, "packinfo", ".autoload"), "wt")); + endif + else + if (exist (fullfile (desc.dir, "packinfo", ".autoload"), "file")) + desc.autoload = 1; + else + desc.autoload = 0; + endif + endif + descriptions{end + 1} = desc; + elseif (verbose) + warning ("directory %s is not a valid package", dirlist{k}); + endif + endfor + + if (! isempty (files)) + ## We are rebuilding for a particular package(s) so we should take + ## care to keep the other untouched packages in the descriptions + descriptions = {descriptions{:}, old_descriptions{:}}; + + dup = []; + for i = 1:length (descriptions) + if (find (dup, i)) + continue; + endif + for j = (i+1):length (descriptions) + if (find (dup, j)) + continue; + endif + if (strcmp (descriptions{i}.name, descriptions{j}.name)) + dup = [dup, j]; + endif + endfor + endfor + if (! isempty (dup)) + descriptions (dup) = []; + endif + endif +endfunction + +function build (files, handle_deps, autoload, verbose) + if (length (files) < 1) + error ("insufficient number of files"); + endif + builddir = files{1}; + if (! exist (builddir, "dir")) + warning ("creating build directory %s", builddir); + [status, msg] = mkdir (builddir); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + builddir = absolute_pathname (builddir); + installdir = fullfile (builddir, "install"); + if (! exist (installdir, "dir")) + [status, msg] = mkdir (installdir); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + files(1) = []; + buildlist = fullfile (builddir, "octave_packages"); + install (files, handle_deps, autoload, installdir, installdir, verbose, + buildlist, "", false); + unwind_protect + repackage (builddir, buildlist); + unwind_protect_cleanup + unload_packages ({"all"}, handle_deps, buildlist, ""); + if (exist (installdir, "dir")) + rm_rf (installdir); + endif + if (exist (buildlist, "file")) + unlink (buildlist); + endif + end_unwind_protect +endfunction + +function install (files, handle_deps, autoload, prefix, archprefix, verbose, + local_list, global_list, global_install) + + ## Check that the directory in prefix exist. If it doesn't: create it! + if (! exist (prefix, "dir")) + warning ("creating installation directory %s", prefix); + [status, msg] = mkdir (prefix); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + + ## Get the list of installed packages. + [local_packages, global_packages] = installed_packages (local_list, + global_list); + + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + + if (global_install) + packages = global_packages; + else + packages = local_packages; + endif + + ## Uncompress the packages and read the DESCRIPTION files. + tmpdirs = packdirs = descriptions = {}; + try + ## Warn about non existent files. + for i = 1:length (files) + if (isempty (glob(files{i}))) + warning ("file %s does not exist", files{i}); + endif + endfor + + ## Unpack the package files and read the DESCRIPTION files. + files = glob (files); + packages_to_uninstall = []; + for i = 1:length (files) + tgz = files{i}; + + if (exist (tgz, "file")) + ## Create a temporary directory. + tmpdir = tmpnam (); + tmpdirs{end+1} = tmpdir; + if (verbose) + printf ("mkdir (%s)\n", tmpdir); + endif + [status, msg] = mkdir (tmpdir); + if (status != 1) + error ("couldn't create temporary directory: %s", msg); + endif + + ## Uncompress the package. + if (!exist(tgz, "dir")) + if (verbose) + printf ("untar (%s, %s)\n", tgz, tmpdir); + endif + untar (tgz, tmpdir); + + ## Get the name of the directories produced by tar. + [dirlist, err, msg] = readdir (tmpdir); + if (err) + error ("couldn't read directory produced by tar: %s", msg); + endif + + if (length (dirlist) > 3) + error ("bundles of packages are not allowed"); + endif + else + ## we are dealing with a directory, so just copy the files + if (verbose) + printf ("Copying directory (%s, %s)\n", tgz, tmpdir); + endif + [status, msg, msgid] = copyfile (tgz, tmpdir); + if (!status) + disp(msg); + endif + dirlist = {".", "..", tgz}; + endif + endif + + if (exist (tgz, "file") || exist (tgz, "dir")) + ## The two first entries of dirlist are "." and "..". + if (exist (tgz, "file")) + packdir = fullfile (tmpdir, dirlist{3}); + else + packdir = fullfile (pwd(), dirlist{3}); + endif + packdirs{end+1} = packdir; + + ## Make sure the package contains necessary files. + verify_directory (packdir); + + ## Read the DESCRIPTION file. + filename = fullfile (packdir, "DESCRIPTION"); + desc = get_description (filename); + + ## Verify that package name corresponds with filename. + [dummy, nm] = fileparts (tgz); + if ((length (nm) >= length (desc.name)) + && ! strcmp (desc.name, nm(1:length(desc.name)))) + error ("package name '%s' doesn't correspond to its filename '%s'", + desc.name, nm); + endif + + ## Set default installation directory. + desc.dir = fullfile (prefix, cstrcat (desc.name, "-", desc.version)); + + ## Set default architectire dependent installation directory. + desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-", + desc.version)); + + ## Save desc. + descriptions{end+1} = desc; + + ## Are any of the new packages already installed? + ## If so we'll remove the old version. + for j = 1:length (packages) + if (strcmp (packages{j}.name, desc.name)) + packages_to_uninstall(end+1) = j; + endif + endfor + endif + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Check dependencies. + if (handle_deps) + ok = true; + error_text = ""; + for i = 1:length (descriptions) + desc = descriptions{i}; + idx2 = setdiff (1:length(descriptions), i); + if (global_install) + ## Global installation is not allowed to have dependencies on locally + ## installed packages. + idx1 = setdiff (1:length(global_packages), packages_to_uninstall); + pseudo_installed_packages = {global_packages{idx1}, ... + descriptions{idx2}}; + else + idx1 = setdiff (1:length(local_packages), packages_to_uninstall); + pseudo_installed_packages = {local_packages{idx1}, ... + global_packages{:}, ... + descriptions{idx2}}; + endif + bad_deps = get_unsatisfied_deps (desc, pseudo_installed_packages); + ## Are there any unsatisfied dependencies? + if (! isempty (bad_deps)) + ok = false; + for i = 1:length (bad_deps) + dep = bad_deps{i}; + error_text = cstrcat (error_text, " ", desc.name, " needs ", + dep.package, " ", dep.operator, " ", + dep.version, "\n"); + endfor + endif + endfor + + ## Did we find any unsatisfied dependencies? + if (! ok) + error ("the following dependencies where unsatisfied:\n %s", error_text); + endif + endif + + ## Prepare each package for installation. + try + for i = 1:length (descriptions) + desc = descriptions{i}; + pdir = packdirs{i}; + prepare_installation (desc, pdir); + configure_make (desc, pdir, verbose); + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Uninstall the packages that will be replaced. + try + for i = packages_to_uninstall + if (global_install) + uninstall ({global_packages{i}.name}, false, verbose, local_list, + global_list, global_install); + else + uninstall ({local_packages{i}.name}, false, verbose, local_list, + global_list, global_install); + endif + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Install each package. + try + for i = 1:length (descriptions) + desc = descriptions{i}; + pdir = packdirs{i}; + copy_files (desc, pdir, global_install); + create_pkgadddel (desc, pdir, "PKG_ADD", global_install); + create_pkgadddel (desc, pdir, "PKG_DEL", global_install); + finish_installation (desc, pdir, global_install); + generate_lookfor_cache (desc); + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + for i = 1:length (descriptions) + rm_rf (descriptions{i}.dir); + rm_rf (getarchdir (descriptions{i})); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Check if the installed directory is empty. If it is remove it + ## from the list. + for i = length (descriptions):-1:1 + if (dirempty (descriptions{i}.dir, {"packinfo", "doc"}) + && dirempty (getarchdir (descriptions{i}))) + warning ("package %s is empty\n", descriptions{i}.name); + rm_rf (descriptions{i}.dir); + rm_rf (getarchdir (descriptions{i})); + descriptions(i) = []; + endif + endfor + + ## If the package requested that it is autoloaded, or the installer + ## requested that it is, then mark the package as autoloaded. + for i = length (descriptions):-1:1 + if (autoload > 0 || (autoload == 0 && isautoload (descriptions(i)))) + fclose (fopen (fullfile (descriptions{i}.dir, "packinfo", + ".autoload"), "wt")); + descriptions{i}.autoload = 1; + endif + endfor + + ## Add the packages to the package list. + try + if (global_install) + idx = setdiff (1:length(global_packages), packages_to_uninstall); + global_packages = save_order ({global_packages{idx}, descriptions{:}}); + save (global_list, "global_packages"); + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + else + idx = setdiff (1:length(local_packages), packages_to_uninstall); + local_packages = save_order ({local_packages{idx}, descriptions{:}}); + save (local_list, "local_packages"); + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + endif + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + for i = 1:length (descriptions) + rm_rf (descriptions{i}.dir); + endfor + if (global_install) + printf ("error: couldn't append to %s\n", global_list); + else + printf ("error: couldn't append to %s\n", local_list); + endif + rethrow (lasterror ()); + end_try_catch + + ## All is well, let's clean up. + for i = 1:length (tmpdirs) + [status, msg] = rm_rf (tmpdirs{i}); + if (status != 1) + warning ("couldn't clean up after my self: %s\n", msg); + endif + endfor + + ## Add the newly installed packages to the path, so the user + ## can begin using them. Only load them if they are marked autoload. + if (length (descriptions) > 0) + idx = []; + for i = 1:length (descriptions) + if (isautoload (descriptions(i))) + nm = descriptions{i}.name; + for j = 1:length (installed_pkgs_lst) + if (strcmp (nm, installed_pkgs_lst{j}.name)) + idx (end + 1) = j; + break; + endif + endfor + endif + endfor + load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, + global_install); + endif + + ## If there's a NEWS file, mention it + ## we are checking if desc exists too because it's possible to ge to this point + ## without creating it such as giving an invalid filename for the package + if (exist ("desc", "var") && exist (fullfile (desc.dir, "packinfo", "NEWS"), "file")) + printf ("For information about changes from previous versions of the %s package, run 'news (\"%s\")'.\n", + desc.name, desc.name); + endif + +endfunction + +function uninstall (pkgnames, handle_deps, verbose, local_list, + global_list, global_install) + ## Get the list of installed packages. + [local_packages, global_packages] = installed_packages(local_list, + global_list); + if (global_install) + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + else + installed_pkgs_lst = local_packages; + endif + + num_packages = length (installed_pkgs_lst); + delete_idx = []; + for i = 1:num_packages + cur_name = installed_pkgs_lst{i}.name; + if (any (strcmp (cur_name, pkgnames))) + delete_idx(end+1) = i; + endif + endfor + + ## Are all the packages that should be uninstalled already installed? + if (length (delete_idx) != length (pkgnames)) + if (global_install) + ## Try again for a locally installed package. + installed_pkgs_lst = local_packages; + + num_packages = length (installed_pkgs_lst); + delete_idx = []; + for i = 1:num_packages + cur_name = installed_pkgs_lst{i}.name; + if (any (strcmp (cur_name, pkgnames))) + delete_idx(end+1) = i; + endif + endfor + if (length (delete_idx) != length (pkgnames)) + ## FIXME: We should have a better error message. + warning ("some of the packages you want to uninstall are not installed"); + endif + else + ## FIXME: We should have a better error message. + warning ("some of the packages you want to uninstall are not installed"); + endif + endif + + ## Compute the packages that will remain installed. + idx = setdiff (1:num_packages, delete_idx); + remaining_packages = {installed_pkgs_lst{idx}}; + + ## Check dependencies. + if (handle_deps) + error_text = ""; + for i = 1:length (remaining_packages) + desc = remaining_packages{i}; + bad_deps = get_unsatisfied_deps (desc, remaining_packages); + + ## Will the uninstallation break any dependencies? + if (! isempty (bad_deps)) + for i = 1:length (bad_deps) + dep = bad_deps{i}; + error_text = cstrcat (error_text, " ", desc.name, " needs ", + dep.package, " ", dep.operator, " ", + dep.version, "\n"); + endfor + endif + endfor + + if (! isempty (error_text)) + error ("the following dependencies where unsatisfied:\n %s", error_text); + endif + endif + + ## Delete the directories containing the packages. + for i = delete_idx + desc = installed_pkgs_lst{i}; + ## If an 'on_uninstall.m' exist, call it! + if (exist (fullfile (desc.dir, "packinfo", "on_uninstall.m"), "file")) + wd = pwd (); + cd (fullfile (desc.dir, "packinfo")); + on_uninstall (desc); + cd (wd); + endif + ## Do the actual deletion. + if (desc.loaded) + rmpath (desc.dir); + if (exist (getarchdir (desc))) + rmpath (getarchdir (desc)); + endif + endif + if (exist (desc.dir, "dir")) + [status, msg] = rm_rf (desc.dir); + if (status != 1) + error ("couldn't delete directory %s: %s", desc.dir, msg); + endif + [status, msg] = rm_rf (getarchdir (desc)); + if (status != 1) + error ("couldn't delete directory %s: %s", getarchdir (desc), msg); + endif + if (dirempty (desc.archprefix)) + rm_rf (desc.archprefix); + endif + else + warning ("directory %s previously lost", desc.dir); + endif + endfor + + ## Write a new ~/.octave_packages. + if (global_install) + if (length (remaining_packages) == 0) + unlink (global_list); + else + global_packages = save_order (remaining_packages); + save (global_list, "global_packages"); + endif + else + if (length (remaining_packages) == 0) + unlink (local_list); + else + local_packages = save_order (remaining_packages); + save (local_list, "local_packages"); + endif + endif + +endfunction + +function [pkg_desc_list, flag] = describe (pkgnames, verbose, + local_list, global_list) + + ## Get the list of installed packages. + installed_pkgs_lst = installed_packages(local_list, global_list); + num_packages = length (installed_pkgs_lst); + + + describe_all = false; + if (any (strcmp ("all", pkgnames))) + describe_all = true; + flag(1:num_packages) = {"Not Loaded"}; + num_pkgnames = num_packages; + else + num_pkgnames = length (pkgnames); + flag(1:num_pkgnames) = {"Not installed"}; + endif + + for i = 1:num_packages + curr_name = installed_pkgs_lst{i}.name; + if (describe_all) + name_pos = i; + else + name_pos = find(strcmp (curr_name, pkgnames)); + endif + + if (! isempty (name_pos)) + if (installed_pkgs_lst{i}.loaded) + flag{name_pos} = "Loaded"; + else + flag{name_pos} = "Not loaded"; + endif + + pkg_desc_list{name_pos}.name = installed_pkgs_lst{i}.name; + pkg_desc_list{name_pos}.version = installed_pkgs_lst{i}.version; + pkg_desc_list{name_pos}.description = installed_pkgs_lst{i}.description; + pkg_desc_list{name_pos}.provides = parse_pkg_idx (installed_pkgs_lst{i}.dir); + + endif + endfor + + non_inst = find (strcmp (flag, "Not installed")); + if (! isempty (non_inst)) + if (nargout < 2) + non_inst_str = sprintf (" %s ", pkgnames{non_inst}); + error ("some packages are not installed: %s", non_inst_str); + else + pkg_desc_list{non_inst} = struct ("name", {}, "description", + {}, "provides", {}); + endif + endif + + if (nargout == 0) + for i = 1:num_pkgnames + print_package_description (pkg_desc_list{i}.name, + pkg_desc_list{i}.version, + pkg_desc_list{i}.provides, + pkg_desc_list{i}.description, + flag{i}, verbose); + endfor + endif + +endfunction + +## AUXILIARY FUNCTIONS + +## Read an INDEX file. +function [pkg_idx_struct] = parse_pkg_idx (packdir) + + index_file = fullfile (packdir, "packinfo", "INDEX"); + + if (! exist (index_file, "file")) + error ("could not find any INDEX file in directory %s, try 'pkg rebuild all' to generate missing INDEX files", packdir); + endif + + + [fid, msg] = fopen (index_file, "r"); + if (fid == -1) + error ("the INDEX file %s could not be read: %s", + index_file, msg); + endif + + cat_num = 1; + pkg_idx_struct{1}.category = "Uncategorized"; + pkg_idx_struct{1}.functions = {}; + + line = fgetl (fid); + while (isempty (strfind (line, ">>")) && ! feof (fid)) + line = fgetl (fid); + endwhile + + while (! feof (fid) || line != -1) + if (! any (! isspace (line)) || line(1) == "#" || any (line == "=")) + ## Comments, blank lines or comments about unimplemented + ## functions: do nothing + ## FIXME: probably comments and pointers to external functions + ## could be treated better when printing to screen? + elseif (! isempty (strfind (line, ">>"))) + ## Skip package name and description as they are in DESCRIPTION + ## already. + elseif (! isspace (line(1))) + ## Category. + if (! isempty (pkg_idx_struct{cat_num}.functions)) + pkg_idx_struct{++cat_num}.functions = {}; + endif + pkg_idx_struct{cat_num}.category = deblank (line); + else + ## Function names. + while (any (! isspace (line))) + [fun_name, line] = strtok (line); + pkg_idx_struct{cat_num}.functions{end+1} = deblank (fun_name); + endwhile + endif + line = fgetl (fid); + endwhile + fclose (fid); +endfunction + +function print_package_description (pkg_name, pkg_ver, pkg_idx_struct, + pkg_desc, status, verbose) + + printf ("---\nPackage name:\n\t%s\n", pkg_name); + printf ("Version:\n\t%s\n", pkg_ver); + printf ("Short description:\n\t%s\n", pkg_desc); + printf ("Status:\n\t%s\n", status); + if (verbose) + printf ("---\nProvides:\n"); + for i = 1:length(pkg_idx_struct) + if (! isempty (pkg_idx_struct{i}.functions)) + printf ("%s\n", pkg_idx_struct{i}.category); + for j = 1:length(pkg_idx_struct{i}.functions) + printf ("\t%s\n", pkg_idx_struct{i}.functions{j}); + endfor + endif + endfor + endif + +endfunction + + +function pth = absolute_pathname (pth) + [status, msg, msgid] = fileattrib (pth); + if (status != 1) + error ("could not find the file or path %s", pth); + else + pth = msg.Name; + endif +endfunction + +function repackage (builddir, buildlist) + packages = installed_packages (buildlist, buildlist); + + wd = pwd(); + for i = 1 : length(packages) + pack = packages{i}; + unwind_protect + cd (builddir); + mkdir (pack.name); + mkdir (fullfile (pack.name, "inst")); + copyfile (fullfile (pack.dir, "*"), fullfile (pack.name, "inst")); + movefile (fullfile (pack.name, "inst","packinfo", "*"), pack.name); + if (exist (fullfile (pack.name, "inst","packinfo", ".autoload"), "file")) + unlink (fullfile (pack.name, "inst","packinfo", ".autoload")); + endif + rmdir (fullfile (pack.name, "inst", "packinfo")); + if (exist (fullfile (pack.name, "inst", "doc"), "dir")) + movefile (fullfile (pack.name, "inst", "doc"), pack.name); + endif + if (exist (fullfile (pack.name, "inst", "bin"), "dir")) + movefile (fullfile (pack.name, "inst", "bin"), pack.name); + endif + archdir = fullfile (pack.archprefix, cstrcat (pack.name, "-", + pack.version), getarch ()); + if (exist (archdir, "dir")) + if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file")) + unlink (fullfile (pack.name, "inst", "PKG_ADD")); + endif + if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file")) + unlink (fullfile (pack.name, "inst", "PKG_DEL")); + endif + if (exist (fullfile (archdir, "PKG_ADD"), "file")) + movefile (fullfile (archdir, "PKG_ADD"), + fullfile (pack.name, "PKG_ADD")); + endif + if (exist (fullfile (archdir, "PKG_DEL"), "file")) + movefile (fullfile (archdir, "PKG_DEL"), + fullfile (pack.name, "PKG_DEL")); + endif + else + if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file")) + movefile (fullfile (pack.name, "inst", "PKG_ADD"), + fullfile (pack.name, "PKG_ADD")); + endif + if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file")) + movefile (fullfile (pack.name, "inst", "PKG_DEL"), + fullfile (pack.name, "PKG_DEL")); + endif + endif + tfile = cstrcat (pack.name, "-", pack.version, ".tar"); + tar (tfile, pack.name); + try + gzip (tfile); + unlink (tfile); + catch + warning ("failed to compress %s", tfile); + end_try_catch + unwind_protect_cleanup + if (exist (pack.name, "dir")) + rm_rf (pack.name); + endif + cd (wd); + end_unwind_protect + endfor +endfunction + +function auto = isautoload (desc) + auto = false; + if (isfield (desc{1}, "autoload")) + a = desc{1}.autoload; + if ((isnumeric (a) && a > 0) + || (ischar (a) && (strcmpi (a, "true") + || strcmpi (a, "on") + || strcmpi (a, "yes") + || strcmpi (a, "1")))) + auto = true; + endif + endif +endfunction + +function prepare_installation (desc, packdir) + ## Is there a pre_install to call? + if (exist (fullfile (packdir, "pre_install.m"), "file")) + wd = pwd (); + try + cd (packdir); + pre_install (desc); + cd (wd); + catch + cd (wd); + rethrow (lasterror ()); + end_try_catch + endif + + ## If the directory "inst" doesn't exist, we create it. + inst_dir = fullfile (packdir, "inst"); + if (! exist (inst_dir, "dir")) + [status, msg] = mkdir (inst_dir); + if (status != 1) + rm_rf (desc.dir); + error ("the 'inst' directory did not exist and could not be created: %s", + msg); + endif + endif +endfunction + +function configure_make (desc, packdir, verbose) + ## Perform ./configure, make, make install in "src". + if (exist (fullfile (packdir, "src"), "dir")) + src = fullfile (packdir, "src"); + octave_bindir = octave_config_info ("bindir"); + mkoctfile = fullfile (octave_bindir, "mkoctfile"); + octave_config = fullfile (octave_bindir, "octave-config"); + octave_binary = fullfile (octave_bindir, "octave"); + cenv = {"MKOCTFILE"; mkoctfile; + "OCTAVE_CONFIG"; octave_config; + "OCTAVE"; octave_binary; + "INSTALLDIR"; desc.dir}; + scenv = sprintf ("%s=\"%s\" ", cenv{:}); + ## Configure. + if (exist (fullfile (src, "configure"), "file")) + flags = ""; + if (isempty (getenv ("CC"))) + flags = cstrcat (flags, " CC=\"", octave_config_info ("CC"), "\""); + endif + if (isempty (getenv ("CXX"))) + flags = cstrcat (flags, " CXX=\"", octave_config_info ("CXX"), "\""); + endif + if (isempty (getenv ("AR"))) + flags = cstrcat (flags, " AR=\"", octave_config_info ("AR"), "\""); + endif + if (isempty (getenv ("RANLIB"))) + flags = cstrcat (flags, " RANLIB=\"", octave_config_info ("RANLIB"), "\""); + endif + [status, output] = shell (cstrcat ("cd '", src, "'; ", scenv, + "./configure --prefix=\"", + desc.dir, "\"", flags)); + if (status != 0) + rm_rf (desc.dir); + error ("the configure script returned the following error: %s", output); + elseif (verbose) + printf("%s", output); + endif + + endif + + ## Make. + if (exist (fullfile (src, "Makefile"), "file")) + [status, output] = shell (cstrcat (scenv, "make -C '", src, "'")); + if (status != 0) + rm_rf (desc.dir); + error ("'make' returned the following error: %s", output); + elseif (verbose) + printf("%s", output); + endif + endif + + ## Copy files to "inst" and "inst/arch" (this is instead of 'make + ## install'). + files = fullfile (src, "FILES"); + instdir = fullfile (packdir, "inst"); + archdir = fullfile (packdir, "inst", getarch ()); + + ## Get file names. + if (exist (files, "file")) + [fid, msg] = fopen (files, "r"); + if (fid < 0) + error ("couldn't open %s: %s", files, msg); + endif + filenames = char (fread (fid))'; + fclose (fid); + if (filenames(end) == "\n") + filenames(end) = []; + endif + filenames = split_by (filenames, "\n"); + delete_idx = []; + for i = 1:length (filenames) + if (! all (isspace (filenames{i}))) + filenames{i} = fullfile (src, filenames{i}); + else + delete_idx(end+1) = i; + endif + endfor + filenames(delete_idx) = []; + else + m = dir (fullfile (src, "*.m")); + oct = dir (fullfile (src, "*.oct")); + mex = dir (fullfile (src, "*.mex")); + + filenames = cellfun (@(x) fullfile (src, x), + {m.name, oct.name, mex.name}, + "uniformoutput", false); + endif + + ## Split into architecture dependent and independent files. + if (isempty (filenames)) + idx = []; + else + idx = cellfun ("is_architecture_dependent", filenames); + endif + archdependent = filenames (idx); + archindependent = filenames (!idx); + + ## Copy the files. + if (! all (isspace ([filenames{:}]))) + if (! exist (instdir, "dir")) + mkdir (instdir); + endif + if (! all (isspace ([archindependent{:}]))) + if (verbose) + printf ("copyfile"); + printf (" %s", archindependent{:}); + printf ("%s\n", instdir); + endif + [status, output] = copyfile (archindependent, instdir); + if (status != 1) + rm_rf (desc.dir); + error ("Couldn't copy files from 'src' to 'inst': %s", output); + endif + endif + if (! all (isspace ([archdependent{:}]))) + if (verbose) + printf ("copyfile"); + printf (" %s", archdependent{:}); + printf (" %s\n", archdir); + endif + if (! exist (archdir, "dir")) + mkdir (archdir); + endif + [status, output] = copyfile (archdependent, archdir); + if (status != 1) + rm_rf (desc.dir); + error ("Couldn't copy files from 'src' to 'inst': %s", output); + endif + endif + endif + endif +endfunction + +function pkg = extract_pkg (nm, pat) + fid = fopen (nm, "rt"); + pkg = ""; + if (fid >= 0) + while (! feof (fid)) + ln = fgetl (fid); + if (ln > 0) + t = regexp (ln, pat, "tokens"); + if (! isempty (t)) + pkg = cstrcat (pkg, "\n", t{1}{1}); + endif + endif + endwhile + if (! isempty (pkg)) + pkg = cstrcat (pkg, "\n"); + endif + fclose (fid); + endif +endfunction + +function create_pkgadddel (desc, packdir, nm, global_install) + instpkg = fullfile (desc.dir, nm); + instfid = fopen (instpkg, "wt"); + ## If it is exists, most of the PKG_* file should go into the + ## architecture dependent directory so that the autoload/mfilename + ## commands work as expected. The only part that doesn't is the + ## part in the main directory. + archdir = fullfile (getarchprefix (desc), cstrcat (desc.name, "-", + desc.version), getarch ()); + if (exist (getarchdir (desc, global_install), "dir")) + archpkg = fullfile (getarchdir (desc, global_install), nm); + archfid = fopen (archpkg, "at"); + else + archpkg = instpkg; + archfid = instfid; + endif + + if (archfid >= 0 && instfid >= 0) + ## Search all dot-m files for PKG commands. + lst = dir (fullfile (packdir, "inst", "*.m")); + for i = 1:length (lst) + nam = fullfile (packdir, "inst", lst(i).name); + fwrite (instfid, extract_pkg (nam, ['^[#%][#%]* *' nm ': *(.*)$'])); + endfor + + ## Search all C++ source files for PKG commands. + lst = dir (fullfile (packdir, "src", "*.cc")); + for i = 1:length (lst) + nam = fullfile (packdir, "src", lst(i).name); + fwrite (archfid, extract_pkg (nam, ['^//* *' nm ': *(.*)$'])); + fwrite (archfid, extract_pkg (nam, ['^/\** *' nm ': *(.*) *\*/$'])); + endfor + + ## Add developer included PKG commands. + packdirnm = fullfile (packdir, nm); + if (exist (packdirnm, "file")) + fid = fopen (packdirnm, "rt"); + if (fid >= 0) + while (! feof (fid)) + ln = fgets (fid); + if (ln > 0) + fwrite (archfid, ln); + endif + endwhile + fclose (fid); + endif + endif + + ## If the files is empty remove it. + fclose (instfid); + t = dir (instpkg); + if (t.bytes <= 0) + unlink (instpkg); + endif + + if (instfid != archfid) + fclose (archfid); + t = dir (archpkg); + if (t.bytes <= 0) + unlink (archpkg); + endif + endif + endif +endfunction + +function copy_files (desc, packdir, global_install) + ## Create the installation directory. + if (! exist (desc.dir, "dir")) + [status, output] = mkdir (desc.dir); + if (status != 1) + error ("couldn't create installation directory %s : %s", + desc.dir, output); + endif + endif + + octfiledir = getarchdir (desc); + + ## Copy the files from "inst" to installdir. + instdir = fullfile (packdir, "inst"); + if (! dirempty (instdir)) + [status, output] = copyfile (fullfile (instdir, "*"), desc.dir); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't copy files to the installation directory"); + endif + if (exist (fullfile (desc.dir, getarch ()), "dir") + && ! strcmp (fullfile (desc.dir, getarch ()), octfiledir)) + if (! exist (octfiledir, "dir")) + ## Can be required to create upto three levels of dirs. + octm1 = fileparts (octfiledir); + if (! exist (octm1, "dir")) + octm2 = fileparts (octm1); + if (! exist (octm2, "dir")) + octm3 = fileparts (octm2); + if (! exist (octm3, "dir")) + [status, output] = mkdir (octm3); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm3, output); + endif + endif + [status, output] = mkdir (octm2); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm2, output); + endif + endif + [status, output] = mkdir (octm1); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm1, output); + endif + endif + [status, output] = mkdir (octfiledir); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octfiledir, output); + endif + endif + [status, output] = movefile (fullfile (desc.dir, getarch (), "*"), + octfiledir); + rm_rf (fullfile (desc.dir, getarch ())); + + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy files to the installation directory"); + endif + endif + + endif + + ## Create the "packinfo" directory. + packinfo = fullfile (desc.dir, "packinfo"); + [status, msg] = mkdir (packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't create packinfo directory: %s", msg); + endif + + packinfo_copy_file ("DESCRIPTION", "required", packdir, packinfo, desc, octfiledir); + packinfo_copy_file ("COPYING", "required", packdir, packinfo, desc, octfiledir); + + packinfo_copy_file ("NEWS", "optional", packdir, packinfo, desc, octfiledir); + packinfo_copy_file ("ONEWS", "optional", packdir, packinfo, desc, octfiledir); + packinfo_copy_file ("ChangeLog", "optional", packdir, packinfo, desc, octfiledir); + + ## Is there an INDEX file to copy or should we generate one? + index_file = fullfile (packdir, "INDEX"); + if (exist(index_file, "file")) + packinfo_copy_file ("INDEX", "required", packdir, packinfo, desc, octfiledir); + else + try + write_index (desc, fullfile (packdir, "inst"), + fullfile (packinfo, "INDEX"), global_install); + catch + rm_rf (desc.dir); + rm_rf (octfiledir); + rethrow (lasterror ()); + end_try_catch + endif + + ## Is there an 'on_uninstall.m' to install? + packinfo_copy_file ("on_uninstall.m", "optional", packdir, packinfo, desc, octfiledir); + + ## Is there a doc/ directory that needs to be installed? + docdir = fullfile (packdir, "doc"); + if (exist (docdir, "dir") && ! dirempty (docdir)) + [status, output] = copyfile (docdir, desc.dir); + endif + + ## Is there a bin/ directory that needs to be installed? + ## FIXME: Need to treat architecture dependent files in bin/ + bindir = fullfile (packdir, "bin"); + if (exist (bindir, "dir") && ! dirempty (bindir)) + [status, output] = copyfile (bindir, desc.dir); + endif +endfunction + +function packinfo_copy_file (filename, requirement, packdir, packinfo, desc, octfiledir) + filepath = fullfile (packdir, filename); + if (!exist (filepath, "file") && strcmpi (requirement, "optional")) + ## do nothing, it's still OK + else + [status, output] = copyfile (filepath, packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("Couldn't copy %s file: %s", filename, output); + endif + endif +endfunction + +function finish_installation (desc, packdir, global_install) + ## Is there a post-install to call? + if (exist (fullfile (packdir, "post_install.m"), "file")) + wd = pwd (); + try + cd (packdir); + post_install (desc); + cd (wd); + catch + cd (wd); + rm_rf (desc.dir); + rm_rf (getarchdir (desc), global_install); + rethrow (lasterror ()); + end_try_catch + endif +endfunction + +function generate_lookfor_cache (desc) + dirs = split_by (genpath (desc.dir), pathsep ()); + for i = 1 : length (dirs) + gen_doc_cache (fullfile (dirs{i}, "doc-cache"), dirs{i}); + endfor +endfunction + +## Make sure the package contains the essential files. +function verify_directory (dir) + needed_files = {"COPYING", "DESCRIPTION"}; + for f = needed_files + if (! exist (fullfile (dir, f{1}), "file")) + error ("package is missing file: %s", f{1}); + endif + endfor +endfunction + +## Parse the DESCRIPTION file. +function desc = get_description (filename) + [fid, msg] = fopen (filename, "r"); + if (fid == -1) + error ("the DESCRIPTION file %s could not be read: %s", filename, msg); + endif + + desc = struct (); + + line = fgetl (fid); + while (line != -1) + if (line(1) == "#") + ## Comments, do nothing. + elseif (isspace(line(1))) + ## Continuation lines + if (exist ("keyword", "var") && isfield (desc, keyword)) + desc.(keyword) = cstrcat (desc.(keyword), " ", rstrip(line)); + endif + else + ## Keyword/value pair + colon = find (line == ":"); + if (length (colon) == 0) + disp ("skipping line"); + else + colon = colon(1); + keyword = tolower (strip (line(1:colon-1))); + value = strip (line (colon+1:end)); + if (length (value) == 0) + fclose (fid); + error ("The keyword `%s' of the package `%s' has an empty value", + keyword, desc.name); + endif + desc.(keyword) = value; + endif + endif + line = fgetl (fid); + endwhile + fclose (fid); + + ## Make sure all is okay. + needed_fields = {"name", "version", "date", "title", ... + "author", "maintainer", "description"}; + for f = needed_fields + if (! isfield (desc, f{1})) + error ("description is missing needed field %s", f{1}); + endif + endfor + desc.version = fix_version (desc.version); + if (isfield (desc, "depends")) + desc.depends = fix_depends (desc.depends); + else + desc.depends = ""; + endif + desc.name = tolower (desc.name); +endfunction + +## Make sure the version string v is a valid x.y.z version string +## Examples: "0.1" => "0.1.0", "monkey" => error(...). +function out = fix_version (v) + dots = find (v == "."); + if (length (dots) == 1) + major = str2num (v(1:dots-1)); + minor = str2num (v(dots+1:end)); + if (length (major) != 0 && length (minor) != 0) + out = sprintf ("%d.%d.0", major, minor); + return; + endif + elseif (length (dots) == 2) + major = str2num (v(1:dots(1)-1)); + minor = str2num (v(dots(1)+1:dots(2)-1)); + rev = str2num (v(dots(2)+1:end)); + if (length (major) != 0 && length (minor) != 0 && length (rev) != 0) + out = sprintf ("%d.%d.%d", major, minor, rev); + return; + endif + endif + error ("bad version string: %s", v); +endfunction + +## Make sure the depends field is of the right format. +## This function returns a cell of structures with the following fields: +## package, version, operator +function deps_cell = fix_depends (depends) + deps = split_by (tolower (depends), ","); + deps_cell = cell (1, length (deps)); + + ## For each dependency. + for i = 1:length (deps) + dep = deps{i}; + lpar = find (dep == "("); + rpar = find (dep == ")"); + ## Does the dependency specify a version + ## Example: package(>= version). + if (length (lpar) == 1 && length (rpar) == 1) + package = tolower (strip (dep(1:lpar-1))); + sub = dep(lpar(1)+1:rpar(1)-1); + parts = strsplit (sub, " ", true); + if (length (parts) != 2) + error ("incorrect syntax for dependency `%s' in the DESCRIPTION file\n", + dep); + endif + operator = parts{1}; + if (! any (strcmp (operator, {">", ">=", "<=", "<", "=="}))) + error ("unsupported operator: %s", operator); + endif + version = fix_version (parts{2}); + + ## If no version is specified for the dependency + ## we say that the version should be greater than + ## or equal to "0.0.0". + else + package = tolower (strip (dep)); + operator = ">="; + version = "0.0.0"; + endif + deps_cell{i} = struct ("package", package, "operator", operator, + "version", version); + endfor +endfunction + +## Strip the text of spaces from the right +## Example: " hello world " => " hello world" +## FIXME -- is this the same as deblank? +function text = rstrip (text) + chars = find (! isspace (text)); + if (length (chars) > 0) + ## FIXME: shouldn't it be text = text(1:chars(end)); + text = text (chars(1):end); + else + text = ""; + endif +endfunction + +## Strip the text of spaces from the left and the right. +## Example: " hello world " => "hello world" +function text = strip (text) + chars = find (! isspace (text)); + if (length (chars) > 0) + text = text(chars(1):chars(end)); + else + text = ""; + endif +endfunction + +## Split the text into a cell array of strings by sep. +## Example: "A, B" => {"A", "B"} (with sep = ",") +function out = split_by (text, sep) + out = strtrim (strsplit (text, sep)); +endfunction + +## Create an INDEX file for a package that doesn't provide one. +## 'desc' describes the package. +## 'dir' is the 'inst' directory in temporary directory. +## 'index_file' is the name (including path) of resulting INDEX file. +function write_index (desc, dir, index_file, global_install) + ## Get names of functions in dir + [files, err, msg] = readdir (dir); + if (err) + error ("couldn't read directory %s: %s", dir, msg); + endif + + ## Get classes in dir + class_idx = strmatch ("@", files); + for k = 1:length (class_idx) + class_name = files {class_idx (k)}; + class_dir = fullfile (dir, class_name); + if (exist (class_dir, "dir")) + [files2, err, msg] = readdir (class_dir); + if (err) + error ("couldn't read directory %s: %s", class_dir, msg); + endif + files2 = strcat (class_name, filesep (), files2); + files = [files; files2]; + endif + endfor + + ## Check for architecture dependent files. + tmpdir = getarchdir (desc); + if (exist (tmpdir, "dir")) + [files2, err, msg] = readdir (tmpdir); + if (err) + error ("couldn't read directory %s: %s", tmpdir, msg); + endif + files = [files; files2]; + endif + + functions = {}; + for i = 1:length (files) + file = files{i}; + lf = length (file); + if (lf > 2 && strcmp (file(end-1:end), ".m")) + functions{end+1} = file(1:end-2); + elseif (lf > 4 && strcmp (file(end-3:end), ".oct")) + functions{end+1} = file(1:end-4); + endif + endfor + + ## Does desc have a categories field? + if (! isfield (desc, "categories")) + error ("the DESCRIPTION file must have a Categories field, when no INDEX file is given"); + endif + categories = split_by (desc.categories, ","); + if (length (categories) < 1) + error ("the Category field is empty"); + endif + + ## Write INDEX. + fid = fopen (index_file, "w"); + if (fid == -1) + error ("couldn't open %s for writing", index_file); + endif + fprintf (fid, "%s >> %s\n", desc.name, desc.title); + fprintf (fid, "%s\n", categories{1}); + fprintf (fid, " %s\n", functions{:}); + fclose (fid); +endfunction + +function bad_deps = get_unsatisfied_deps (desc, installed_pkgs_lst) + bad_deps = {}; + + ## For each dependency. + for i = 1:length (desc.depends) + dep = desc.depends{i}; + + ## Is the current dependency Octave? + if (strcmp (dep.package, "octave")) + if (! compare_versions (OCTAVE_VERSION, dep.version, dep.operator)) + bad_deps{end+1} = dep; + endif + ## Is the current dependency not Octave? + else + ok = false; + for i = 1:length (installed_pkgs_lst) + cur_name = installed_pkgs_lst{i}.name; + cur_version = installed_pkgs_lst{i}.version; + if (strcmp (dep.package, cur_name) + && compare_versions (cur_version, dep.version, dep.operator)) + ok = true; + break; + endif + endfor + if (! ok) + bad_deps{end+1} = dep; + endif + endif + endfor +endfunction + +function [out1, out2] = installed_packages (local_list, global_list) + ## Get the list of installed packages. + try + local_packages = load (local_list).local_packages; + catch + local_packages = {}; + end_try_catch + try + global_packages = load (global_list).global_packages; + catch + global_packages = {}; + end_try_catch + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + + ## Eliminate duplicates in the installed package list. + ## Locally installed packages take precedence. + dup = []; + for i = 1:length (installed_pkgs_lst) + if (find (dup, i)) + continue; + endif + for j = (i+1):length (installed_pkgs_lst) + if (find (dup, j)) + continue; + endif + if (strcmp (installed_pkgs_lst{i}.name, installed_pkgs_lst{j}.name)) + dup = [dup, j]; + endif + endfor + endfor + if (! isempty(dup)) + installed_pkgs_lst(dup) = []; + endif + + ## Now check if the package is loaded. + tmppath = strrep (path(), "\\", "/"); + for i = 1:length (installed_pkgs_lst) + if (findstr (tmppath, strrep (installed_pkgs_lst{i}.dir, "\\", "/"))) + installed_pkgs_lst{i}.loaded = true; + else + installed_pkgs_lst{i}.loaded = false; + endif + endfor + for i = 1:length (local_packages) + if (findstr (tmppath, strrep (local_packages{i}.dir, "\\", "/"))) + local_packages{i}.loaded = true; + else + local_packages{i}.loaded = false; + endif + endfor + for i = 1:length (global_packages) + if (findstr (tmppath, strrep (global_packages{i}.dir, "\\", "/"))) + global_packages{i}.loaded = true; + else + global_packages{i}.loaded = false; + endif + endfor + + ## Should we return something? + if (nargout == 2) + out1 = local_packages; + out2 = global_packages; + return; + elseif (nargout == 1) + out1 = installed_pkgs_lst; + return; + endif + + ## We shouldn't return something, so we'll print something. + num_packages = length (installed_pkgs_lst); + if (num_packages == 0) + printf ("no packages installed.\n"); + return; + endif + + ## Compute the maximal lengths of name, version, and dir. + h1 = "Package Name"; + h2 = "Version"; + h3 = "Installation directory"; + max_name_length = length (h1); + max_version_length = length (h2); + names = cell (num_packages, 1); + for i = 1:num_packages + max_name_length = max (max_name_length, + length (installed_pkgs_lst{i}.name)); + max_version_length = max (max_version_length, + length (installed_pkgs_lst{i}.version)); + names{i} = installed_pkgs_lst{i}.name; + endfor + max_dir_length = terminal_size()(2) - max_name_length - ... + max_version_length - 7; + if (max_dir_length < 20) + max_dir_length = Inf; + endif + + h1 = postpad (h1, max_name_length + 1, " "); + h2 = postpad (h2, max_version_length, " ");; + + ## Print a header. + header = sprintf("%s | %s | %s\n", h1, h2, h3); + printf (header); + tmp = sprintf (repmat ("-", 1, length(header)-1)); + tmp(length(h1)+2) = "+"; + tmp(length(h1)+length(h2)+5) = "+"; + printf ("%s\n", tmp); + + ## Print the packages. + format = sprintf ("%%%ds %%1s| %%%ds | %%s\n", max_name_length, + max_version_length); + [dummy, idx] = sort (names); + for i = 1:num_packages + cur_name = installed_pkgs_lst{idx(i)}.name; + cur_version = installed_pkgs_lst{idx(i)}.version; + cur_dir = installed_pkgs_lst{idx(i)}.dir; + if (length (cur_dir) > max_dir_length) + first_char = length (cur_dir) - max_dir_length + 4; + first_filesep = strfind (cur_dir(first_char:end), filesep()); + if (! isempty (first_filesep)) + cur_dir = cstrcat ("...", + cur_dir((first_char + first_filesep(1) - 1):end)); + else + cur_dir = cstrcat ("...", cur_dir(first_char:end)); + endif + endif + if (installed_pkgs_lst{idx(i)}.loaded) + cur_loaded = "*"; + else + cur_loaded = " "; + endif + printf (format, cur_name, cur_loaded, cur_version, cur_dir); + endfor +endfunction + +function load_packages (files, handle_deps, local_list, global_list) + installed_pkgs_lst = installed_packages (local_list, global_list); + num_packages = length (installed_pkgs_lst); + + ## Read package names and installdirs into a more convenient format. + pnames = pdirs = cell (1, num_packages); + for i = 1:num_packages + pnames{i} = installed_pkgs_lst{i}.name; + pdirs{i} = installed_pkgs_lst{i}.dir; + endfor + + ## Load all. + if (length (files) == 1 && strcmp (files{1}, "all")) + idx = [1:length(installed_pkgs_lst)]; + ## Load auto. + elseif (length (files) == 1 && strcmp (files{1}, "auto")) + idx = []; + for i = 1:length (installed_pkgs_lst) + if (exist (fullfile (pdirs{i}, "packinfo", ".autoload"), "file")) + idx (end + 1) = i; + endif + endfor + ## Load package_name1 ... + else + idx = []; + for i = 1:length (files) + idx2 = find (strcmp (pnames, files{i})); + if (! any (idx2)) + error ("package %s is not installed", files{i}); + endif + idx (end + 1) = idx2; + endfor + endif + + ## Load the packages, but take care of the ordering of dependencies. + load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, true); +endfunction + +function unload_packages (files, handle_deps, local_list, global_list) + installed_pkgs_lst = installed_packages (local_list, global_list); + num_packages = length (installed_pkgs_lst); + + ## Read package names and installdirs into a more convenient format. + pnames = pdirs = cell (1, num_packages); + for i = 1:num_packages + pnames{i} = installed_pkgs_lst{i}.name; + pdirs{i} = installed_pkgs_lst{i}.dir; + pdeps{i} = installed_pkgs_lst{i}.depends; + endfor + + ## Get the current octave path. + p = split_by (path(), pathsep ()); + + if (length (files) == 1 && strcmp (files{1}, "all")) + ## Unload all. + dirs = pdirs; + desc = installed_pkgs_lst; + else + ## Unload package_name1 ... + dirs = {}; + desc = {}; + for i = 1:length (files) + idx = strcmp (pnames, files{i}); + if (! any (idx)) + error ("package %s is not installed", files{i}); + endif + dirs{end+1} = pdirs{idx}; + desc{end+1} = installed_pkgs_lst{idx}; + endfor + endif + + ## Check for architecture dependent directories. + archdirs = {}; + for i = 1:length (dirs) + tmpdir = getarchdir (desc{i}); + if (exist (tmpdir, "dir")) + archdirs{end+1} = dirs{i}; + archdirs{end+1} = tmpdir; + else + archdirs{end+1} = dirs{i}; + endif + endfor + + ## Unload the packages. + for i = 1:length (archdirs) + d = archdirs{i}; + idx = strcmp (p, d); + if (any (idx)) + rmpath (d); + ## FIXME: We should also check if we need to remove items from + ## EXEC_PATH. + endif + endfor +endfunction + +function [status_out, msg_out] = rm_rf (dir) + if (exist (dir)) + crr = confirm_recursive_rmdir (false, "local"); + [status, msg] = rmdir (dir, "s"); + else + status = 1; + msg = ""; + endif + if (nargout > 0) + status_out = status; + endif + if (nargout > 1) + msg_out = msg; + endif +endfunction + +function emp = dirempty (nm, ign) + if (exist (nm, "dir")) + if (nargin < 2) + ign = {".", ".."}; + else + ign = [{".", ".."}, ign]; + endif + l = dir (nm); + for i = 1:length (l) + found = false; + for j = 1:length (ign) + if (strcmp (l(i).name, ign{j})) + found = true; + break; + endif + endfor + if (! found) + emp = false; + return + endif + endfor + emp = true; + else + emp = true; + endif +endfunction + +function arch = getarch () + persistent _arch = cstrcat (octave_config_info ("canonical_host_type"), + "-", octave_config_info ("api_version")); + arch = _arch; +endfunction + +function archprefix = getarchprefix (desc, global_install) + if ((nargin == 2 && global_install) || (nargin < 2 && issuperuser ())) + archprefix = fullfile (octave_config_info ("libdir"), "octave", + "packages", cstrcat(desc.name, "-", desc.version)); + else + archprefix = desc.dir; + endif +endfunction + +function archdir = getarchdir (desc) + archdir = fullfile (desc.archprefix, getarch()); +endfunction + +function s = issuperuser () + if ((ispc () && ! isunix ()) || (geteuid() == 0)) + s = true; + else + s = false; + endif +endfunction + +function [status, output] = shell (cmd) + persistent have_sh; + + cmd = strrep (cmd, "\\", "/"); + if (ispc () && ! isunix ()) + if (isempty(have_sh)) + if (system("sh.exe -c \"exit\"")) + have_sh = false; + else + have_sh = true; + endif + endif + if (have_sh) + [status, output] = system (cstrcat ("sh.exe -c \"", cmd, "\"")); + else + error ("Can not find the command shell"); + endif + else + [status, output] = system (cmd); + endif +endfunction + +function newdesc = save_order (desc) + newdesc = {}; + for i = 1 : length(desc) + deps = desc{i}.depends; + if (isempty (deps) + || (length (deps) == 1 && strcmp(deps{1}.package, "octave"))) + newdesc {end + 1} = desc{i}; + else + tmpdesc = {}; + for k = 1 : length (deps) + for j = 1 : length (desc) + if (strcmp (desc{j}.name, deps{k}.package)) + tmpdesc{end+1} = desc{j}; + break; + endif + endfor + endfor + if (! isempty (tmpdesc)) + newdesc = {newdesc{:}, save_order(tmpdesc){:}, desc{i}}; + else + newdesc{end+1} = desc{i}; + endif + endif + endfor + ## Eliminate the duplicates. + idx = []; + for i = 1 : length (newdesc) + for j = (i + 1) : length (newdesc) + if (strcmp (newdesc{i}.name, newdesc{j}.name)) + idx (end + 1) = j; + endif + endfor + endfor + newdesc(idx) = []; +endfunction + +function load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, + global_install) + idx = load_package_dirs (idx, [], handle_deps, installed_pkgs_lst); + dirs = {}; + execpath = EXEC_PATH (); + for i = idx; + ndir = installed_pkgs_lst{i}.dir; + dirs{end+1} = ndir; + if (exist (fullfile (dirs{end}, "bin"), "dir")) + execpath = cstrcat (execpath, pathsep (), fullfile (dirs{end}, "bin")); + endif + tmpdir = getarchdir (installed_pkgs_lst{i}); + if (exist (tmpdir, "dir")) + dirs{end + 1} = tmpdir; + if (exist (fullfile (dirs{end}, "bin"), "dir")) + execpath = cstrcat (execpath, pathsep (), fullfile (dirs{end}, "bin")); + endif + endif + endfor + + ## Load the packages. + if (length (dirs) > 0) + addpath (dirs{:}); + endif + + ## Add the binaries to exec_path. + if (! strcmp (EXEC_PATH, execpath)) + EXEC_PATH (execpath); + endif +endfunction + +function idx = load_package_dirs (lidx, idx, handle_deps, installed_pkgs_lst) + for i = lidx + if (isfield (installed_pkgs_lst{i}, "loaded") + && installed_pkgs_lst{i}.loaded) + continue; + else + if (handle_deps) + deps = installed_pkgs_lst{i}.depends; + if ((length (deps) > 1) + || (length (deps) == 1 && ! strcmp(deps{1}.package, "octave"))) + tmplidx = []; + for k = 1 : length (deps) + for j = 1 : length (installed_pkgs_lst) + if (strcmp (installed_pkgs_lst{j}.name, deps{k}.package)) + tmplidx (end + 1) = j; + break; + endif + endfor + endfor + idx = load_package_dirs (tmplidx, idx, handle_deps, + installed_pkgs_lst); + endif + endif + if (isempty (find(idx == i))) + idx (end + 1) = i; + endif + endif + endfor +endfunction + +function dep = is_architecture_dependent (nm) + persistent archdepsuffix = {".oct",".mex",".a",".lib",".so",".so.*",".dll","dylib"}; + + dep = false; + for i = 1 : length (archdepsuffix) + ext = archdepsuffix{i}; + if (ext(end) == "*") + isglob = true; + ext(end) = []; + else + isglob = false; + endif + pos = findstr (nm, ext); + if (pos) + if (! isglob && (length(nm) - pos(end) != length(ext) - 1)) + continue; + endif + dep = true; + break; + endif + endfor +endfunction + +function [url, local_file] = get_forge_download (name) + [ver, url] = get_forge_pkg (name); + local_file = [name, "-", ver, ".tar.gz"]; +endfunction + +function list = list_forge_packages () + [list, succ] = urlread ("http://octave.sourceforge.net/list_packages.php"); + if (succ) + list = strsplit (list, " \n\t", true); + else + error ("pkg: could not read URL, please verify internet connection"); + endif + if (nargout == 0) + page_screen_output (false, "local"); + puts ("OctaveForge provides these packages:\n"); + for i = 1:length (list) + try + ver = get_forge_pkg (list{i}); + catch + ver = "unknown"; + end_try_catch + printf (" %s %s\n", list{i}, ver); + endfor + endif +endfunction diff --git a/octave_packages/m/pkg/private/get_forge_pkg.m b/octave_packages/m/pkg/private/get_forge_pkg.m new file mode 100644 index 0000000..2a9f8aa --- /dev/null +++ b/octave_packages/m/pkg/private/get_forge_pkg.m @@ -0,0 +1,81 @@ +## Copyright (C) 2010-2012 VZLU Prague, a.s. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{ver}, @var{url}] =} get_forge_pkg (@var{name}) +## Try to discover the current version of an OctaveForge package from the web, +## using a working internet connection and the urlread function. +## If two output arguments are requested, also return an address from which +## to download the file. +## @end deftypefn + +function [ver, url] = get_forge_pkg (name) + if (nargin != 1) + print_usage (); + endif + ## Verify that name is valid. + if (! (ischar (name) && rows (name) == 1 && ndims (name) == 2)) + error ("get_forge_pkg: package NAME must be a string"); + elseif (! all (isalnum (name) | name == "-" | name == "." | name == "_")) + error ("get_forge_pkg: invalid package name: %s", name); + endif + + name = tolower (name); + + ## Try to download package's index page. + [html, succ] = urlread (sprintf ("http://octave.sourceforge.net/%s/index.html", name)); + if (succ) + ## Remove blanks for simpler matching. + html(isspace(html)) = []; + ## Good. Let's grep for the version. + pat = "PackageVersion:([\\d.]*)"; + t = regexp (html, pat, "tokens"); + if (isempty (t) || isempty(t{1})) + error ("get_forge_pkg: could not read version number from package's page"); + else + ver = t{1}{1}; + if (nargout > 1) + # Build download string. + urlbase = "http://downloads.sourceforge.net/octave/%s-%s.tar.gz?download"; + url = sprintf (urlbase, name, ver); + ## Verify that the string exists on the page. + if (isempty (strfind (html, url))) + warning ("get_forge_pkg: download URL not verified"); + endif + endif + endif + else + ## Try get the list of all packages. + [html, succ] = urlread ("http://octave.sourceforge.net/packages.php"); + if (succ) + t = regexp (html, "
", "tokens"); + t = horzcat (t{:}); + if (any (strcmp (t, name))) + error ("get_forge_pkg: package NAME exists, but index page not available"); + else + ## Try a simplistic method to determine close names. + dist = cellfun (@(n) length (setdiff (name, n)), t); + [~, i] = min (dist); + error ("get_forge_pkg: package not found: ""%s"". Maybe you meant ""%s?""", name, t{i}); + endif + else + error ("get_forge_pkg: could not read URL, please verify internet connection"); + endif + endif + +endfunction diff --git a/octave_packages/m/plot/__gnuplot_drawnow__.m b/octave_packages/m/plot/__gnuplot_drawnow__.m new file mode 100644 index 0000000..76fd1bf --- /dev/null +++ b/octave_packages/m/plot/__gnuplot_drawnow__.m @@ -0,0 +1,392 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __gnuplot_drawnow__ (@var{h}, @var{term}, @var{file}, @var{mono}, @var{debug_file}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function __gnuplot_drawnow__ (h, term, file, mono, debug_file) + + if (nargin < 4) + mono = false; + endif + + if (nargin >= 3 && nargin <= 5) + ## Produce various output formats, or redirect gnuplot stream to a + ## debug file. + plot_stream = []; + fid = []; + default_plot_stream = get (h, "__plot_stream__"); + unwind_protect + plot_stream = __gnuplot_open_stream__ (2, h); + gnuplot_supports_term = __gnuplot_has_terminal__ (term, plot_stream); + if (gnuplot_supports_term) + enhanced = gnuplot_set_term (plot_stream (1), true, h, term, file); + __go_draw_figure__ (h, plot_stream(1), enhanced, mono); + if (nargin == 5) + fid = fopen (debug_file, "wb"); + enhanced = gnuplot_set_term (fid, true, h, term, file); + __go_draw_figure__ (h, fid, enhanced, mono); + endif + else + error ("__gnuplot_drawnow__: the gnuplot terminal, \"%s\", is not available", + gnuplot_trim_term (term)); + endif + unwind_protect_cleanup + set (h, "__plot_stream__", default_plot_stream); + if (! isempty (plot_stream)) + pclose (plot_stream(1)); + if (numel (plot_stream) > 1) + pclose (plot_stream(2)); + endif + if (numel (plot_stream) > 2) + waitpid (plot_stream(3)); + endif + endif + if (! isempty (fid)) + fclose (fid); + endif + end_unwind_protect + elseif (nargin == 1) + ## Graphics terminal for display. + plot_stream = get (h, "__plot_stream__"); + if (isempty (plot_stream)) + plot_stream = __gnuplot_open_stream__ (2, h); + new_stream = true; + else + new_stream = false; + endif + term = gnuplot_default_term (); + if (strcmp (term, "dumb")) + ## popen2 eats stdout of gnuplot, use temporary file instead + dumb_tmp_file = tmpnam (); + enhanced = gnuplot_set_term (plot_stream (1), new_stream, h, ... + term, dumb_tmp_file); + else + enhanced = gnuplot_set_term (plot_stream (1), new_stream, h, term); + endif + __go_draw_figure__ (h, plot_stream (1), enhanced, mono); + fflush (plot_stream (1)); + if (strcmp (term, "dumb")) + fid = -1; + while (fid < 0) + pause (0.1); + fid = fopen (dumb_tmp_file, 'r'); + endwhile + ## reprint the plot on screen + [a, count] = fscanf (fid, '%c', Inf); + fclose (fid); + if (count>0) + if (a(1)==12) + ## avoid ^L at the beginning + a = a(2:end); + endif + puts (a); + endif + unlink (dumb_tmp_file); + endif + else + print_usage (); + endif + +endfunction + +function enhanced = gnuplot_set_term (plot_stream, new_stream, h, term, file) + ## Generate the gnuplot "set terminal ..." command. + ## When "term" originates from print.m, it may include other options. + if (nargin < 4) + ## This supports the gnuplot graphics toolkit. + term = gnuplot_default_term (); + opts_str = ""; + else + ## Get the one word terminal id and save the remaining as options to + ## be passed on to gnuplot. The terminal may respect the graphics + ## toolkit. + [term, opts_str] = gnuplot_trim_term (term); + term = lower (term); + if (strcmpi (term, "lua")) + ## Replace "lau tikz" with + term = "tikz"; + opts_str = strrep (opts_str, "tikz", ""); + endif + endif + + if (strfind (opts_str, "noenhanced")) + enhanced = false; + else + enhanced = gnuplot_is_enhanced_term (term); + endif + + ## Set the terminal. + if (! isempty (term)) + + if (enhanced) + enh_str = "enhanced"; + else + enh_str = ""; + endif + + if (! isempty (h) && isfigure (h)) + + ## Generate gnuplot title string for plot windows. + if (output_to_screen (term) && ~strcmp (term, "dumb")) + fig.numbertitle = get (h, "numbertitle"); + fig.name = strrep (get (h, "name"), "\"", "\\\""); + if (strcmpi (get (h, "numbertitle"), "on")) + title_str = sprintf ("Figure %d", h); + else + title_str = ""; + endif + if (! isempty (fig.name) && ! isempty (title_str)) + title_str = sprintf ("%s: %s", title_str, fig.name); + elseif (! isempty (fig.name) && isempty (title_str)) + title_str = fig.name; + endif + if (! isempty (title_str)) + title_str = sprintf ("title \"%s\"", title_str); + endif + if (strcmp (term, "aqua")) + ## Adjust axes-label and tick-label spacing. + opts_str = sprintf ("%s font \"%s,%d\"", opts_str, + get (0, "defaultaxesfontname"), + get (0, "defaultaxesfontsize") / 1.5); + endif + else + title_str = ""; + endif + + if (! (any (strfind (opts_str, " size ") > 0) + || any (strfind (opts_str, "size ") == 1))) + ## Get figure size in pixels. Rely on listener to handle coversion. + units = get (h, "units"); + unwind_protect + set (h, "units", "pixels"); + position_in_pixels = get (h, "position"); + unwind_protect_cleanup + set (h, "units", units); + end_unwind_protect + gnuplot_pos = position_in_pixels(1:2); + gnuplot_size = position_in_pixels(3:4); + if (! (output_to_screen (term) + || any (strcmp (term, {"emf", "gif", "jpeg", "pbm", "png", ... + "pngcairo", "svg"})))) + ## Convert to inches + gnuplot_pos = gnuplot_pos / 72; + gnuplot_size = gnuplot_size / 72; + endif + if (all (gnuplot_size > 0)) + terminals_with_size = {"canvas", "emf", "epslatex", "fig", ... + "gif", "jpeg", "latex", "pbm", "pdf", ... + "pdfcairo", "postscript", "png", "pngcairo", ... + "pstex", "pslatex", "svg", "tikz"}; + if (__gnuplot_has_feature__ ("x11_figure_position")) + terminals_with_size{end+1} = "x11"; + endif + if (__gnuplot_has_feature__ ("wxt_figure_size")) + terminals_with_size{end+1} = "wxt"; + endif + switch (term) + case terminals_with_size + size_str = sprintf ("size %g,%g", gnuplot_size); + case "tikz" + size_str = sprintf ("size %gin,%gin", gnuplot_size); + case "dumb" + new_stream = 1; + if (~isempty (getenv ("COLUMNS")) && ~isempty (getenv ("LINES"))) + ## Let dumb use full text screen size (minus prompt lines). + n = sprintf ("%i", -2 - length (find (sprintf ("%s", PS1) == "\n"))); + ## n = the number of times \n appears in PS1 + size_str = ["size ", getenv("COLUMNS"), ",", getenv("LINES"), n]; + else + ## Use the gnuplot default. + size_str = ""; + endif + case {"aqua", "fig", "corel"} + size_str = sprintf ("size %g %g", gnuplot_size); + case "dxf" + size_str = ""; + otherwise + size_str = ""; + endswitch + if (strncmpi (term, "x11", 3) + && __gnuplot_has_feature__ ("x11_figure_position")) + ## X11 allows the window to be positioned as well. + units = get (0, "units"); + unwind_protect + set (0, "units", "pixels"); + screen_size = get (0, "screensize")(3:4); + unwind_protect_cleanup + set (0, "units", units); + end_unwind_protect + if (all (screen_size > 0)) + ## For X11, set the figure positon as well as the size + ## gnuplot position is UL, Octave's is LL (same for screen/window) + gnuplot_pos(2) = screen_size(2) - gnuplot_pos(2) - gnuplot_size(2); + gnuplot_pos = max (gnuplot_pos, 1); + size_str = sprintf ("%s position %d,%d", size_str, + gnuplot_pos(1), gnuplot_pos(2)); + endif + endif + else + size_str = ""; + warning ("gnuplot_set_term: size is zero"); + endif + else + ## A specified size take priority over the figure properies. + size_str = ""; + endif + else + if isempty (h) + disp ("gnuplot_set_term: figure handle is empty"); + elseif !isfigure(h) + disp ("gnuplot_set_term: not a figure handle"); + endif + title_str = ""; + size_str = ""; + endif + + ## Set the gnuplot terminal (type, enhanced, title, options & size). + term_str = sprintf ("set terminal %s", term); + if (! isempty (enh_str)) + term_str = sprintf ("%s %s", term_str, enh_str); + endif + if (! isempty (title_str)) + term_str = sprintf ("%s %s", term_str, title_str); + endif + if (isempty (strfind (term, "corel"))) + if (! isempty (size_str) && new_stream) + ## size_str comes after other options to permit specification of + ## the canvas size for terminals cdr/corel. + term_str = sprintf ("%s %s", term_str, size_str); + endif + if (nargin > 3 && ischar (opts_str)) + ## Options must go last. + term_str = sprintf ("%s %s", term_str, opts_str); + endif + else + if (nargin > 3 && ischar (opts_str)) + ## Options must go last. + term_str = sprintf ("%s %s", term_str, opts_str); + endif + if (! isempty (size_str) && new_stream) + ## size_str comes after other options to permit specification of + ## the canvas size for terminals cdr/corel. + term_str = sprintf ("%s %s", term_str, size_str); + endif + endif + + ## Work around the gnuplot feature of growing the x11 window and + ## flickering window (x11, windows, & wxt) when the mouse and + ## multiplot are set in gnuplot. + fputs (plot_stream, "unset multiplot;\n"); + flickering_terms = {"x11", "windows", "wxt", "dumb"}; + if (! any (strcmp (term, flickering_terms)) + || have_non_legend_axes (h) + || numel (findall (h, "type", "image")) > 0) + fprintf (plot_stream, "%s\n", term_str); + if (nargin == 5) + if (! isempty (file)) + fprintf (plot_stream, "set output '%s';\n", file); + endif + endif + fputs (plot_stream, "set multiplot;\n"); + elseif (any (strcmp (term, flickering_terms))) + fprintf (plot_stream, "%s\n", term_str); + if (nargin == 5) + if (! isempty (file)) + fprintf (plot_stream, "set output '%s';\n", file); + endif + endif + endif + else + ## gnuplot will pick up the GNUTERM environment variable itself + ## so no need to set the terminal type if not also setting the + ## figure title, enhanced mode, or position. + endif + +endfunction + +function term = gnuplot_default_term () + term = getenv ("GNUTERM"); + ## If not specified, guess the terminal type. + if (isempty (term)) + if (ismac ()) + term = "aqua"; + elseif (! isunix ()) + term = "windows"; + elseif (! isempty (getenv ("DISPLAY"))) + term = "x11"; + else + term = "dumb"; + endif + endif +endfunction + +function [term, opts] = gnuplot_trim_term (string) + ## Extract the terminal type and terminal options (from print.m) + string = deblank (string); + n = strfind (string, ' '); + if (isempty (n)) + term = string; + opts = ""; + else + term = string(1:(n-1)); + opts = string((n+1):end); + endif +endfunction + +function have_enhanced = gnuplot_is_enhanced_term (term) + persistent enhanced_terminals; + if (isempty (enhanced_terminals)) + ## Don't include pstex, pslatex or epslatex here as the TeX commands + ## should not be interpreted in that case. + enhanced_terminals = {"aqua", "canvas", "dumb", "emf", "gif", "jpeg", ... + "pdf", "pdfcairo", "pm", "png", "pngcairo", ... + "postscript", "svg", "windows", "wxt", "x11"}; + endif + if (nargin < 1) + ## Determine the default gnuplot terminal. + term = gnuplot_default_term (); + endif + have_enhanced = any (strncmp (enhanced_terminals, term, min (numel (term), 3))); +endfunction + +function ret = output_to_screen (term) + ret = any (strcmpi ({"aqua", "dumb", "wxt", "x11", "windows", "pm"}, term)); +endfunction + +function retval = have_non_legend_axes (h) + retval = false; + all_axes = findall (h, "type", "axes"); + if (! isempty (all_axes)) + n_all_axes = numel (all_axes); + all_axes_tags = get (all_axes, "tag"); + legend_axes = strcmp (all_axes_tags, "legend"); + if (! isempty (legend_axes)) + n_legend_axes = sum (legend_axes); + retval = (n_all_axes - n_legend_axes) > 1; + endif + endif +endfunction + + +## No test needed for internal helper function. +%!assert (1) diff --git a/octave_packages/m/plot/__plt_get_axis_arg__.m b/octave_packages/m/plot/__plt_get_axis_arg__.m new file mode 100644 index 0000000..bfe619e --- /dev/null +++ b/octave_packages/m/plot/__plt_get_axis_arg__.m @@ -0,0 +1,82 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{h}, @var{varargin}, @var{narg}] =} __plt_get_axis_arg__ (@var{caller}, @var{varargin}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function [h, varargin, narg] = __plt_get_axis_arg__ (caller, varargin) + + if (islogical (caller)) + nogca = caller; + caller = varargin{1}; + varargin(1) = []; + else + nogca = false; + endif + + ## Figure handles are integers, but object handles are non-integer, + ## therefore ignore integer scalars. + if (nargin > 1 && length (varargin) > 0 && isnumeric (varargin{1}) + && numel (varargin{1}) == 1 && ishandle (varargin{1}(1)) + && varargin{1}(1) != 0 && ! isfigure (varargin{1}(1))) + tmp = varargin{1}; + obj = get (tmp); + if ((strcmp (obj.type, "axes") && ! strcmp (obj.tag, "legend")) + || strcmp (obj.type, "hggroup")) + h = ancestor (tmp, "axes"); + varargin(1) = []; + if (isempty (varargin)) + varargin = {}; + endif + else + error ("%s: expecting first argument to be axes handle", caller); + endif + else + f = get (0, "currentfigure"); + if (isempty (f)) + h = []; + else + h = get (f, "currentaxes"); + endif + if (isempty (h)) + if (nogca) + h = NaN; + else + h = gca (); + endif + endif + if (nargin < 2) + varargin = {}; + endif + endif + + if (ishandle (h) && strcmp (get (h, "nextplot"), "new")) + h = axes (); + endif + + narg = length (varargin); + +endfunction + + +## No test needed for internal helper function. +%!assert (1) diff --git a/octave_packages/m/plot/allchild.m b/octave_packages/m/plot/allchild.m new file mode 100644 index 0000000..dd1753f --- /dev/null +++ b/octave_packages/m/plot/allchild.m @@ -0,0 +1,57 @@ +## Copyright (C) 2008-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} allchild (@var{handles}) +## Find all children, including hidden children, of a graphics object. +## +## This function is similar to @code{get (h, "children")}, but also +## returns hidden objects. If @var{handles} is a scalar, +## @var{h} will be a vector. Otherwise, @var{h} will be a cell matrix +## of the same size as @var{handles} and each cell will contain a +## vector of handles. +## @seealso{get, set, findall, findobj} +## @end deftypefn + +## Author: Bill Denney + +function h = allchild (handles) + + shh = get (0, "showhiddenhandles"); + unwind_protect + set (0, "showhiddenhandles", "on"); + h = get (handles, "children"); + unwind_protect_cleanup + set (0, "showhiddenhandles", shh); + end_unwind_protect + +endfunction + + +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert(get (allchild (hf),"type"),{"axes"; "uimenu"; "uimenu"; "uimenu"}); +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/ancestor.m b/octave_packages/m/plot/ancestor.m new file mode 100644 index 0000000..7de8720 --- /dev/null +++ b/octave_packages/m/plot/ancestor.m @@ -0,0 +1,86 @@ +## Copyright (C) 2007-2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{parent} =} ancestor (@var{h}, @var{type}) +## @deftypefnx {Function File} {@var{parent} =} ancestor (@var{h}, @var{type}, 'toplevel') +## Return the first ancestor of handle object @var{h} whose type matches +## @var{type}, where @var{type} is a character string. If @var{type} is a +## cell array of strings, return the first parent whose type matches +## any of the given type strings. +## +## If the handle object @var{h} is of type @var{type}, return @var{h}. +## +## If @code{"toplevel"} is given as a 3rd argument, return the highest +## parent in the object hierarchy that matches the condition, instead +## of the first (nearest) one. +## @seealso{get, set} +## @end deftypefn + +function p = ancestor (h, type, toplevel) + + if (nargin == 2 || nargin == 3) + p = cell (numel (h), 1); + if (ischar (type)) + type = { type }; + endif + if (iscellstr (type)) + look_first = true; + if (nargin == 3) + if (ischar (toplevel) && strcmpi (toplevel, "toplevel")) + look_first = false; + else + error ("ancestor: third argument must be \"toplevel\""); + endif + endif + h = num2cell (h); + for nh = 1:numel(h) + while (true) + if (isempty (h{nh}) || ! ishandle (h{nh})) + break; + endif + if (any (strcmpi (get (h{nh}, "type"), type))) + p{nh} = h{nh}; + if (look_first) + break; + endif + endif + h{nh} = get (h{nh}, "Parent"); + endwhile + endfor + if (nh == 1) + p = p{1}; + endif + else + error ("ancestor: second argument must be a string or cell array of strings"); + endif + else + print_usage (); + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (ancestor (l, "axes"), gca); +%! assert (ancestor (l, "figure"), hf); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/area.m b/octave_packages/m/plot/area.m new file mode 100644 index 0000000..b9fe7cb --- /dev/null +++ b/octave_packages/m/plot/area.m @@ -0,0 +1,208 @@ +## Copyright (C) 2007-2012 Michael Goffioul +## Copyright (C) 2007-2009 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} area (@var{x}, @var{y}) +## @deftypefnx {Function File} {} area (@var{x}, @var{y}, @var{lvl}) +## @deftypefnx {Function File} {} area (@dots{}, @var{prop}, @var{val}, @dots{}) +## @deftypefnx {Function File} {} area (@var{y}, @dots{}) +## @deftypefnx {Function File} {} area (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} area (@dots{}) +## Area plot of cumulative sum of the columns of @var{y}. This shows the +## contributions of a value to a sum, and is functionally similar to +## @code{plot (@var{x}, cumsum (@var{y}, 2))}, except that the area under +## the curve is shaded. +## +## If the @var{x} argument is omitted it is assumed to be given by +## @code{1 : rows (@var{y})}. A value @var{lvl} can be defined that determines +## where the base level of the shading under the curve should be defined. +## +## Additional arguments to the @code{area} function are passed to +## @code{patch}. +## +## The optional return value @var{h} is a graphics handle to the hggroup +## object representing the area patch objects. +## @seealso{plot, patch} +## @end deftypefn + +function h = area (varargin) + + [ax, varargin, nargin] = __plt_get_axis_arg__ ("area", varargin{:}); + + if (nargin > 0) + idx = 1; + x = y = []; + bv = 0; + args = {}; + ## Check for (X) or (X,Y) arguments and possible base value. + if (nargin >= idx && ismatrix (varargin{idx})) + y = varargin{idx}; + idx++; + if (nargin >= idx) + if (isscalar (varargin{idx})) + bv = varargin{idx}; + idx++; + elseif (ismatrix (varargin{idx})) + x = y; + y = varargin{idx}; + idx++; + if (nargin >= idx && isscalar (varargin{idx})) + bv = varargin{idx}; + idx++; + endif + endif + endif + else + print_usage (); + endif + ## Check for additional args. + if (nargin >= idx) + args = {varargin{idx:end}}; + endif + newplot (); + if (isvector (y)) + y = y(:); + endif + if (isempty (x)) + x = repmat ([1:size(y, 1)]', 1, size (y, 2)); + elseif (isvector (x)) + x = repmat (x(:), 1, size (y, 2)); + endif + + oldax = gca (); + unwind_protect + axes (ax); + tmp = __area__ (ax, x, y, bv, args{:}); + unwind_protect_cleanup + axes (oldax); + end_unwind_protect + + if (nargout > 0) + h = tmp; + endif + else + print_usage (); + endif + +endfunction + +function retval = __area__ (ax, x, y, bv, varargin) + + y0 = bv * ones (1, rows (y)); + y0 = zeros (1, rows (y)); + retval = []; + for i = 1: size (y, 2); + hg = hggroup (); + retval = [retval; hg]; + args = __add_datasource__ ("area", hg, {"x", "y"}, varargin{:}); + + x1 = x(:, 1).'; + y1 = y (:, i).'; + addproperty ("xdata", hg, "data", x1); + addproperty ("ydata", hg, "data", y1); + + addlistener (hg, "xdata", @update_data); + addlistener (hg, "ydata", @update_data); + + if (i == 1) + h = patch (ax, [x1(1), x1, fliplr(x1)], [bv, y1, bv*ones(1, length(y1))], + __next_line_color__ (), "parent", hg); + else + y1 = y0 + y1; + h = patch (ax, [x1(1), x1, fliplr(x1)], [y0(1), y1, fliplr(y0)], + __next_line_color__ (), "parent", hg); + endif + + y0 = y1; + + addproperty ("basevalue", hg, "data", bv); + addlistener (hg, "basevalue", @move_baseline); + + addproperty ("edgecolor", hg, "patchedgecolor", get (h, "edgecolor")); + addproperty ("linewidth", hg, "patchlinewidth", get (h, "linewidth")); + addproperty ("linestyle", hg, "patchlinestyle", get (h, "linestyle")); + addproperty ("facecolor", hg, "patchfacecolor", get (h, "facecolor")); + + addlistener (hg, "edgecolor", @update_props); + addlistener (hg, "linewidth", @update_props); + addlistener (hg, "linestyle", @update_props); + addlistener (hg, "facecolor", @update_props); + + addproperty ("areagroup", hg, "data"); + set (retval, "areagroup", retval); + + if (! isempty (args)) + set (hg, args{:}); + endif + endfor + +endfunction + +function update_props (h, d) + kids = get (h, "children"); + set (kids, "edgecolor", get (h, "edgecolor"), + "linewidth", get (h, "linewidth"), + "linestyle", get (h, "linestyle"), + "facecolor", get (h, "facecolor")); +endfunction + +function move_baseline (h, d) + persistent recursion = false; + + ## Don't allow recursion + if (! recursion) + unwind_protect + recursion = true; + hlist = get (h, "areagroup"); + b0 = get (h, "basevalue"); + + for hh = hlist(:)' + if (hh != h) + b1 = get (hh, "basevalue"); + if (b1 != b0) + set (hh, "basevalue", b0); + endif + endif + endfor + update_data (h, d); + unwind_protect_cleanup + recursion = false; + end_unwind_protect + endif +endfunction + +function update_data (h, d) + hlist = get (h, "areagroup"); + bv = get (h, "basevalue"); + for i = 1 : length (hlist) + hh = hlist(i); + x1 = get (hh, "xdata")(:); + y1 = get (hh, "ydata")(:); + + set (get (hh, "children"), "xdata", [x1(1); x1; flipud(x1)]); + if (i == 1) + set (get (hh, "children"), "ydata", [bv; y1; bv*ones(length(y1), 1)]); + else + y1 = y0 + y1; + set (get (hh, "children"), "ydata", [y0(1); y1; flipud(y0)]); + endif + + y0 = y1; + endfor +endfunction diff --git a/octave_packages/m/plot/axes.m b/octave_packages/m/plot/axes.m new file mode 100644 index 0000000..62df88f --- /dev/null +++ b/octave_packages/m/plot/axes.m @@ -0,0 +1,62 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} axes () +## @deftypefnx {Function File} {} axes (@var{property}, @var{value}, @dots{}) +## @deftypefnx {Function File} {} axes (@var{h}) +## Create an axes object and return a handle to it. +## @end deftypefn + +## Author: jwe + +function h = axes (varargin) + + if (nargin == 0 || nargin > 1) + ## Create an axes object. + idx = find (strcmpi (varargin(1:2:end), "parent"), 1, "first"); + if (! isempty (idx) && length (varargin) >= 2*idx) + cf = varargin{2*idx}; + varargin([2*idx-1, 2*idx]) = []; + else + cf = gcf (); + endif + tmp = __go_axes__ (cf, varargin{:}); + if (__is_handle_visible__ (tmp)) + set (ancestor (cf, "figure"), "currentaxes", tmp); + endif + else + ## arg is axes handle. + tmp = varargin{1}; + if (length(tmp) == 1 && ishandle (tmp) + && strcmp (get (tmp, "type"), "axes")) + if (__is_handle_visible__ (tmp)) + parent = ancestor (tmp, "figure"); + set (0, "currentfigure", parent); + set (parent, "currentaxes", tmp); + endif + else + error ("axes: expecting argument to be a scalar axes handle"); + endif + endif + + if (nargout > 0) + h = tmp; + endif + +endfunction diff --git a/octave_packages/m/plot/axis.m b/octave_packages/m/plot/axis.m new file mode 100644 index 0000000..cf7e000 --- /dev/null +++ b/octave_packages/m/plot/axis.m @@ -0,0 +1,580 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} axis () +## @deftypefnx {Function File} {} axis ([@var{x}_lo @var{x}_hi]) +## @deftypefnx {Function File} {} axis ([@var{x}_lo @var{x}_hi @var{y}_lo @var{y}_hi]) +## @deftypefnx {Function File} {} axis ([@var{x}_lo @var{x}_hi @var{y}_lo @var{y}_hi @var{z}_lo @var{z}_hi]) +## @deftypefnx {Function File} {} axis (@var{option}) +## @deftypefnx {Function File} {} axis (@dots{}, @var{option}) +## @deftypefnx {Function File} {} axis (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{limits} =} axis () +## Set axis limits for plots. +## +## The argument @var{limits} should be a 2-, 4-, or 6-element vector. The +## first and second elements specify the lower and upper limits for the +## x-axis. The third and fourth specify the limits for the y-axis, and the +## fifth and sixth specify the limits for the z-axis. +## +## Without any arguments, @code{axis} turns autoscaling on. +## +## With one output argument, @code{x = axis} returns the current axes. +## +## The vector argument specifying limits is optional, and additional +## string arguments may be used to specify various axis properties. For +## example, +## +## @example +## axis ([1, 2, 3, 4], "square"); +## @end example +## +## @noindent +## forces a square aspect ratio, and +## +## @example +## axis ("tic", "labely"); +## @end example +## +## @noindent +## turns tic marks on for all axes and tic mark labels on for the y-axis +## only. +## +## @noindent +## The following options control the aspect ratio of the axes. +## +## @table @asis +## @item "square" +## Force a square aspect ratio. +## +## @item "equal" +## Force x distance to equal y-distance. +## +## @item "normal" +## Restore the balance. +## @end table +## +## @noindent +## The following options control the way axis limits are interpreted. +## +## @table @asis +## @item "auto" +## Set the specified axes to have nice limits around the data +## or all if no axes are specified. +## +## @item "manual" +## Fix the current axes limits. +## +## @item "tight" +## Fix axes to the limits of the data. +## @end table +## +## @noindent +## The option @code{"image"} is equivalent to @code{"tight"} and +## @code{"equal"}. +## +## @noindent +## The following options affect the appearance of tic marks. +## +## @table @asis +## @item "on" +## Turn tic marks and labels on for all axes. +## +## @item "off" +## Turn tic marks off for all axes. +## +## @item "tic[xyz]" +## Turn tic marks on for all axes, or turn them on for the +## specified axes and off for the remainder. +## +## @item "label[xyz]" +## Turn tic labels on for all axes, or turn them on for the +## specified axes and off for the remainder. +## +## @item "nolabel" +## Turn tic labels off for all axes. +## @end table +## Note, if there are no tic marks for an axis, there can be no labels. +## +## @noindent +## The following options affect the direction of increasing values on +## the axes. +## +## @table @asis +## @item "ij" +## Reverse y-axis, so lower values are nearer the top. +## +## @item "xy" +## Restore y-axis, so higher values are nearer the top. +## @end table +## +## If an axes handle is passed as the first argument, then operate on +## this axes rather than the current axes. +## @end deftypefn + +## Author: jwe + +function varargout = axis (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("axis", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + varargout = cell (max (nargin == 0, nargout), 1); + if (isempty (varargout)) + __axis__ (h, varargin{:}); + else + [varargout{:}] = __axis__ (h, varargin{:}); + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +function curr_axis = __axis__ (ca, ax, varargin) + + if (nargin == 1) + if (nargout == 0) + set (ca, "xlimmode", "auto", "ylimmode", "auto", "zlimmode", "auto"); + else + xlim = get (ca, "xlim"); + ylim = get (ca, "ylim"); + view = get (ca, "view"); + if (view(2) == 90) + curr_axis = [xlim, ylim]; + else + zlim = get (ca, "zlim"); + curr_axis = [xlim, ylim, zlim]; + endif + endif + + elseif (ischar (ax)) + len = length (ax); + + ## 'matrix mode' to reverse the y-axis + if (strcmpi (ax, "ij")) + set (ca, "ydir", "reverse"); + elseif (strcmpi (ax, "xy")) + set (ca, "ydir", "normal"); + + ## aspect ratio + elseif (strcmpi (ax, "image")) + __axis__ (ca, "equal"); + __do_tight_option__ (ca); + elseif (strcmpi (ax, "square")) + set (ca, "plotboxaspectratio", [1, 1, 1]); + elseif (strcmp (ax, "equal")) + if (strcmp (get (get (ca, "parent"), "__graphics_toolkit__"), "gnuplot")) + ## FIXME - gnuplot applies the aspect ratio activepostionproperty. + set (ca, "activepositionproperty", "position"); + ## The following line is a trick used to trigger the recalculation of + ## aspect related magnitudes even if the aspect ratio is the same + ## (useful with the x11 gnuplot terminal after a window resize) + set (ca, "dataaspectratiomode", "auto"); + endif + set (ca, "dataaspectratio", [1, 1, 1]); + elseif (strcmpi (ax, "normal")) + set (ca, "plotboxaspectratio", [1, 1, 1]); + set (ca, "plotboxaspectratiomode", "auto"); + + ## axis limits + elseif (len >= 4 && strcmpi (ax(1:4), "auto")) + if (len > 4) + if (any (ax == "x")) + set (ca, "xlimmode", "auto"); + endif + if (any (ax == "y")) + set (ca, "ylimmode", "auto"); + endif + if (any (ax == "z")) + set (ca, "zlimmode", "auto"); + endif + else + set (ca, "xlimmode", "auto", "ylimmode", "auto", "zlimmode", "auto"); + endif + elseif (strcmpi (ax, "manual")) + ## fixes the axis limits, like axis(axis) should; + set (ca, "xlimmode", "manual", "ylimmode", "manual", "zlimmode", "manual"); + elseif (strcmpi (ax, "tight")) + ## sets the axis limits to the min and max of all data. + __do_tight_option__ (ca); + ## tic marks + elseif (strcmpi (ax, "on") || strcmpi (ax, "tic")) + set (ca, "xtickmode", "auto", "ytickmode", "auto", "ztickmode", "auto"); + if (strcmpi (ax, "on")) + set (ca, "xticklabelmode", "auto", "yticklabelmode", "auto", + "zticklabelmode", "auto"); + endif + set (ca, "visible", "on"); + elseif (strcmpi (ax, "off")) + set (ca, "xtick", [], "ytick", [], "ztick", []); + set (ca, "visible", "off"); + elseif (len > 3 && strcmpi (ax(1:3), "tic")) + if (any (ax == "x")) + set (ca, "xtickmode", "auto"); + else + set (ca, "xtick", []); + endif + if (any (ax == "y")) + set (ca, "ytickmode", "auto"); + else + set (ca, "ytick", []); + endif + if (any (ax == "z")) + set (ca, "ztickmode", "auto"); + else + set (ca, "ztick", []); + endif + elseif (strcmpi (ax, "label")) + set (ca, "xticklabelmode", "auto", "yticklabelmode", "auto", + "zticklabelmode", "auto"); + elseif (strcmpi (ax, "nolabel")) + set (ca, "xticklabel", "", "yticklabel", "", "zticklabel", ""); + elseif (len > 5 && strcmpi (ax(1:5), "label")) + if (any (ax == "x")) + set (ca, "xticklabelmode", "auto"); + else + set (ca, "xticklabel", ""); + endif + if (any (ax == "y")) + set (ca, "yticklabelmode", "auto"); + else + set (ca, "yticklabel", ""); + endif + if (any (ax == "z")) + set (ca, "zticklabelmode", "auto"); + else + set (ca, "zticklabel", ""); + endif + + else + warning ("unknown axis option '%s'", ax); + endif + + elseif (isvector (ax)) + + len = length (ax); + + if (len != 2 && len != 4 && len != 6) + error ("axis: expecting vector with 2, 4, or 6 elements"); + endif + + for i = 1:2:len + if (ax(i) >= ax(i+1)) + error ("axis: limits(%d) must be less than limits(%d)", i, i+1); + endif + endfor + + if (len > 1) + set (ca, "xlim", [ax(1), ax(2)]); + endif + + if (len > 3) + set (ca, "ylim", [ax(3), ax(4)]); + endif + + if (len > 5) + set (ca, "zlim", [ax(5), ax(6)]); + endif + + else + error ("axis: expecting no args, or a vector with 2, 4, or 6 elements"); + endif + + if (! isempty (varargin)) + __axis__ (ca, varargin{:}); + endif + +endfunction + +function lims = __get_tight_lims__ (ca, ax) + + ## Get the limits for axis ("tight"). + ## AX should be one of "x", "y", or "z". + kids = findobj (ca, "-property", strcat (ax, "data")); + ## The data properties for hggroups mirror their children. + ## Exclude the redundant hgroup values. + hg_kids = findobj (kids, "type", "hggroup"); + kids = setdiff (kids, hg_kids); + if (isempty (kids)) + ## Return the current limits. + lims = get (ca, strcat (ax, "lim")); + else + data = get (kids, strcat (ax, "data")); + scale = get (ca, strcat (ax, "scale")); + if (! iscell (data)) + data = {data}; + end + if (strcmp (scale, "log")) + tmp = data; + data = cellfun (@(x) x(x>0), tmp, "uniformoutput", false); + n = cellfun (@isempty, data); + data(n) = cellfun (@(x) x(x<0), tmp(n), "uniformoutput", false); + endif + data = cellfun (@(x) x(isfinite(x)), data, "uniformoutput", false); + data = data(! cellfun ("isempty", data)); + if (! isempty (data)) + lims_min = min (cellfun (@(x) min (x(:)), data(:))); + lims_max = max (cellfun (@(x) max (x(:)), data(:))); + lims = [lims_min, lims_max]; + else + lims = [0, 1]; + endif + endif + +endfunction + +function __do_tight_option__ (ca) + + set (ca, + "xlim", __get_tight_lims__ (ca, "x"), + "ylim", __get_tight_lims__ (ca, "y")); + if __calc_dimensions__ (ca) > 2 + set (ca, "zlim", __get_tight_lims__ (ca, "z")); + endif + +endfunction + +%!demo +%! clf +%! t=0:0.01:2*pi; x=sin(t); +%! +%! subplot(221); +%! plot(t, x); +%! title("normal plot"); +%! +%! subplot(222); +%! plot(t, x); +%! title("square plot"); +%! axis("square"); +%! +%! subplot(223); +%! plot(t, x); +%! title("equal plot"); +%! axis("equal"); +%! +%! subplot(224); +%! plot(t, x); +%! title("normal plot again"); +%! axis("normal"); + +%!demo +%! clf +%! t=0:0.01:2*pi; x=sin(t); +%! +%! subplot(121); +%! plot(t, x); +%! title("ij plot"); +%! axis("ij"); +%! +%! subplot(122); +%! plot(t, x); +%! title("xy plot"); +%! axis("xy"); + +%!demo +%! clf +%! t=0:0.01:2*pi; x=sin(t); +%! +%! subplot(331); +%! plot(t, x); +%! title("x tics and labels"); +%! axis("ticx"); +%! +%! subplot(332); +%! plot(t, x); +%! title("y tics and labels"); +%! axis("ticy"); +%! +%! subplot(333); +%! plot(t, x); +%! title("axis off"); +%! axis("off"); +%! +%! subplot(334); +%! plot(t, x); +%! title("x and y tics, x labels"); +%! axis("labelx","tic"); +%! +%! subplot(335); +%! plot(t, x); +%! title("x and y tics, y labels"); +%! axis("labely","tic"); +%! +%! subplot(336); +%! plot(t, x); +%! title("all tics but no labels"); +%! axis("nolabel","tic"); +%! +%! subplot(337); +%! plot(t, x); +%! title("x tics, no labels"); +%! axis("nolabel","ticx"); +%! +%! subplot(338); +%! plot(t, x); +%! title("y tics, no labels"); +%! axis("nolabel","ticy"); +%! +%! subplot(339); +%! plot(t, x); +%! title("all tics and labels"); +%! axis("on"); + +%!demo +%! clf +%! t=0:0.01:2*pi; x=sin(t); +%! +%! subplot(321); +%! plot(t, x); +%! title("axes at [0 3 0 1]") +%! axis([0,3,0,1]); +%! +%! subplot(322); +%! plot(t, x); +%! title("auto"); +%! axis("auto"); +%! +%! subplot(323); +%! plot(t, x, ";sine [0:2pi];"); hold on; +%! plot(-3:3,-3:3, ";line (-3,-3)->(3,3);"); hold off; +%! title("manual"); +%! axis("manual"); +%! +%! subplot(324); +%! plot(t, x, ";sine [0:2pi];"); +%! title("axes at [0 3 0 1], then autox"); +%! axis([0,3,0,1]); axis("autox"); +%! +%! subplot(325); +%! plot(t, x, ";sine [0:2p];"); +%! axis([3,6,0,1]); axis("autoy"); +%! title("axes at [3 6 0 1], then autoy"); +%! +%! subplot(326); +%! plot(t, sin(t), t, -2*sin(t/2)) +%! axis("tight"); +%! title("tight"); + +%!demo +%! clf +%! axis image +%! x=0:0.1:10; +%! plot(x,sin(x)) +%! axis image +%! title("image") + +%!demo +%! clf +%! [x,y,z] = peaks(50); +%! x1 = max(x(:)); +%! pcolor(x-x1,y-x1/2,z) +%! hold on +%! [x,y,z] = sombrero; +%! s = x1/max(x(:)); +%! pcolor(s*x+x1,s*y+x1/2,5*z) +%! axis tight + +%!demo +%! clf +%! x = -10:10; +%! plot (x, x, x, -x) +%! set (gca, "yscale", "log") +%! legend ({"x >= 1", "x <= 1"}, "location", "north") +%! title ("ylim = [1, 10]") + +%!demo +%! clf +%! loglog (1:20, "-s") +%! axis tight + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "zero") +%! box off + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "left") +%! box off + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "zero") +%! set (gca, "yaxislocation", "right") +%! box off + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "bottom") +%! set (gca, "yaxislocation", "zero") +%! box off + +%!demo +%! clf +%! x = -10:0.1:10; +%! y = sin(x)./(1+abs(x)) + x*0.1 - .4; +%! plot (x, y) +%! title ("no plot box") +%! set (gca, "xaxislocation", "top") +%! set (gca, "yaxislocation", "zero") +%! box off + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot (11:20, [21:24, NaN, -Inf, 27:30]); +%! hold all; +%! plot (11:20, 25.5 + rand (10)); +%! axis tight; +%! assert (axis (), [11 20 21 30]); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! loglog (a, -a) +%! axis tight; +%! assert (axis (), [1e-5, 10, -10, -1e-5]) +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/bar.m b/octave_packages/m/plot/bar.m new file mode 100644 index 0000000..4137ac9 --- /dev/null +++ b/octave_packages/m/plot/bar.m @@ -0,0 +1,99 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} bar (@var{x}, @var{y}) +## @deftypefnx {Function File} {} bar (@var{y}) +## @deftypefnx {Function File} {} bar (@var{x}, @var{y}, @var{w}) +## @deftypefnx {Function File} {} bar (@var{x}, @var{y}, @var{w}, @var{style}) +## @deftypefnx {Function File} {@var{h} =} bar (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {} bar (@var{h}, @dots{}) +## Produce a bar graph from two vectors of x-y data. +## +## If only one argument is given, @var{y}, it is taken as a vector of y-values +## and the x coordinates are taken to be the indices of the elements. +## +## The default width of 0.8 for the bars can be changed using @var{w}. +## +## If @var{y} is a matrix, then each column of @var{y} is taken to be a +## separate bar graph plotted on the same graph. By default the columns +## are plotted side-by-side. This behavior can be changed by the @var{style} +## argument, which can take the values @code{"grouped"} (the default), +## or @code{"stacked"}. +## +## The optional return value @var{h} is a handle to the created "bar series" +## object with one handle per column of the variable @var{y}. This +## series allows common elements of the group of bar series objects to +## be changed in a single bar series and the same properties are changed +## in the other "bar series". For example, +## +## @example +## @group +## h = bar (rand (5, 10)); +## set (h(1), "basevalue", 0.5); +## @end group +## @end example +## +## @noindent +## changes the position on the base of all of the bar series. +## +## The optional input handle @var{h} allows an axis handle to be passed. +## +## The bar graph's appearance may be modified by specifying property/value +## pairs. The following example modifies the face and edge colors. +## +## @example +## bar (randn (1, 100), "facecolor", "r", "edgecolor", "b") +## @end example +## +## @noindent +## The color of the bars is taken from the figure's colormap, such that +## +## @example +## @group +## bar (rand (10, 3)); +## colormap (summer (64)); +## @end group +## @end example +## +## @noindent +## will change the colors used for the bars. The color of bars can also be set +## manually using the "facecolor" property as shown below. +## +## @example +## @group +## h = bar (rand (10, 3)); +## set (h(1), "facecolor", "r") +## set (h(2), "facecolor", "g") +## set (h(3), "facecolor", "b") +## @end group +## @end example +## +## @seealso{barh, plot} +## @end deftypefn + +## Author: jwe + +function varargout = bar (varargin) + varargout = cell (nargout, 1); + [varargout{:}] = __bar__ (true, "bar", varargin{:}); +endfunction + + +%% FIXME: Need demo or test for function + diff --git a/octave_packages/m/plot/barh.m b/octave_packages/m/plot/barh.m new file mode 100644 index 0000000..f7f4ee9 --- /dev/null +++ b/octave_packages/m/plot/barh.m @@ -0,0 +1,58 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} barh (@var{x}, @var{y}) +## @deftypefnx {Function File} {} barh (@var{y}) +## @deftypefnx {Function File} {} barh (@var{x}, @var{y}, @var{w}) +## @deftypefnx {Function File} {} barh (@var{x}, @var{y}, @var{w}, @var{style}) +## @deftypefnx {Function File} {@var{h} =} barh (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {} barh (@var{h}, @dots{}) +## Produce a horizontal bar graph from two vectors of x-y data. +## +## If only one argument is given, it is taken as a vector of y-values +## and the x coordinates are taken to be the indices of the elements. +## +## The default width of 0.8 for the bars can be changed using @var{w}. +## +## If @var{y} is a matrix, then each column of @var{y} is taken to be a +## separate bar graph plotted on the same graph. By default the columns +## are plotted side-by-side. This behavior can be changed by the @var{style} +## argument, which can take the values @code{"grouped"} (the default), +## or @code{"stacked"}. +## +## The optional input handle @var{h} allows an axis handle to be passed. +## Properties of the patch graphics object can be changed using +## @var{prop}, @var{val} pairs. +## +## The optional return value @var{h} is a graphics handle to the created +## bar series object. See @code{bar} for a description of the use of the +## bar series. +## @seealso{bar, plot} +## @end deftypefn + +## Author: jwe + +function varargout = barh (varargin) + varargout = cell (nargout, 1); + [varargout{:}] = __bar__ (false, "barh", varargin{:}); +endfunction + + +%% FIXME: Need demo or test for function + diff --git a/octave_packages/m/plot/box.m b/octave_packages/m/plot/box.m new file mode 100644 index 0000000..9e94749 --- /dev/null +++ b/octave_packages/m/plot/box.m @@ -0,0 +1,61 @@ +## Copyright (C) 2006-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} box (@var{arg}) +## @deftypefnx {Function File} {} box (@var{h}, @dots{}) +## Control the display of a border around the plot. +## The argument may be either @code{"on"} or @code{"off"}. If it is +## omitted, the current box state is toggled. +## @seealso{grid} +## @end deftypefn + +## Author: jwe + +function box (varargin) + + h = gca (); + + box_state = get (h, "box"); + + nargs = numel (varargin); + + if (nargs == 0) + if (strcmpi (box_state, "on")) + box_state = "off"; + else + box_state = "on"; + endif + elseif (nargs == 1) + state = varargin{1}; + if (ischar (state)) + if (strcmpi (state, "off")) + box_state = "off"; + elseif (strcmpi (state, "on")) + box_state = "on"; + else + print_usage (); + endif + endif + else + print_usage (); + endif + + set (h, "box", box_state); + +endfunction diff --git a/octave_packages/m/plot/caxis.m b/octave_packages/m/plot/caxis.m new file mode 100644 index 0000000..26a7b4b --- /dev/null +++ b/octave_packages/m/plot/caxis.m @@ -0,0 +1,88 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} caxis (@var{limits}) +## @deftypefnx {Function File} {} caxis (@var{h}, @dots{}) +## Set color axis limits for plots. +## +## The argument @var{limits} should be a 2-element vector specifying the +## lower and upper limits to assign to the first and last value in the +## colormap. Values outside this range are clamped to the first and last +## colormap entries. +## +## If @var{limits} is 'auto', then automatic colormap scaling is applied, +## whereas if @var{limits} is 'manual' the colormap scaling is set to manual. +## +## Called without any arguments to current color axis limits are returned. +## +## If an axes handle is passed as the first argument, then operate on +## this axes rather than the current axes. +## @end deftypefn + +function varargout = caxis (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("caxis", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + varargout = cell (max (nargin == 0, nargout), 1); + if (isempty (varargout)) + __caxis__ (h, varargin{:}); + else + [varargout{:}] = __caxis__ (h, varargin{:}); + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +function [cmin, cmax] = __caxis__ (ca, ax, varargin) + + if (nargin == 1) + cmin = get (ca, "clim"); + if (nargout > 1) + cmax = cmin(2); + cmin = cmin(1); + endif + elseif (ischar (ax)) + if (strcmpi (ax, "auto")) + set (ca, "climmode", "auto"); + elseif (strcmpi (ax, "manual")) + set (ca, "climmode", "manual"); + endif + elseif (isvector (ax)) + len = length (ax); + + if (len != 2) + error ("caxis: expecting vector with 2 elements"); + endif + + set (ca, "clim", [ax(1), ax(2)]); + else + error ("caxis: expecting no args, a string or a 2 element vector"); + endif + + if (nargin > 2) + __caxis__ (ca, varargin{:})'; + endif + +endfunction + diff --git a/octave_packages/m/plot/cla.m b/octave_packages/m/plot/cla.m new file mode 100644 index 0000000..31d756d --- /dev/null +++ b/octave_packages/m/plot/cla.m @@ -0,0 +1,102 @@ +## Copyright (C) 2008-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cla () +## @deftypefnx {Function File} {} cla ("reset") +## @deftypefnx {Function File} {} cla (@var{hax}) +## @deftypefnx {Function File} {} cla (@var{hax}, "reset") +## Delete the children of the current axes with visible handles. +## If @var{hax} is specified and is an axes object handle, operate on it +## instead of the current axes. If the optional argument @code{"reset"} +## is specified, also delete the children with hidden handles. +## @seealso{clf} +## @end deftypefn + +## Author: Ben Abbott +## Created: 2008-10-03 + +function cla (varargin) + + if (nargin > 2) + print_usage (); + elseif (nargin > 1) + if (ishandle (varargin{1}) + && strcmp (get (varargin{1}, "type"), "axes") + && ischar (varargin{2}) && strcmpi (varargin{2}, "reset")) + oldhax = gca; + hax = varargin{1}; + do_reset = true; + else + print_usage (); + endif + elseif (nargin == 1) + if (ishandle (varargin{1}) + && strcmp (get (varargin{1}, "type"), "axes")) + oldhax = gca; + hax = varargin{1}; + do_reset = false; + elseif (ischar (varargin{1}) && strcmpi (varargin{1}, "reset")) + hax = gca; + oldhax = hax; + do_reset = true; + else + print_usage (); + endif + else + hax = gca; + oldhax = hax; + do_reset = false; + endif + + hc = get (hax, "children"); + + if (! do_reset && ! isempty (hc)) + hc = findobj (hc, "flat", "visible", "on"); + hc = setdiff (hc, hax); + endif + + if (! isempty (hc)) + ## Delete the children of the axis. + delete (hc); + endif + + ## FIXME: The defaults should be "reset()" below, but so far there is + ## no method to determine the defaults, much less return an object's + ## properties to their default values. Instead make a close + ## approximation. + + axes (hax); + axis ("auto"); + + ## Set the current axis back to where it was upon entry. + axes (oldhax); + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot (1:10) +%! cla () +%! kids = get (gca, "children"); +%! cla () +%! unwind_protect_cleanup +%! close (hf) +%! end_unwind_protect +%! assert (numel (kids), 0) diff --git a/octave_packages/m/plot/clabel.m b/octave_packages/m/plot/clabel.m new file mode 100644 index 0000000..bfbce3b --- /dev/null +++ b/octave_packages/m/plot/clabel.m @@ -0,0 +1,142 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} clabel (@var{c}, @var{h}) +## @deftypefnx {Function File} {} clabel (@var{c}, @var{h}, @var{v}) +## @deftypefnx {Function File} {} clabel (@var{c}, @var{h}, "manual") +## @deftypefnx {Function File} {} clabel (@var{c}) +## @deftypefnx {Function File} {} clabel (@var{c}, @var{h}) +## @deftypefnx {Function File} {} clabel (@dots{}, @var{prop}, @var{val}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} clabel (@dots{}) +## Add labels to the contours of a contour plot. The contour plot is specified +## by the contour matrix @var{c} and optionally the contourgroup object @var{h} +## that are returned by @code{contour}, @code{contourf} and @code{contour3}. +## The contour labels are rotated and placed in the contour itself. +## +## By default, all contours are labeled. However, the contours to label can be +## specified by the vector @var{v}. If the "manual" argument is given then +## the contours to label can be selected with the mouse. +## +## Additional property/value pairs that are valid properties of text objects +## can be given and are passed to the underlying text objects. Additionally, +## the property "LabelSpacing" is available allowing the spacing between labels +## on a contour (in points) to be specified. The default is 144 points, or 2 +## inches. +## +## The optional return value @var{h} is a vector of graphics handles to +## the text objects representing each label. +## The "userdata" property of the text objects contains the numerical value of +## the contour label. +## +## An example of the use of @code{clabel} is +## +## @example +## @group +## [c, h] = contour (peaks (), -4 : 6); +## clabel (c, h, -4:2:6, "fontsize", 12); +## @end group +## @end example +## +## @seealso{contour, contourf, contour3, meshc, surfc, text} +## @end deftypefn + +function retval = clabel (c, varargin) + label_spacing = 2 * 72; + have_hg = false; + have_labelspacing = false; + + if (nargin < 1) + print_usage (); + elseif (nargin == 1) + hparent = gca (); + else + arg = varargin{1}; + if (isscalar (arg) && ishandle(arg) + && strcmp (get (arg, "type"), "hggroup")) + obj = get (arg); + if (! isfield (obj, "contourmatrix")) + error ("clabel: expecting the handle to be a contour group"); + endif + hg = arg; + have_hg = true; + varargin(1) = []; + else + hparent = gca (); + endif + endif + + if (length(varargin) > 0 && isnumeric (varargin{1})) + v = varargin{1}(:); + varargin(1) = []; + else + v = []; + endif + + for i = 1 : length (varargin) - 1 + arg = varargin{i}; + if (strcmpi (arg, "labelspacing")) + label_spacing = varargin{i+1}; + have_labelspacing = true; + varargin(i:i+1) = []; + break; + endif + endfor + + for i = 1 : length (varargin) + arg = varargin{i}; + if (strcmpi (arg, "manual")) + error ("clabel: manual contouring mode not supported"); + endif + endfor + + if (have_hg) + if (! isempty (v)) + if (have_labelspacing) + set (hg, "textlistmode", "manual", "textlist", v, + "labelspacing", label_spacing, "showtext", "on"); + else + set (hg, "textlistmode", "manual", "textlist", v, "showtext", "on"); + endif + else + if (have_labelspacing) + set (hg,"showtext", "on", "labelspacing", label_spacing); + else + set (hg,"showtext", "on"); + endif + endif + retval = findobj (hg, "type", "text"); + if (! isempty (varargin)) + set (retval, varargin {:}); + endif + else + retval = __clabel__ (c, v, hparent, label_spacing, [], varargin{:}); + endif +endfunction + + +%!demo +%! clf +%! [c, h] = contour (peaks(), -4:6); +%! clabel (c, h, -4:2:6, "fontsize", 12); + +%!demo +%! clf +%! [c, h] = contourf (peaks(), -7:6); +%! clabel (c, h, -6:2:6, "fontsize", 12); + diff --git a/octave_packages/m/plot/clf.m b/octave_packages/m/plot/clf.m new file mode 100644 index 0000000..5d5f778 --- /dev/null +++ b/octave_packages/m/plot/clf.m @@ -0,0 +1,105 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} clf () +## @deftypefnx {Function File} {} clf ("reset") +## @deftypefnx {Function File} {} clf (@var{hfig}) +## @deftypefnx {Function File} {} clf (@var{hfig}, "reset") +## @deftypefnx {Function File} {@var{h} =} clf (@dots{}) +## Clear the current figure window. @code{clf} operates by deleting child +## graphics objects with visible handles (@code{handlevisibility} = on). +## If @var{hfig} is specified operate on it instead of the current figure. +## If the optional argument @code{"reset"} is specified, all objects including +## those with hidden handles are deleted. +## +## The optional return value @var{h} is the graphics handle of the figure +## window that was cleared. +## @seealso{cla, close, delete} +## @end deftypefn + +## Author: jwe + +function retval = clf (varargin) + + if (nargin > 2) + print_usage (); + elseif (nargin > 1) + if (isfigure (varargin{1}) && ischar (varargin{2}) + && strcmpi (varargin{2}, "reset")) + oldfig = gcf; + hfig = varargin{1}; + do_reset = true; + else + print_usage (); + endif + elseif (nargin == 1) + if (isfigure (varargin{1})) + oldfig = gcf; + hfig = varargin{1}; + do_reset = false; + elseif (ischar (varargin{1}) && strcmpi (varargin{1}, "reset")) + hfig = gcf; + oldfig = hfig; + do_reset = true; + else + print_usage (); + endif + else + hfig = gcf; + oldfig = hfig; + do_reset = false; + endif + + if (do_reset) + ## Select all the children, including the one with hidden handles. + hc = allchild (hfig); + reset (hfig); + else + ## Select only the chilren with visible handles. + hc = get (hfig, "children"); + endif + + ## Delete the children. + delete (hc); + + if (nargout > 0) + retval = hfig; + endif + +endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (!isempty (get (gcf, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! clf; +%! assert (isempty (get (gcf, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/close.m b/octave_packages/m/plot/close.m new file mode 100644 index 0000000..c77c6a1 --- /dev/null +++ b/octave_packages/m/plot/close.m @@ -0,0 +1,93 @@ +## Copyright (C) 2002-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} close +## @deftypefnx {Command} {} close (@var{n}) +## @deftypefnx {Command} {} close all +## @deftypefnx {Command} {} close all hidden +## Close figure window(s) by calling the function specified by the +## @code{"closerequestfcn"} property for each figure. By default, the +## function @code{closereq} is used. +## @seealso{closereq} +## @end deftypefn + +## Author: jwe +## 2010-05-02 PBig allow empty argument + +function retval = close (arg1, arg2) + + figs = []; + + if (nargin == 0) + ## Close current figure. Don't use gcf because that will open a new + ## plot window if one doesn't exist. + figs = get (0, "currentfigure"); + if (! isempty (figs) && figs == 0) + figs = []; + endif + elseif (nargin == 1) + if (ischar (arg1) && strcmpi (arg1, "all")) + close_all_figures (false); + elseif (isfigure (arg1)) + figs = arg1; + elseif (isempty(arg1)) + figs = []; + else + error ("close: expecting argument to be \"all\" or a figure handle"); + endif + elseif (nargin == 2 + && ischar (arg1) && strcmpi (arg1, "all") + && ischar (arg2) && strcmpi (arg2, "hidden")) + close_all_figures (true); + else + print_usage (); + endif + + for h = figs + __go_execute_callback__ (h, "closerequestfcn"); + endfor + + if (nargout > 0) + retval = 1; + endif + +endfunction + +function close_all_figures (close_hidden_figs) + + while (! isempty (fig = get (0, "currentfigure"))) + ## handlevisibility = get (fig, "handlevisibility") + ## if (close_hidden_figs || ! strcmpi (handlevisibility, "off")) + close (fig); + ## endif + endwhile + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! close (hf); +%! objs = findobj ("type", "figure"); +%! assert (isempty (intersect (objs, hf))); +%! unwind_protect_cleanup +%! if (isfigure (hf)) +%! close (hf); +%! endif +%! end_unwind_protect diff --git a/octave_packages/m/plot/closereq.m b/octave_packages/m/plot/closereq.m new file mode 100644 index 0000000..2aebe88 --- /dev/null +++ b/octave_packages/m/plot/closereq.m @@ -0,0 +1,43 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} closereq () +## Close the current figure and delete all graphics objects associated +## with it. +## @seealso{close, delete} +## @end deftypefn + +## Author: jwe + +function closereq () + + if (nargin == 0) + cf = gcbf (); + if (isempty (cf)) + warning ("closereq: calling closereq from octave prompt is not supported, use `close' instead"); + cf = get (0, "currentfigure"); + endif + if (! isempty (cf) && isfigure (cf)) + delete (cf); + endif + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/plot/colorbar.m b/octave_packages/m/plot/colorbar.m new file mode 100644 index 0000000..0825abb --- /dev/null +++ b/octave_packages/m/plot/colorbar.m @@ -0,0 +1,613 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} colorbar (@var{s}) +## @deftypefnx {Function File} {} colorbar ("peer", @var{h}, @dots{}) +## Add a colorbar to the current axes. Valid values for @var{s} are +## +## @table @asis +## @item "EastOutside" +## Place the colorbar outside the plot to the right. This is the default. +## +## @item "East" +## Place the colorbar inside the plot to the right. +## +## @item "WestOutside" +## Place the colorbar outside the plot to the left. +## +## @item "West" +## Place the colorbar inside the plot to the left. +## +## @item "NorthOutside" +## Place the colorbar above the plot. +## +## @item "North" +## Place the colorbar at the top of the plot. +## +## @item "SouthOutside" +## Place the colorbar under the plot. +## +## @item "South" +## Place the colorbar at the bottom of the plot. +## +## @item "Off", "None" +## Remove any existing colorbar from the plot. +## @end table +## +## If the argument "peer" is given, then the following argument is treated +## as the axes handle on which to add the colorbar. +## @end deftypefn + +function h = colorbar (varargin) + ax = []; + loc = "eastoutside"; + args = {}; + deleting = false; + + i = 1; + while (i <= nargin) + arg = varargin {i++}; + if (ischar(arg)) + if (strcmpi (arg, "peer")) + if (i > nargin) + error ("colorbar: missing axes handle after \"peer\""); + else + ax = varargin{i++}; + if (!isscalar (ax) || ! ishandle (ax) + || ! strcmp (get (ax, "type"), "axes")) + error ("colorbar: expecting an axes handle following \"peer\""); + endif + endif + elseif (strcmpi (arg, "north") || strcmpi (arg, "south") + || strcmpi (arg, "east") || strcmpi (arg, "west") + || strcmpi (arg, "northoutside") || strcmpi (arg, "southoutside") + || strcmpi (arg, "eastoutside") || strcmpi (arg, "westoutside")) + loc = tolower (arg); + elseif (strcmpi (arg, "location") && i <= nargin) + loc = tolower (varargin{i++}); + elseif (strcmpi (arg, "off") || strcmpi (arg, "none")) + deleting = true; + else + args{end+1} = arg; + endif + else + args{end+1} = arg; + endif + endwhile + + if (isempty (ax)) + ax = gca (); + endif + + showhiddenhandles = get (0, "showhiddenhandles"); + unwind_protect + set (0, "showhiddenhandles", "on"); + cax = findobj (get (ax, "parent"), "tag", "colorbar", "type", "axes", "axes", ax); + if (! isempty (cax)) + delete (cax); + endif + unwind_protect_cleanup + set (0, "showhiddenhandles", showhiddenhandles); + end_unwind_protect + + if (! deleting) + ## FIXME - Matlab does not require the "position" property to be active. + ## Is there a way to determine the plotbox position for the + ## gnuplot graphics toolkit with the outerposition is active? + set (ax, "activepositionproperty", "position"); + obj = get (ax); + obj.__my_handle__ = ax; + position = obj.position; + clen = rows (get (get (ax, "parent"), "colormap")); + cext = get (ax, "clim"); + cdiff = (cext(2) - cext(1)) / clen / 2; + cmin = cext(1) + cdiff; + cmax = cext(2) - cdiff; + + [pos, cpos, vertical, mirror] = ... + __position_colorbox__ (loc, obj, ancestor (ax, "figure")); + set (ax, "position", pos); + + cax = __go_axes__ (get (ax, "parent"), "tag", "colorbar", + "handlevisibility", "on", + "activepositionproperty", "position", + "position", cpos); + addproperty ("location", cax, "radio", + "eastoutside|east|westoutside|west|northoutside|north|southoutside|south", + loc); + addproperty ("axes", cax, "handle", ax); + + if (vertical) + hi = image (cax, [0,1], [cmin, cmax], [1 : clen]'); + if (mirror) + set (cax, "xtick", [], "xdir", "normal", "ydir", "normal", + "ylim", cext, "ylimmode", "manual", + "yaxislocation", "right", args{:}); + else + set (cax, "xtick", [], "xdir", "normal", "ydir", "normal", + "ylim", cext, "ylimmode", "manual", + "yaxislocation", "left", args{:}); + endif + else + hi = image (cax, [cmin, cmax], [0,1], [1 : clen]); + if (mirror) + set (cax, "ytick", [], "xdir", "normal", "ydir", "normal", + "xlim", cext, "xlimmode", "manual", + "xaxislocation", "top", args{:}); + else + set (cax, "ytick", [], "xdir", "normal", "ydir", "normal", + "xlim", cext, "xlimmode", "manual", + "xaxislocation", "bottom", args{:}); + endif + endif + + ctext = text (0, 0, "", "tag", "colorbar","visible", "off", + "handlevisibility", "off", "xliminclude", "off", + "yliminclude", "off", "zliminclude", "off", + "deletefcn", {@deletecolorbar, cax, obj}); + + set (cax, "deletefcn", {@resetaxis, obj}); + + addlistener (ax, "clim", {@update_colorbar_clim, hi, vertical}); + addlistener (ax, "plotboxaspectratio", {@update_colorbar_axis, cax, obj}); + addlistener (ax, "plotboxaspectratiomode", {@update_colorbar_axis, cax, obj}); + addlistener (ax, "dataaspectratio", {@update_colorbar_axis, cax, obj}); + addlistener (ax, "dataaspectratiomode", {@update_colorbar_axis, cax, obj}); + addlistener (ax, "position", {@update_colorbar_axis, cax, obj}); + + endif + + if (nargout > 0) + h = cax; + endif +endfunction + +function deletecolorbar (h, d, hc, orig_props) + ## Don't delete the colorbar and reset the axis size if the + ## parent figure is being deleted. + if (ishandle (hc) && strcmp (get (hc, "type"), "axes") + && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off"))) + if (strcmp (get (hc, "beingdeleted"), "off")) + delete (hc); + endif + if (!isempty (ancestor (h, "axes")) + && strcmp (get (ancestor (h, "axes"), "beingdeleted"), "off")) + set (ancestor (h, "axes"), "position", orig_props.position, ... + "outerposition", orig_props.outerposition, ... + "activepositionproperty", orig_props.activepositionproperty); + endif + endif +endfunction + +function resetaxis (h, d, orig_props) + if (ishandle (h) && strcmp (get (h, "type"), "axes") + && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off")) + && ishandle (get (h, "axes"))) + set (get (h, "axes"), "position", orig_props.position, ... + "outerposition", orig_props.outerposition, ... + "activepositionproperty", orig_props.activepositionproperty); + endif +endfunction + +function update_colorbar_clim (h, d, hi, vert) + if (ishandle (h) && strcmp (get (h, "type"), "image") + && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off"))) + clen = rows (get (get (h, "parent"), "colormap")); + cext = get (h, "clim"); + cdiff = (cext(2) - cext(1)) / clen / 2; + cmin = cext(1) + cdiff; + cmax = cext(2) - cdiff; + + if (vert) + set (hi, "ydata", [cmin, cmax]); + set (get (hi, "parent"), "ylim", cext); + else + set (hi, "xdata", [cmin, cmax]); + set (get (hi, "parent"), "xlim", cext); + endif + endif +endfunction + +function update_colorbar_axis (h, d, cax, orig_props) + + if (ishandle (cax) && strcmp (get (cax, "type"), "axes") + && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off"))) + loc = get (cax, "location"); + obj = get (h); + obj.__my_handle__ = h; + obj.position = orig_props.position; + obj.outerposition = orig_props.outerposition; + [pos, cpos, vertical, mirror] = ... + __position_colorbox__ (loc, obj, ancestor (h, "figure")); + + if (vertical) + if (mirror) + set (cax, "xtick", [], "xdir", "normal", "ydir", "normal", + "yaxislocation", "right", "position", cpos); + else + set (cax, "xtick", [], "xdir", "normal", "ydir", "normal", + "yaxislocation", "left", "position", cpos); + endif + else + if (mirror) + set (cax, "ytick", [], "xdir", "normal", "ydir", "normal", + "xaxislocation", "top", "position", cpos); + else + set (cax, "ytick", [], "xdir", "normal", "ydir", "normal", + "xaxislocation", "bottom", "position", cpos); + endif + endif + + endif +endfunction + +function [pos, cpos, vertical, mirr] = __position_colorbox__ (cbox, obj, cf) + + ## This will always represent the position prior to adding the colorbar. + pos = obj.position; + sz = pos(3:4); + + if (strcmpi (obj.plotboxaspectratiomode, "manual") + || strcmpi (obj.dataaspectratiomode, "manual")) + if (isempty (strfind (cbox, "outside"))) + scale = 1.0; + else + scale = 0.8; + endif + if (isempty (strfind (cbox, "east")) && isempty (strfind (cbox, "west"))) + scale = [1, scale]; + else + scale = [scale, 1]; + endif + if (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot") + && strcmp (obj.activepositionproperty, "outerposition")) + obj.outerposition = obj.outerposition .* [1, 1, scale]; + off = 0.5 * (obj.outerposition (3:4) - __actual_axis_position__ (obj)(3:4)); + else + obj.position = obj.position .* [1, 1, scale]; + off = 0.5 * (obj.position (3:4) - __actual_axis_position__ (obj)(3:4)); + endif + else + off = 0.0; + endif + + switch (cbox) + case "northoutside" + origin = pos(1:2) + [0., 0.9] .* sz + [1, -1] .* off; + sz = sz .* [1.0, 0.06]; + pos(4) = 0.8 * pos(4); + mirr = true; + vertical = false; + case "north" + origin = pos(1:2) + [0.05, 0.9] .* sz + [1, -1] .* off; + sz = sz .* [1.0, 0.06] * 0.9; + mirr = false; + vertical = false; + case "southoutside" + origin = pos(1:2) + off; + sz = sz .* [1.0, 0.06]; + pos(2) = pos(2) + pos(4) * 0.2; + pos(4) = 0.8 * pos(4); + mirr = false; + vertical = false; + case "south" + origin = pos(1:2) + [0.05, 0.05] .* sz + off; + sz = sz .* [1.0, 0.06] * 0.9; + mirr = true; + vertical = false; + case "eastoutside" + origin = pos(1:2) + [0.9, 0] .* sz + [-1, 1] .* off; + sz = sz .* [0.06, 1.0]; + pos(3) = 0.8 * pos(3); + mirr = true; + vertical = true; + case "east" + origin = pos(1:2) + [0.9, 0.05] .* sz + [-1, 1] .* off; + sz = sz .* [0.06, 1.0] * 0.9; + mirr = false; + vertical = true; + case "westoutside" + origin = pos(1:2) + off; + sz = sz .* [0.06, 1.0]; + pos(1) = pos(1) + pos(3) * 0.2; + pos(3) = 0.8 * pos(3); + mirr = false; + vertical = true; + case "west" + origin = pos(1:2) + [0.05, 0.05] .* sz + off; + sz = sz .* [0.06, 1.0] .* 0.9; + mirr = true; + vertical = true; + endswitch + + cpos = [origin, sz]; + + if (strcmpi (obj.plotboxaspectratiomode, "manual") + || strcmpi (obj.dataaspectratiomode, "manual")) + obj.position = pos; + actual_pos = __actual_axis_position__ (obj); + if (strfind (cbox, "outside")) + scale = 1.0; + else + scale = 0.9; + endif + if (sz(1) > sz(2)) + ## Ensure north or south colorbars are the proper length + dx = (1-scale)*actual_pos(3); + cpos(1) = actual_pos(1) + dx/2; + cpos(3) = actual_pos(3) - dx; + else + ## Ensure east or west colorbars are the proper height + dy = (1-scale)*actual_pos(4); + cpos(2) = actual_pos(2) + dy/2; + cpos(4) = actual_pos(4) - dy; + endif + endif + +endfunction + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! imagesc(x) +%! colorbar(); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! imagesc(x) +%! colorbar("westoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! imagesc(x) +%! colorbar("peer", gca (), "northoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! imagesc(x) +%! colorbar("southoutside"); + +%!demo +%! clf +%! contour(peaks()) +%! colorbar("west"); + +%!demo +%! clf +%! subplot(2,2,1) +%! contour(peaks()) +%! colorbar("east"); +%! subplot(2,2,2) +%! contour(peaks()) +%! colorbar("west"); +%! subplot(2,2,3) +%! contour(peaks()) +%! colorbar("north"); +%! subplot(2,2,4) +%! contour(peaks()) +%! colorbar("south"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(2,2,1) +%! imagesc(x) +%! colorbar(); +%! subplot(2,2,2) +%! imagesc(x) +%! colorbar("westoutside"); +%! subplot(2,2,3) +%! imagesc(x) +%! colorbar("northoutside"); +%! subplot(2,2,4) +%! imagesc(x) +%! colorbar("southoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(1,2,1) +%! imagesc(x) +%! axis square; +%! colorbar(); +%! subplot(1,2,2) +%! imagesc(x) +%! axis square; +%! colorbar("westoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(1,2,1) +%! imagesc(x) +%! axis square; +%! colorbar("northoutside"); +%! subplot(1,2,2) +%! imagesc(x) +%! axis square; +%! colorbar("southoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(2,1,1) +%! imagesc(x) +%! axis square; +%! colorbar(); +%! subplot(2,1,2) +%! imagesc(x) +%! axis square; +%! colorbar("westoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(2,1,1) +%! imagesc(x) +%! axis square; +%! colorbar("northoutside"); +%! subplot(2,1,2) +%! imagesc(x) +%! axis square; +%! colorbar("southoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(1,2,1) +%! imagesc(x) +%! colorbar(); +%! subplot(1,2,2) +%! imagesc(x) +%! colorbar("westoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(1,2,1) +%! imagesc(x) +%! colorbar("northoutside"); +%! subplot(1,2,2) +%! imagesc(x) +%! colorbar("southoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(2,1,1) +%! imagesc(x) +%! colorbar(); +%! subplot(2,1,2) +%! imagesc(x) +%! colorbar("westoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(2,1,1) +%! imagesc(x) +%! colorbar("northoutside"); +%! subplot(2,1,2) +%! imagesc(x) +%! colorbar("southoutside"); + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! subplot(1,2,1) +%! contour(x) +%! axis square; +%! colorbar("east"); +%! xlim ([1, 64]) +%! ylim ([1, 64]) +%! subplot(1,2,2) +%! contour(x) +%! colorbar("west"); +%! xlim ([1, 64]) +%! ylim ([1, 64]) + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! contour (x) +%! xlim ([1, 64]) +%! ylim ([1, 64]) +%! colorbar (); +%! colorbar off + +%!demo +%! clf +%! n = 64; x = kron (1:n,ones(n,1)); x = abs(x - x.'); +%! contour (x) +%! xlim ([1, 64]) +%! ylim ([1, 64]) +%! colorbar (); +%! colorbar (); + +%!demo +%! clf +%! imagesc (1./hilb(99)); +%! h = colorbar; +%! set (h, 'yscale', 'log'); + +%!demo +%! clf +%! imagesc (log10 (1 ./ hilb (99))); +%! h = colorbar; +%! ytick = get(h, "ytick"); +%! set (h, "yticklabel", sprintf ('10^{%g}|', ytick)); + +%!demo +%! clf +%! n=5;x=linspace(0,5,n);y=linspace(0,1,n); +%! imagesc(1./hilb(n)); axis equal; colorbar + +%!demo +%! clf +%! n=5;x=linspace(0,5,n);y=linspace(0,1,n); +%! imagesc(x,y,1./hilb(n)); axis equal; colorbar + +%!demo +%! clf +%! n=5;x=linspace(0,5,n);y=linspace(0,1,n); +%! imagesc(y,x,1./hilb(n)); axis equal; colorbar +## This requires that the axes position be properly determined for "axes equal" + +%!demo +%! clf +%! axes +%! colorbar +%! hold on +%! contour(peaks) +%! hold off + +%!demo +%! clf +%! plot([0, 2]) +%! colorbar ("east") +%! axis square + +%!demo +%! clf +%! plot([0, 2]) +%! colorbar ("eastoutside") +%! axis square + +%!demo +%! clf +%! pcolor (peaks (20)) +%! shading ("interp") +%! axis ("tight", "square") +%! colorbar () +#%! axes('color','none','box','on','activepositionproperty','position') + +%!demo +%! clf +%! plot([0, 2]) +%! colorbar ("east") +%! axis equal + +%!demo +%! clf +%! plot([0, 2]) +%! colorbar ("eastoutside") +%! axis equal diff --git a/octave_packages/m/plot/colstyle.m b/octave_packages/m/plot/colstyle.m new file mode 100644 index 0000000..8e8372f --- /dev/null +++ b/octave_packages/m/plot/colstyle.m @@ -0,0 +1,89 @@ +## Copyright (C) 2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{style}, @var{color}, @var{marker}, @var{msg}] =} colstyle (@var{linespec}) +## Parse @var{linespec} and return the line style, color, and markers given. +## In the case of an error, the string @var{msg} will return the text of the +## error. +## @end deftypefn + +function [l, c, m, msg] = colstyle (style) + + if (nargin != 1) + print_usage (); + endif + + if (! ischar (style)) + error ("colstyle: STYLE must be a string"); + endif + + try + opt = __pltopt__ ("colstyle", style); + l = opt.linestyle; + c = opt.color; + m = opt.marker; + msg = []; + switch (c) + case [0 0 0] + c = "k"; + case [1 0 0] + c = "r"; + case [0 1 0] + c = "g"; + case [0 0 1] + c = "b"; + case [1 1 0] + c = "y"; + case [1 0 1] + c = "m"; + case [0 1 1] + c = "c"; + case [0 1 1] + c = "w"; + endswitch + catch + l = c = m = []; + msg = lasterr (); + end_try_catch + +endfunction + +%!test +%! [l, c, m, msg] = colstyle ("r:x"); +%! assert (isempty (msg)); +%! assert (l, ":"); +%! assert (c, "r"); +%! assert (m, "x"); + +%!test +%! [l, c, m, msg] = colstyle ("."); +%! assert (isempty (msg)); +%! assert (l, "none"); +%! assert (c, []); +%! assert (m, "."); + +%!test +%! [l, c, m, msg] = colstyle ("~"); +%! assert (msg, "colstyle: unrecognized format character: `~'"); + +%% Test input validation +%!error colstyle () +%!error colstyle (1, 2) +%!error colstyle (1.5) + diff --git a/octave_packages/m/plot/comet.m b/octave_packages/m/plot/comet.m new file mode 100644 index 0000000..2caff8c --- /dev/null +++ b/octave_packages/m/plot/comet.m @@ -0,0 +1,88 @@ +## Copyright (C) 2008-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} comet (@var{y}) +## @deftypefnx {Function File} {} comet (@var{x}, @var{y}) +## @deftypefnx {Function File} {} comet (@var{x}, @var{y}, @var{p}) +## @deftypefnx {Function File} {} comet (@var{ax}, @dots{}) +## Produce a simple comet style animation along the trajectory provided by +## the input coordinate vectors (@var{x}, @var{y}), where @var{x} will default +## to the indices of @var{y}. +## +## The speed of the comet may be controlled by @var{p}, which represents the +## time which passes as the animation passes from one point to the next. The +## default for @var{p} is 0.1 seconds. +## +## If @var{ax} is specified the animation is produced in that axis rather than +## the @code{gca}. +## @end deftypefn + +## Author: Ben Abbott bpabbott@mac.com +## Created: 2008-09-21 + +function comet (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("comet", varargin{:}); + + if (nargin == 0) + print_usage (); + elseif (nargin == 1) + y = varargin{1}; + x = 1:numel(y); + p = 0.1; + elseif (nargin == 2) + x = varargin{1}; + y = varargin{2}; + p = 0.1; + elseif (nargin == 3) + x = varargin{1}; + y = varargin{2}; + p = varargin{3}; + endif + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + theaxis = [min(x), max(x), min(y), max(y)]; + num = numel (y); + dn = round (num/10); + for n = 1:(num+dn); + m = n - dn; + m = max ([m, 1]); + k = min ([n, num]); + h = plot (x(1:m), y(1:m), "r", x(m:k), y(m:k), "g", x(k), y(k), "ob"); + axis (theaxis); + drawnow (); + pause (p); + endfor + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +%!demo +%! clf +%! t = 0:.1:2*pi; +%! x = cos(2*t).*(cos(t).^2); +%! y = sin(2*t).*(sin(t).^2); +%! comet(x,y) + + diff --git a/octave_packages/m/plot/comet3.m b/octave_packages/m/plot/comet3.m new file mode 100644 index 0000000..6ab026e --- /dev/null +++ b/octave_packages/m/plot/comet3.m @@ -0,0 +1,86 @@ +## Copyright (C) 2010-2012 Ben Abbott and John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} comet3 (@var{z}) +## @deftypefnx {Function File} {} comet3 (@var{x}, @var{y}, @var{z}, @var{p}) +## @deftypefnx {Function File} {} comet3 (@var{ax}, @dots{}) +## Produce a simple comet style animation along the trajectory provided by +## the input coordinate vectors (@var{x}, @var{y}), where @var{x} will default +## to the indices of @var{y}. +## +## The speed of the comet may be controlled by @var{p}, which represents the +## time which passes as the animation passes from one point to the next. The +## default for @var{p} is 0.1 seconds. +## +## If @var{ax} is specified the animation is produced in that axis rather than +## the @code{gca}. +## @end deftypefn + +## Author: jwe +## Created: 2010-12-17 + +function comet3 (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("comet3", varargin{:}); + + if (nargin == 0 || nargin == 2 || nargin > 4) + print_usage (); + elseif (nargin == 1) + z = varargin{1}; + x = y = 1:numel(z); + p = 0.1; + elseif (nargin == 3) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + p = 0.1; + elseif (nargin == 4) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + p = varargin{4}; + endif + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + theaxis = [min(x), max(x), min(y), max(y), min(z), max(z)]; + num = numel (y); + dn = round (num/10); + for n = 1:(num+dn); + m = n - dn; + m = max ([m, 1]); + k = min ([n, num]); + h = plot3 (x(1:m), y(1:m), z(1:m), "r", x(m:k), y(m:k), z(m:k), "g", + x(k), y(k), z(k), "ob"); + axis (theaxis); + drawnow (); + pause (p); + endfor + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +%!demo +%! clf +%! t = 0:pi/20:5*pi; +%! comet3 (cos(t), sin(t), t, 0.01); diff --git a/octave_packages/m/plot/compass.m b/octave_packages/m/plot/compass.m new file mode 100644 index 0000000..8e7b89a --- /dev/null +++ b/octave_packages/m/plot/compass.m @@ -0,0 +1,120 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} compass (@var{u}, @var{v}) +## @deftypefnx {Function File} {} compass (@var{z}) +## @deftypefnx {Function File} {} compass (@dots{}, @var{style}) +## @deftypefnx {Function File} {} compass (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} compass (@dots{}) +## +## Plot the @code{(@var{u}, @var{v})} components of a vector field emanating +## from the origin of a polar plot. If a single complex argument @var{z} is +## given, then @code{@var{u} = real (@var{z})} and @code{@var{v} = imag +## (@var{z})}. +## +## The style to use for the plot can be defined with a line style @var{style} +## in a similar manner to the line styles used with the @code{plot} command. +## +## The optional return value @var{h} is a vector of graphics handles to the +## line objects representing the drawn vectors. +## +## @example +## @group +## a = toeplitz ([1;randn(9,1)], [1,randn(1,9)]); +## compass (eig (a)); +## @end group +## @end example +## +## @seealso{polar, quiver, feather, plot} +## @end deftypefn + +function retval = compass (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("compass", varargin{:}); + + arrowsize = 0.25; + + if (nargin == 0) + print_usage (); + elseif (nargin == 1 || (nargin == 2 && ! isnumeric (varargin{2}))) + ioff = 2; + z = varargin{1}(:).'; + u = real (z); + v = imag (z); + elseif (nargin > 1 && isnumeric (varargin{2})) + ioff = 3; + u = varargin{1}(:).'; + v = varargin{2}(:).'; + endif + + line_spec = "b-"; + have_line_spec = false; + while (ioff <= nargin) + arg = varargin{ioff++}; + if ((ischar (arg) || iscell (arg)) && ! have_line_spec) + [linespec, valid] = __pltopt__ ("compass", arg, false); + if (valid) + line_spec = arg; + have_line_spec = true; + break; + else + error ("compass: invalid linespec"); + endif + else + error ("compass: unrecognized argument"); + endif + endwhile + + ## Matlab draws compass plots, with the arrow head as one continous + ## line, and each arrow separately. This is completely different than + ## quiver and quite ugly. + n = length (u); + xend = u; + xtmp = u .* (1 - arrowsize); + yend = v; + ytmp = v .* (1 - arrowsize); + x = [zeros(1, n); xend; xtmp - v * arrowsize / 3; xend; ... + xtmp + v * arrowsize / 3]; + y = [zeros(1, n); yend; ytmp + u * arrowsize / 3; yend; ... + ytmp - u * arrowsize / 3]; + [r, p] = cart2pol (x, y); + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + hlist = polar (h, r, p, line_spec); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + retval = hlist; + endif + +endfunction + + +%!demo +%! clf +%! randn_9x1_data = [-2.555884; 0.394974; -0.191871; -1.147024; 1.355425; -0.437335; -0.014370; -0.941312; 1.240300]; +%! randn_1x9_data = [1.42934, -1.10821, -1.70404, 0.63357, -0.68337, -1.19771, -0.96502, -1.12810, 0.22457]; +%! a = toeplitz ([1;randn_9x1_data], [1,randn_1x9_data]); +%! compass (eig (a)); + diff --git a/octave_packages/m/plot/contour.m b/octave_packages/m/plot/contour.m new file mode 100644 index 0000000..bdba013 --- /dev/null +++ b/octave_packages/m/plot/contour.m @@ -0,0 +1,92 @@ +## Copyright (C) 1993-2012 Shai Ayal +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} contour (@var{z}) +## @deftypefnx {Function File} {} contour (@var{z}, @var{vn}) +## @deftypefnx {Function File} {} contour (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {} contour (@var{x}, @var{y}, @var{z}, @var{vn}) +## @deftypefnx {Function File} {} contour (@dots{}, @var{style}) +## @deftypefnx {Function File} {} contour (@var{h}, @dots{}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contour (@dots{}) +## Plot level curves (contour lines) of the matrix @var{z}, using the +## contour matrix @var{c} computed by @code{contourc} from the same +## arguments; see the latter for their interpretation. The set of +## contour levels, @var{c}, is only returned if requested. For example: +## +## @example +## @group +## x = 0:2; +## y = x; +## z = x' * y; +## contour (x, y, z, 2:3) +## @end group +## @end example +## +## The style to use for the plot can be defined with a line style @var{style} +## in a similar manner to the line styles used with the @code{plot} command. +## Any markers defined by @var{style} are ignored. +## +## The optional input and output argument @var{h} allows an axis handle to +## be passed to @code{contour} and the handles to the contour objects to be +## returned. +## @seealso{contourc, patch, plot} +## @end deftypefn + +## Author: Shai Ayal + +function [c, h] = contour (varargin) + + [xh, varargin] = __plt_get_axis_arg__ ("contour", varargin{:}); + + oldh = gca (); + unwind_protect + axes (xh); + newplot (); + [ctmp, htmp] = __contour__ (xh, "none", varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + c = ctmp; + h = htmp; + endif + +endfunction + +%!demo +%! clf () +%! [x, y, z] = peaks (); +%! contour (x, y, z); + +%!demo +%! clf () +%! [theta, r] = meshgrid (linspace (0, 2*pi, 64), linspace(0,1,64)); +%! [X, Y] = pol2cart (theta, r); +%! Z = sin(2*theta).*(1-r); +%! contour(X, Y, abs(Z), 10) + +%!demo +%! clf () +%! x = linspace (-2, 2); +%! [x, y] = meshgrid (x); +%! z = sqrt (x.^2 + y.^2) ./ (x.^2 + y.^2+1); +%! contourf (x, y, z, [0.4, 0.4]) +%! title ("The hole should be filled with the background color") + diff --git a/octave_packages/m/plot/contour3.m b/octave_packages/m/plot/contour3.m new file mode 100644 index 0000000..9828425 --- /dev/null +++ b/octave_packages/m/plot/contour3.m @@ -0,0 +1,86 @@ +## Copyright (C) 2007-2012 David BAteman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} contour3 (@var{z}) +## @deftypefnx {Function File} {} contour3 (@var{z}, @var{vn}) +## @deftypefnx {Function File} {} contour3 (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {} contour3 (@var{x}, @var{y}, @var{z}, @var{vn}) +## @deftypefnx {Function File} {} contour3 (@dots{}, @var{style}) +## @deftypefnx {Function File} {} contour3 (@var{h}, @dots{}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contour3 (@dots{}) +## Plot level curves (contour lines) of the matrix @var{z}, using the +## contour matrix @var{c} computed by @code{contourc} from the same +## arguments; see the latter for their interpretation. The contours are +## plotted at the Z level corresponding to their contour. The set of +## contour levels, @var{c}, is only returned if requested. For example: +## +## @example +## @group +## contour3 (peaks (19)); +## hold on +## surface (peaks (19), "facecolor", "none", "EdgeColor", "black"); +## colormap hot; +## @end group +## @end example +## +## The style to use for the plot can be defined with a line style @var{style} +## in a similar manner to the line styles used with the @code{plot} command. +## Any markers defined by @var{style} are ignored. +## +## The optional input and output argument @var{h} allows an axis handle to +## be passed to @code{contour} and the handles to the contour objects to be +## returned. +## @seealso{contourc, patch, plot} +## @end deftypefn + +function [c, h] = contour3 (varargin) + + [xh, varargin, nargin] = __plt_get_axis_arg__ ("contour3", varargin{:}); + + oldh = gca (); + unwind_protect + axes (xh); + newplot (); + [ctmp, htmp] = __contour__ (xh, "auto", varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (! ishold ()) + set (xh, "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + + if (nargout > 0) + c = ctmp; + h = htmp; + endif + +endfunction + +%!demo +%! clf +%! contour3 (peaks (19)); +%! hold on +%! surface (peaks (19), "facecolor", "none", "edgecolor", "black") +%! colormap hot +%! axis tight +%! zlim auto +%! hold off +%! box off diff --git a/octave_packages/m/plot/contourc.m b/octave_packages/m/plot/contourc.m new file mode 100644 index 0000000..00221d7 --- /dev/null +++ b/octave_packages/m/plot/contourc.m @@ -0,0 +1,153 @@ +## Copyright (C) 2003-2012 Shai Ayal +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{c}, @var{lev}] =} contourc (@var{x}, @var{y}, @var{z}, @var{vn}) +## Compute isolines (contour lines) of the matrix @var{z}. +## Parameters @var{x}, @var{y} and @var{vn} are optional. +## +## The return value @var{lev} is a vector of the contour levels. +## The return value @var{c} is a 2 by @var{n} matrix containing the +## contour lines in the following format +## +## @example +## @group +## @var{c} = [lev1, x1, x2, @dots{}, levn, x1, x2, ... +## len1, y1, y2, @dots{}, lenn, y1, y2, @dots{}] +## @end group +## @end example +## +## @noindent +## in which contour line @var{n} has a level (height) of @var{levn} and +## length of @var{lenn}. +## +## If @var{x} and @var{y} are omitted they are taken as the row/column +## index of @var{z}. @var{vn} is either a scalar denoting the number of lines +## to compute or a vector containing the values of the lines. If only one +## value is wanted, set @code{@var{vn} = [val, val]}; +## If @var{vn} is omitted it defaults to 10. +## +## For example: +## +## @example +## @group +## x = 0:2; +## y = x; +## z = x' * y; +## contourc (x, y, z, 2:3) +## @result{} 2.0000 2.0000 1.0000 3.0000 1.5000 2.0000 +## 2.0000 1.0000 2.0000 2.0000 2.0000 1.5000 +## @end group +## @end example +## @seealso{contour} +## @end deftypefn + +## Author: Shai Ayal + +function [cout, lev] = contourc (varargin) + + if (nargin == 1) + vn = 10; + z = varargin{1}; + [nr, nc] = size (z); + x = 1:nc; + y = 1:nr; + elseif (nargin == 2) + vn = varargin{2}; + z = varargin{1}; + [nr, nc] = size (z); + x = 1:nc; + y = 1:nr; + elseif (nargin == 3) + vn = 10; + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + elseif (nargin == 4) + vn = varargin{4}; + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + else + print_usage (); + endif + + if (!ismatrix (z) || isvector (z) || isscalar (z)) + error ("contourc: Z argument must be a matrix"); + endif + + if (isscalar (vn)) + vv = linspace (min (z(:)), max (z(:)), vn+2)(2:end-1); + else + vv = unique (sort (vn)); + endif + + if (isvector (x) && isvector (y)) + c = __contourc__ (x(:)', y(:)', z, vv); + else + ## Indexes x,y for the purpose of __contourc__. + ii = 1:size (z,2); + jj = 1:size (z,1); + + ## Now call __contourc__ for the real work... + c = __contourc__ (ii, jj, z, vv); + + ## Map the contour lines from index space (i,j) back + ## to the original grid (x,y) + i = 1; + + while (i < size (c,2)) + clen = c(2, i); + ind = i + [1 : clen]; + + ci = c(1, ind); + cj = c(2,ind); + + ## due to rounding errors some elements of ci and cj + ## can fall out of the range of ii and jj and interp2 would + ## return NA for those values. + ## The permitted range is enforced here: + + ci = max (ci, 1); ci = min (ci, size (z, 2)); + cj = max (cj, 1); cj = min (cj, size (z, 1)); + + c(1, ind) = interp2 (ii, jj, x, ci, cj); + c(2, ind) = interp2 (ii, jj, y, ci, cj); + + i = i + clen + 1; + endwhile + endif + + if (nargout > 0) + cout = c; + lev = vv; + endif + +endfunction + +%!test +%! x = 0:2; +%! y = x; +%! z = x' * y; +%! [c_actual, lev_actual]= contourc (x, y, z, 2:3); +%! c_expected = [2, 1, 1, 2, 2, 3, 1.5, 2; 4, 2, 2, 1, 1, 2, 2, 1.5]; +%! lev_expected = [2 3]; +%! assert (c_actual, c_expected, eps) +%! assert (lev_actual, lev_expected, eps) + + diff --git a/octave_packages/m/plot/contourf.m b/octave_packages/m/plot/contourf.m new file mode 100644 index 0000000..f693311 --- /dev/null +++ b/octave_packages/m/plot/contourf.m @@ -0,0 +1,93 @@ +## Copyright (C) 2007-2012 Kai Habel +## Copyright (C) 2003 Shai Ayal +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{c}, @var{h}] =} contourf (@var{x}, @var{y}, @var{z}, @var{lvl}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contourf (@var{x}, @var{y}, @var{z}, @var{n}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contourf (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contourf (@var{z}, @var{n}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contourf (@var{z}, @var{lvl}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contourf (@var{z}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contourf (@var{ax}, @dots{}) +## @deftypefnx {Function File} {[@var{c}, @var{h}] =} contourf (@dots{}, @var{"property"}, @var{val}) +## Compute and plot filled contours of the matrix @var{z}. +## Parameters @var{x}, @var{y} and @var{n} or @var{lvl} are optional. +## +## The return value @var{c} is a 2xn matrix containing the contour lines +## as described in the help to the contourc function. +## +## The return value @var{h} is handle-vector to the patch objects creating +## the filled contours. +## +## If @var{x} and @var{y} are omitted they are taken as the row/column +## index of @var{z}. @var{n} is a scalar denoting the number of lines +## to compute. Alternatively @var{lvl} is a vector containing the +## contour levels. If only one value (e.g., lvl0) is wanted, set +## @var{lvl} to [lvl0, lvl0]. If both @var{n} or @var{lvl} are omitted +## a default value of 10 contour level is assumed. +## +## If provided, the filled contours are added to the axes object +## @var{ax} instead of the current axis. +## +## The following example plots filled contours of the @code{peaks} +## function. +## +## @example +## @group +## [x, y, z] = peaks (50); +## contourf (x, y, z, -7:9) +## @end group +## @end example +## @seealso{contour, contourc, patch} +## @end deftypefn + +## Author: Kai Habel +## Author: Shai Ayal + +function [c, h] = contourf (varargin) + + [xh, varargin] = __plt_get_axis_arg__ ("contour", varargin{:}); + + oldh = gca (); + unwind_protect + axes (xh); + newplot (); + [ctmp, htmp] = __contour__ (xh, "none", "fill", "on", + "linecolor", "black", varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + c = ctmp; + h = htmp; + endif +endfunction + +%!demo +%! clf +%! [x, y, z] = peaks (50); +%! contourf (x, y, z, -7:9) + +%!demo +%! clf +%! [theta, r] = meshgrid (linspace (0, 2*pi, 64), linspace(0,1,64)); +%! [X, Y] = pol2cart (theta, r); +%! Z = sin(2*theta).*(1-r); +%! contourf(X, Y, abs(Z), 10) diff --git a/octave_packages/m/plot/cylinder.m b/octave_packages/m/plot/cylinder.m new file mode 100644 index 0000000..d9d09c3 --- /dev/null +++ b/octave_packages/m/plot/cylinder.m @@ -0,0 +1,92 @@ +## Copyright (C) 2007-2012 Michael Goffioul and Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cylinder +## @deftypefnx {Function File} {} cylinder (@var{r}) +## @deftypefnx {Function File} {} cylinder (@var{r}, @var{n}) +## @deftypefnx {Function File} {[@var{x}, @var{y}, @var{z}] =} cylinder (@dots{}) +## @deftypefnx {Function File} {} cylinder (@var{ax}, @dots{}) +## Generate three matrices in @code{meshgrid} format, such that +## @code{surf (@var{x}, @var{y}, @var{z})} generates a unit cylinder. +## The matrices are of size @code{@var{n}+1}-by-@code{@var{n}+1}. +## @var{r} is a vector containing the radius along the z-axis. +## If @var{n} or @var{r} are omitted then default values of 20 or [1 1] +## are assumed. +## +## Called with no return arguments, @code{cylinder} calls directly +## @code{surf (@var{x}, @var{y}, @var{z})}. If an axes handle @var{ax} +## is passed as the first argument, the surface is plotted to this set +## of axes. +## +## Examples: +## +## @example +## @group +## [x, y, z] = cylinder (10:-1:0, 50); +## surf (x, y, z); +## title ("a cone"); +## @end group +## @end example +## @seealso{sphere} +## @end deftypefn + +function [xx, yy, zz] = cylinder (varargin) + + [ax, args, nargs] = __plt_get_axis_arg__ ((nargout > 0), "cylinder", + varargin{:}); + + if (nargs == 0) + n = 20; + r = [1, 1]; + elseif (nargs == 1) + n = 20; + r = args{1}; + elseif (nargs == 2) + r = args{1}; + n = args{2}; + else + print_usage (); + endif + + if (length (r) < 2) + error ("cylinder: length(R) must be larger than 2"); + endif + + phi = linspace (0, 2*pi, n+1); + idx = 1:length(r); + [phi, idx] = meshgrid(phi, idx); + z = (idx - 1) / (length(r) - 1); + r = r(idx); + [x, y] = pol2cart (phi, r); + + if (nargout > 0) + xx = x; + yy = y; + zz = z; + else + surf (ax, x, y, z); + endif + +endfunction + +%!demo +%! clf +%! [x, y, z] = cylinder (10:-1:0,50); +%! surf (x, y, z); +%! title ("a cone") diff --git a/octave_packages/m/plot/daspect.m b/octave_packages/m/plot/daspect.m new file mode 100644 index 0000000..ef6d11c --- /dev/null +++ b/octave_packages/m/plot/daspect.m @@ -0,0 +1,133 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} daspect (@var{data_aspect_ratio}) +## Set the data aspect ratio of the current axes. The aspect ratio is +## a normalized 3-element vector representing the span of the x, y, and +## z-axes limits. +## +## @deftypefnx {Function File} {@var{data_aspect_ratio} =} daspect ( ) +## Return the data aspect ratio of the current axes. +## +## @deftypefnx {Function File} {} daspect (@var{mode}) +## Set the data aspect ratio mode of the current axes. +## +## @deftypefnx {Function File} {@var{data_aspect_ratio_mode} =} daspect ("mode") +## Return the data aspect ratio mode of the current axes. +## +## @deftypefnx {Function File} {} daspect (@var{hax}, @dots{}) +## Use the axes, with handle @var{hax}, instead of the current axes. +## +## @seealso{axis, pbaspect, xlim, ylim, zlim} +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-01-26 + +function varargout = daspect (varargin) + + hax = gca (); + + if (nargin > 0) + if (isscalar (varargin{1}) && ishandle (varargin{1})) + hax = varargin{1}; + varargin = varargin(2:end); + endif + endif + if (numel (varargin) > 0) + if (numel (varargin) == 1) + if (ischar (varargin{1}) + && any (strcmpi (varargin{1}, {"mode", "manual", "auto"}))) + switch (varargin{1}) + case "mode" + if (nargout < 2) + varargout{1} = get (hax, "dataaspectratiomode"); + return + else + error ("daspect: only one output is allowed"); + endif + case "manual" + set (hax, "dataaspectratiomode", "manual"); + case "auto" + set (hax, "dataaspectratiomode", "auto"); + endswitch + elseif (isreal (varargin{1}) && numel (varargin{1}) == 2) + set (hax, "dataaspectratio", [varargin{1}, 1]); + elseif (isreal (varargin{1}) && numel (varargin{1}) == 3) + set (hax, "dataaspectratio", varargin{1}); + else + error ("daspect: invalid input"); + endif + elseif (numel (varargin) > 1) + error ("daspect: too many inputs"); + endif + elseif (nargout == 0) + print_usage (); + endif + + if (nargout == 1) + varargout{1} = get (hax, "dataaspectratio"); + elseif (nargout > 1) + error ("daspect: only one output is allowed"); + endif + +endfunction + +%!demo +%! x = 0:0.01:4; +%! clf +%! plot (x, cos (x), x, sin (x)) +%! axis square +%! daspect ([1 1 1]) +%! title ("square plot-box with axis limits [0, 4, -2, 2]") + +%!demo +%! x = 0:0.01:4; +%! clf +%! plot (x, cos (x), x, sin (x)) +%! axis ([0 4 -1 1]) +%! daspect ([2 1 1]) +%! title ("square plot-box with axis limits [0, 4, -1, 1]") + +%!demo +%! x = 0:0.01:4; +%! clf +%! plot (x, cos (x), x, sin (x)) +%! daspect ([1 2 1]) +%! pbaspect ([2 1 1]) +%! title ("2x1 plot box with axis limits [0, 4, -2, 2]") + +%!demo +%! x = 0:0.01:4; +%! clf +%! plot (x, cos (x), x, sin (x)) +%! axis square +%! set (gca, "activepositionproperty", "position") +%! daspect ([1 1 1]) +%! title ("square plot-box with axis limits [0, 4, -2, 2]") + +%!demo +%! x = 0:0.01:4; +%! clf +%! plot (x, cos (x), x, sin (x)) +%! axis ([0 4 -1 1]) +%! set (gca, "activepositionproperty", "position") +%! daspect ([2 1 1]) +%! title ("square plot-box with axis limits [0, 4, -1, 1]") + diff --git a/octave_packages/m/plot/diffuse.m b/octave_packages/m/plot/diffuse.m new file mode 100644 index 0000000..41dd36e --- /dev/null +++ b/octave_packages/m/plot/diffuse.m @@ -0,0 +1,58 @@ +## Copyright (C) 2009-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} diffuse (@var{sx}, @var{sy}, @var{sz}, @var{lv}) +## Calculate diffuse reflection strength of a surface defined by the normal +## vector elements @var{sx}, @var{sy}, @var{sz}. +## The light vector can be specified using parameter @var{lv}. It can be +## given as 2-element vector [azimuth, elevation] in degrees or as 3-element +## vector [lx, ly, lz]. +## @seealso{specular, surfl} +## @end deftypefn + +## Author: Kai Habel + +function retval = diffuse (sx, sy, sz, lv) + + if (nargin != 4) + print_usage (); + endif + + ## check for normal vector + if (!size_equal (sx, sy, sz)) + error ("diffuse: SX, SY, and SZ must have same size"); + endif + + ## check for light vector (lv) argument + if (length (lv) < 2 || length (lv) > 3) + error ("diffuse: light vector LV must be a 2- or 3-element vector"); + elseif (length (lv) == 2) + [lv(1), lv(2), lv(3)] = sph2cart (lv(1) * pi/180, lv(2) * pi/180, 1.0); + endif + + ## Normalize view and light vector. + if (sum (abs (lv)) > 0) + lv /= norm (lv); + endif + + ns = sqrt (sx.^2 + sy.^2 + sz.^2); + retval = (sx * lv(1) + sy * lv(2) + sz * lv(3)) ./ ns; + retval(retval < 0) = 0; + +endfunction diff --git a/octave_packages/m/plot/ellipsoid.m b/octave_packages/m/plot/ellipsoid.m new file mode 100644 index 0000000..a6cfd84 --- /dev/null +++ b/octave_packages/m/plot/ellipsoid.m @@ -0,0 +1,74 @@ +## Copyright (C) 2007-2012 Sylvain Pelissier +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{y}, @var{z}] =} ellipsoid (@var{xc}, @var{yc}, @var{zc}, @var{xr}, @var{yr}, @var{zr}, @var{n}) +## @deftypefnx {Function File} {} ellipsoid (@var{h}, @dots{}) +## Generate three matrices in @code{meshgrid} format that define an +## ellipsoid. Called with no return arguments, @code{ellipsoid} calls +## directly @code{surf (@var{x}, @var{y}, @var{z})}. If an axes handle +## is passed as the first argument, the surface is plotted to this +## set of axes. +## @seealso{sphere} +## @end deftypefn + +## Author: Sylvain Pelissier + +function [xx, yy, zz] = ellipsoid (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ((nargout > 0), "ellipsoid", + varargin{:}); + + if (nargin != 6 && nargin != 7) + print_usage (); + endif + + xc = varargin{1}; + yc = varargin{2}; + zc = varargin{3}; + xr = varargin{4}; + yr = varargin{5}; + zr = varargin{6}; + + if (nargin == 6) + n = 20; + else + n = varargin{7}; + endif + + theta = linspace (0, 2 * pi, n + 1); + phi = linspace (-pi / 2, pi / 2, n + 1); + [theta, phi] = meshgrid (theta, phi); + + x = xr .* cos (phi) .* cos (theta) + xc; + y = yr .* cos (phi) .* sin (theta) + yc; + z = zr .* sin (phi) + zc; + + if (nargout > 0) + xx = x; + yy = y; + zz = z; + else + surf (h, x, y, z); + endif + +endfunction + +%!demo +%! clf +%! ellipsoid (0, 0, 1, 2, 3, 4, 20); diff --git a/octave_packages/m/plot/errorbar.m b/octave_packages/m/plot/errorbar.m new file mode 100644 index 0000000..d95dc78 --- /dev/null +++ b/octave_packages/m/plot/errorbar.m @@ -0,0 +1,176 @@ +## Copyright (C) 2000-2012 Teemu Ikonen +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} errorbar (@var{args}) +## This function produces two-dimensional plots with errorbars. Many +## different combinations of arguments are possible. The simplest form is +## +## @example +## errorbar (@var{y}, @var{ey}) +## @end example +## +## @noindent +## where the first argument is taken as the set of @var{y} coordinates +## and the second argument @var{ey} is taken as the errors of the +## @var{y} values. @var{x} coordinates are taken to be the indices +## of the elements, starting with 1. +## +## If more than two arguments are given, they are interpreted as +## +## @example +## errorbar (@var{x}, @var{y}, @dots{}, @var{fmt}, @dots{}) +## @end example +## +## @noindent +## where after @var{x} and @var{y} there can be up to four error +## parameters such as @var{ey}, @var{ex}, @var{ly}, @var{uy}, etc., +## depending on the plot type. Any number of argument sets may appear, +## as long as they are separated with a format string @var{fmt}. +## +## If @var{y} is a matrix, @var{x} and error parameters must also be matrices +## having same dimensions. The columns of @var{y} are plotted versus the +## corresponding columns of @var{x} and errorbars are drawn from +## the corresponding columns of error parameters. +## +## If @var{fmt} is missing, yerrorbars ("~") plot style is assumed. +## +## If the @var{fmt} argument is supplied, it is interpreted as in +## normal plots. In addition, @var{fmt} may include an errorbar style +## which must precede the line and marker format. The following plot +## styles are supported by errorbar: +## +## @table @samp +## @item ~ +## Set yerrorbars plot style (default). +## +## @item > +## Set xerrorbars plot style. +## +## @item ~> +## Set xyerrorbars plot style. +## +## @item # +## Set boxes plot style. +## +## @item #~ +## Set boxerrorbars plot style. +## +## @item #~> +## Set boxxyerrorbars plot style. +## @end table +## +## Examples: +## +## @example +## errorbar (@var{x}, @var{y}, @var{ex}, ">") +## @end example +## +## @noindent +## produces an xerrorbar plot of @var{y} versus @var{x} with @var{x} +## errorbars drawn from @var{x}-@var{ex} to @var{x}+@var{ex}. +## +## @example +## @group +## errorbar (@var{x}, @var{y1}, @var{ey}, "~", +## @var{x}, @var{y2}, @var{ly}, @var{uy}) +## @end group +## @end example +## +## @noindent +## produces yerrorbar plots with @var{y1} and @var{y2} versus @var{x}. +## Errorbars for @var{y1} are drawn from @var{y1}-@var{ey} to +## @var{y1}+@var{ey}, errorbars for @var{y2} from @var{y2}-@var{ly} to +## @var{y2}+@var{uy}. +## +## @example +## @group +## errorbar (@var{x}, @var{y}, @var{lx}, @var{ux}, +## @var{ly}, @var{uy}, "~>") +## @end group +## @end example +## +## @noindent +## produces an xyerrorbar plot of @var{y} versus @var{x} in which +## @var{x} errorbars are drawn from @var{x}-@var{lx} to @var{x}+@var{ux} +## and @var{y} errorbars from @var{y}-@var{ly} to @var{y}+@var{uy}. +## @seealso{semilogxerr, semilogyerr, loglogerr} +## @end deftypefn + +## Created: 18.7.2000 +## Author: Teemu Ikonen +## Keywords: errorbar, plotting + +function retval = errorbar (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("errorbar", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + tmp = __errcomm__ ("errorbar", h, varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + + +%!demo +%! clf +%! rand_1x11_data1 = [0.82712, 0.50325, 0.35613, 0.77089, 0.20474, 0.69160, 0.30858, 0.88225, 0.35187, 0.14168, 0.54270]; +%! rand_1x11_data2 = [0.506375, 0.330106, 0.017982, 0.859270, 0.140641, 0.327839, 0.275886, 0.162453, 0.807592, 0.318509, 0.921112]; +%! errorbar (0:10, rand_1x11_data1, 0.25*rand_1x11_data2); + +%!demo +%! clf +%! rand_1x11_data3 = [0.423650, 0.142331, 0.213195, 0.129301, 0.975891, 0.012872, 0.635327, 0.338829, 0.764997, 0.401798, 0.551850]; +%! rand_1x11_data4 = [0.682566, 0.456342, 0.132390, 0.341292, 0.108633, 0.601553, 0.040455, 0.146665, 0.309187, 0.586291, 0.540149]; +%! errorbar(0:10, rand_1x11_data3, rand_1x11_data4, ">"); + +%!demo +%! clf +%! x = 0:0.5:2*pi; +%! err = x/100; +%! y1 = sin (x); +%! y2 = cos (x); +%! hg = errorbar (x, y1, err, "~", x, y2, err, ">"); + +%!demo +%! clf +%! x = 0:0.5:2*pi; +%! err = x/100; +%! y1 = sin (x); +%! y2 = cos (x); +%! hg = errorbar (x, y1, err, err, "#r", x, y2, err, err, "#~"); + +%!demo +%! clf +%! x = 0:0.5:2*pi; +%! err = x/100; +%! y1 = sin (x); +%! y2 = cos (x); +%! hg = errorbar (x, y1, err, err, err, err, "~>", ... +%! x, y2, err, err, err, err, "#~>-*"); + diff --git a/octave_packages/m/plot/ezcontour.m b/octave_packages/m/plot/ezcontour.m new file mode 100644 index 0000000..e7a8f62 --- /dev/null +++ b/octave_packages/m/plot/ezcontour.m @@ -0,0 +1,68 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezcontour (@var{f}) +## @deftypefnx {Function File} {} ezcontour (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezcontour (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezcontour (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezcontour (@dots{}) +## +## Plot the contour lines of a function. @var{f} is a string, inline function +## or function handle with two arguments defining the function. By default the +## plot is over the domain @code{-2*pi < @var{x} < 2*pi} and @code{-2*pi < +## @var{y} < 2*pi} with 60 points in each dimension. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of both @var{x} and @var{y}. If @var{dom} is a four element vector, +## then the minimum and maximum value of @var{x} and @var{y} are specify +## separately. +## +## @var{n} is a scalar defining the number of points to use in each dimension. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## +## @example +## @group +## f = @@(x,y) sqrt (abs (x .* y)) ./ (1 + x.^2 + y.^2); +## ezcontour (f, [-3, 3]); +## @end group +## @end example +## +## @seealso{ezplot, ezcontourf, ezsurfc, ezmeshc} +## @end deftypefn + +function retval = ezcontour (varargin) + + [h, needusage] = __ezplot__ ("contour", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); +%! ezcontour (f, [-3, 3]); + diff --git a/octave_packages/m/plot/ezcontourf.m b/octave_packages/m/plot/ezcontourf.m new file mode 100644 index 0000000..0981100 --- /dev/null +++ b/octave_packages/m/plot/ezcontourf.m @@ -0,0 +1,67 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezcontourf (@var{f}) +## @deftypefnx {Function File} {} ezcontourf (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezcontourf (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezcontourf (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezcontourf (@dots{}) +## +## Plot the filled contour lines of a function. @var{f} is a string, inline +## function or function handle with two arguments defining the function. By +## default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} and +## @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of both @var{x} and @var{y}. If @var{dom} is a four element vector, +## then the minimum and maximum value of @var{x} and @var{y} are specify +## separately. +## +## @var{n} is a scalar defining the number of points to use in each dimension. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## +## @example +## @group +## f = @@(x,y) sqrt (abs (x .* y)) ./ (1 + x.^2 + y.^2); +## ezcontourf (f, [-3, 3]); +## @end group +## @end example +## +## @seealso{ezplot, ezcontour, ezsurfc, ezmeshc} +## @end deftypefn + +function retval = ezcontourf (varargin) + + [h, needusage] = __ezplot__ ("contourf", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); +%! ezcontourf (f, [-3, 3]); diff --git a/octave_packages/m/plot/ezmesh.m b/octave_packages/m/plot/ezmesh.m new file mode 100644 index 0000000..49f0545 --- /dev/null +++ b/octave_packages/m/plot/ezmesh.m @@ -0,0 +1,96 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezmesh (@var{f}) +## @deftypefnx {Function File} {} ezmesh (@var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {} ezmesh (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezmesh (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezmesh (@dots{}, 'circ') +## @deftypefnx {Function File} {} ezmesh (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezmesh (@dots{}) +## +## Plot the mesh defined by a function. @var{f} is a string, inline +## function or function handle with two arguments defining the function. By +## default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} and +## @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of both @var{x} and @var{y}. If @var{dom} is a four element vector, +## then the minimum and maximum value of @var{x} and @var{y} are specify +## separately. +## +## @var{n} is a scalar defining the number of points to use in each dimension. +## +## If three functions are passed, then plot the parametrically defined +## function @code{[@var{fx} (@var{s}, @var{t}), @var{fy} (@var{s}, @var{t}), +## @var{fz} (@var{s}, @var{t})]}. +## +## If the argument 'circ' is given, then the function is plotted over a disk +## centered on the middle of the domain @var{dom}. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. +## +## @example +## @group +## f = @@(x,y) sqrt (abs (x .* y)) ./ (1 + x.^2 + y.^2); +## ezmesh (f, [-3, 3]); +## @end group +## @end example +## +## An example of a parametrically defined function is +## +## @example +## @group +## fx = @@(s,t) cos (s) .* cos(t); +## fy = @@(s,t) sin (s) .* cos(t); +## fz = @@(s,t) sin(t); +## ezmesh (fx, fy, fz, [-pi, pi, -pi/2, pi/2], 20); +## @end group +## @end example +## +## @seealso{ezplot, ezmeshc, ezsurf, ezsurfc} +## @end deftypefn + +function retval = ezmesh (varargin) + + [h, needusage] = __ezplot__ ("mesh", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); +%! ezmesh (f, [-3, 3]); + +%!demo +%! clf +%! fx = @(s,t) cos (s) .* cos(t); +%! fy = @(s,t) sin (s) .* cos(t); +%! fz = @(s,t) sin (t); +%! ezmesh (fx, fy, fz, [-pi,pi,-pi/2,pi/2], 20); + diff --git a/octave_packages/m/plot/ezmeshc.m b/octave_packages/m/plot/ezmeshc.m new file mode 100644 index 0000000..1e03478 --- /dev/null +++ b/octave_packages/m/plot/ezmeshc.m @@ -0,0 +1,79 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezmeshc (@var{f}) +## @deftypefnx {Function File} {} ezmeshc (@var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {} ezmeshc (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezmeshc (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezmeshc (@dots{}, 'circ') +## @deftypefnx {Function File} {} ezmeshc (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezmeshc (@dots{}) +## +## Plot the mesh and contour lines defined by a function. @var{f} is a string, +## inline function or function handle with two arguments defining the function. +## By default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} and +## @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of both @var{x} and @var{y}. If @var{dom} is a four element vector, +## then the minimum and maximum value of @var{x} and @var{y} are specify +## separately. +## +## @var{n} is a scalar defining the number of points to use in each dimension. +## +## If three functions are passed, then plot the parametrically defined +## function @code{[@var{fx} (@var{s}, @var{t}), @var{fy} (@var{s}, @var{t}), +## @var{fz} (@var{s}, @var{t})]}. +## +## If the argument 'circ' is given, then the function is plotted over a disk +## centered on the middle of the domain @var{dom}. +## +## The optional return value @var{h} is a 2-element vector with a graphics +## handle for the created mesh plot and a second handle for the created contour +## plot. +## +## @example +## @group +## f = @@(x,y) sqrt (abs (x .* y)) ./ (1 + x.^2 + y.^2); +## ezmeshc (f, [-3, 3]); +## @end group +## @end example +## +## @seealso{ezplot, ezsurfc, ezsurf, ezmesh} +## @end deftypefn + +function retval = ezmeshc (varargin) + + [h, needusage] = __ezplot__ ("meshc", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); +%! ezmeshc (f, [-3, 3]); + diff --git a/octave_packages/m/plot/ezplot.m b/octave_packages/m/plot/ezplot.m new file mode 100644 index 0000000..95e40b6 --- /dev/null +++ b/octave_packages/m/plot/ezplot.m @@ -0,0 +1,94 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezplot (@var{f}) +## @deftypefnx {Function File} {} ezplot (@var{fx}, @var{fy}) +## @deftypefnx {Function File} {} ezplot (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezplot (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezplot (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezplot (@dots{}) +## +## Plot the curve defined by @var{f} in two dimensions. The function +## @var{f} may be a string, inline function or function handle and can +## have either one or two variables. If @var{f} has one variable, then +## the function is plotted over the domain @code{-2*pi < @var{x} < 2*pi} +## with 500 points. +## +## If @var{f} has two variables then @code{@var{f}(@var{x},@var{y}) = 0} +## is calculated over the meshed domain @code{-2*pi < @var{x} | @var{y} +## < 2*pi} with 60 by 60 in the mesh. For example: +## +## @example +## ezplot (@@(@var{x}, @var{y}) @var{x}.^2 - @var{y}.^2 - 1) +## @end example +## +## If two functions are passed as strings, inline functions or function +## handles, then the parametric function +## +## @example +## @group +## @var{x} = @var{fx} (@var{t}) +## @var{y} = @var{fy} (@var{t}) +## @end group +## @end example +## +## @noindent +## is plotted over the domain @code{-2*pi < @var{t} < 2*pi} with 500 +## points. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of @var{x}, @var{y} and @var{t}. If it is a four element +## vector, then the minimum and maximum values of @var{x} and @var{t} +## are determined by the first two elements and the minimum and maximum +## of @var{y} by the second pair of elements. +## +## @var{n} is a scalar defining the number of points to use in plotting +## the function. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## +## @seealso{plot, ezplot3} +## @end deftypefn + +function retval = ezplot (varargin) + + [h, needusage] = __ezplot__ ("plot", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! ezplot (@cos, @sin) + +%!demo +%! clf +%! ezplot ("1/x") + +%!demo +%! clf +%! ezplot (inline ("x^2 - y^2 = 1")) + diff --git a/octave_packages/m/plot/ezplot3.m b/octave_packages/m/plot/ezplot3.m new file mode 100644 index 0000000..e1108b2 --- /dev/null +++ b/octave_packages/m/plot/ezplot3.m @@ -0,0 +1,69 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezplot3 (@var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {} ezplot3 (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezplot3 (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezplot3 (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezplot3 (@dots{}) +## +## Plot a parametrically defined curve in three dimensions. +## @var{fx}, @var{fy}, and @var{fz} are strings, inline functions +## or function handles with one arguments defining the function. By +## default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} +## with 60 points. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of @var{t}. @var{n} is a scalar defining the number of points to use. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## +## @example +## @group +## fx = @@(t) cos (t); +## fy = @@(t) sin (t); +## fz = @@(t) t; +## ezplot3 (fx, fy, fz, [0, 10*pi], 100); +## @end group +## @end example +## +## @seealso{plot3, ezplot, ezsurf, ezmesh} +## @end deftypefn + +function retval = ezplot3 (varargin) + + [h, needusage] = __ezplot__ ("plot3", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! fx = @(t) cos (t); +%! fy = @(t) sin (t); +%! fz = @(t) t; +%! ezplot3 (fx, fy, fz, [0, 10*pi], 100); + diff --git a/octave_packages/m/plot/ezpolar.m b/octave_packages/m/plot/ezpolar.m new file mode 100644 index 0000000..6109a23 --- /dev/null +++ b/octave_packages/m/plot/ezpolar.m @@ -0,0 +1,61 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezpolar (@var{f}) +## @deftypefnx {Function File} {} ezpolar (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezpolar (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezpolar (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezpolar (@dots{}) +## +## Plot a function in polar coordinates. The function @var{f} is either +## a string, inline function or function handle with one arguments defining +## the function. By default the plot is over the domain @code{0 < @var{x} < +## 2*pi} with 60 points. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of both @var{t}. @var{n} is a scalar defining the number of points to +## use. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## +## @example +## ezpolar (@@(t) 1 + sin (t)); +## @end example +## +## @seealso{polar, ezplot, ezsurf, ezmesh} +## @end deftypefn + +function retval = ezpolar (varargin) + + [h, needusage] = __ezplot__ ("polar", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! ezpolar (@(t) 1 + sin (t)); + diff --git a/octave_packages/m/plot/ezsurf.m b/octave_packages/m/plot/ezsurf.m new file mode 100644 index 0000000..c4caa97 --- /dev/null +++ b/octave_packages/m/plot/ezsurf.m @@ -0,0 +1,96 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezsurf (@var{f}) +## @deftypefnx {Function File} {} ezsurf (@var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {} ezsurf (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezsurf (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezsurf (@dots{}, 'circ') +## @deftypefnx {Function File} {} ezsurf (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezsurf (@dots{}) +## +## Plot the surface defined by a function. @var{f} is a string, inline +## function or function handle with two arguments defining the function. By +## default the plot is over the domain @code{-2*pi < @var{x} < 2*pi} and +## @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of both @var{x} and @var{y}. If @var{dom} is a four element vector, +## then the minimum and maximum value of @var{x} and @var{y} are specify +## separately. +## +## @var{n} is a scalar defining the number of points to use in each dimension. +## +## If three functions are passed, then plot the parametrically defined +## function @code{[@var{fx} (@var{s}, @var{t}), @var{fy} (@var{s}, @var{t}), +## @var{fz} (@var{s}, @var{t})]}. +## +## If the argument 'circ' is given, then the function is plotted over a disk +## centered on the middle of the domain @var{dom}. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. +## +## @example +## @group +## f = @@(x,y) sqrt (abs (x .* y)) ./ (1 + x.^2 + y.^2); +## ezsurf (f, [-3, 3]); +## @end group +## @end example +## +## An example of a parametrically defined function is +## +## @example +## @group +## fx = @@(s,t) cos (s) .* cos (t); +## fy = @@(s,t) sin (s) .* cos (t); +## fz = @@(s,t) sin (t); +## ezsurf (fx, fy, fz, [-pi, pi, -pi/2, pi/2], 20); +## @end group +## @end example +## +## @seealso{ezplot, ezmesh, ezsurfc, ezmeshc} +## @end deftypefn + +function retval = ezsurf (varargin) + + [h, needusage] = __ezplot__ ("surf", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); +%! ezsurf (f, [-3, 3]); + +%!demo +%! clf +%! fx = @(s,t) cos (s) .* cos(t); +%! fy = @(s,t) sin (s) .* cos(t); +%! fz = @(s,t) sin (t); +%! ezsurf (fx, fy, fz, [-pi,pi,-pi/2,pi/2], 20); + diff --git a/octave_packages/m/plot/ezsurfc.m b/octave_packages/m/plot/ezsurfc.m new file mode 100644 index 0000000..dbdce33 --- /dev/null +++ b/octave_packages/m/plot/ezsurfc.m @@ -0,0 +1,79 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ezsurfc (@var{f}) +## @deftypefnx {Function File} {} ezsurfc (@var{fx}, @var{fy}, @var{fz}) +## @deftypefnx {Function File} {} ezsurfc (@dots{}, @var{dom}) +## @deftypefnx {Function File} {} ezsurfc (@dots{}, @var{n}) +## @deftypefnx {Function File} {} ezsurfc (@dots{}, 'circ') +## @deftypefnx {Function File} {} ezsurfc (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} ezsurfc (@dots{}) +## +## Plot the surface and contour lines defined by a function. @var{f} is a +## string, inline function or function handle with two arguments defining the +## function. By default the plot is over the domain @code{-2*pi < @var{x} < +## 2*pi} and @code{-2*pi < @var{y} < 2*pi} with 60 points in each dimension. +## +## If @var{dom} is a two element vector, it represents the minimum and maximum +## value of both @var{x} and @var{y}. If @var{dom} is a four element vector, +## then the minimum and maximum value of @var{x} and @var{y} are specify +## separately. +## +## @var{n} is a scalar defining the number of points to use in each dimension. +## +## If three functions are passed, then plot the parametrically defined +## function @code{[@var{fx} (@var{s}, @var{t}), @var{fy} (@var{s}, @var{t}), +## @var{fz} (@var{s}, @var{t})]}. +## +## If the argument 'circ' is given, then the function is plotted over a disk +## centered on the middle of the domain @var{dom}. +## +## The optional return value @var{h} is a 2-element vector with a graphics +## for the created surface plot and a second handle for the created contour +## plot. +## +## @example +## @group +## f = @@(x,y) sqrt (abs (x .* y)) ./ (1 + x.^2 + y.^2); +## ezsurfc (f, [-3, 3]); +## @end group +## @end example +## +## @seealso{ezplot, ezmeshc, ezsurf, ezmesh} +## @end deftypefn + +function retval = ezsurfc (varargin) + + [h, needusage] = __ezplot__ ("surfc", varargin{:}); + + if (needusage) + print_usage (); + endif + + if (nargout > 0) + retval = h; + endif +endfunction + + +%!demo +%! clf +%! f = @(x,y) sqrt(abs(x .* y)) ./ (1 + x.^2 + y.^2); +%! ezsurfc (f, [-3, 3]); + diff --git a/octave_packages/m/plot/feather.m b/octave_packages/m/plot/feather.m new file mode 100644 index 0000000..482ad92 --- /dev/null +++ b/octave_packages/m/plot/feather.m @@ -0,0 +1,117 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} feather (@var{u}, @var{v}) +## @deftypefnx {Function File} {} feather (@var{z}) +## @deftypefnx {Function File} {} feather (@dots{}, @var{style}) +## @deftypefnx {Function File} {} feather (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} feather (@dots{}) +## +## Plot the @code{(@var{u}, @var{v})} components of a vector field emanating +## from equidistant points on the x-axis. If a single complex argument +## @var{z} is given, then @code{@var{u} = real (@var{z})} and +## @code{@var{v} = imag (@var{z})}. +## +## The style to use for the plot can be defined with a line style @var{style} +## in a similar manner to the line styles used with the @code{plot} command. +## +## The optional return value @var{h} is a vector of graphics handles to the +## line objects representing the drawn vectors. +## +## @example +## @group +## phi = [0 : 15 : 360] * pi/180; +## feather (sin (phi), cos (phi)); +## @end group +## @end example +## +## @seealso{plot, quiver, compass} +## @end deftypefn + +function retval = feather (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("feather", varargin{:}); + + arrowsize = 0.25; + + if (nargin == 0) + print_usage (); + elseif (nargin == 1 || (nargin == 2 && ! isnumeric (varargin{2}))) + ioff = 2; + z = varargin{1}(:).'; + u = real (z); + v = imag (z); + elseif (nargin > 1 && isnumeric (varargin{2})) + ioff = 3; + u = varargin{1}(:).'; + v = varargin{2}(:).'; + endif + + line_spec = "b-"; + have_line_spec = false; + while (ioff <= nargin) + arg = varargin{ioff++}; + if ((ischar (arg) || iscell (arg)) && ! have_line_spec) + [linespec, valid] = __pltopt__ ("feather", arg, false); + if (valid) + line_spec = arg; + have_line_spec = false; + break; + else + error ("feather: invalid linespec"); + endif + else + error ("feather: unrecognized argument"); + endif + endwhile + + ## Matlab draws feather plots, with the arrow head as one continous + ## line, and each arrow separately. This is completely different than + ## quiver and quite ugly. + n = length (u); + xend = [1 : n] + u; + xtmp = [1 : n] + u .* (1 - arrowsize); + yend = v; + ytmp = v .* (1 - arrowsize); + x = [[1 : n]; xend; xtmp - v * arrowsize; xend; ... + xtmp + v * arrowsize]; + y = [zeros(1, n); yend; ytmp + u * arrowsize / 3; yend; ... + ytmp - u * arrowsize / 3]; + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + hlist = plot (h, x, y, line_spec, [1, n], [0, 0], line_spec); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + retval = hlist; + endif + +endfunction + + +%!demo +%! clf +%! phi = [0 : 15 : 360] * pi / 180; +%! feather (sin (phi), cos (phi)) + diff --git a/octave_packages/m/plot/figure.m b/octave_packages/m/plot/figure.m new file mode 100644 index 0000000..05cf304 --- /dev/null +++ b/octave_packages/m/plot/figure.m @@ -0,0 +1,102 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} figure (@var{n}) +## @deftypefnx {Function File} {} figure (@var{n}, @var{property}, @var{value}, @dots{}) +## Set the current plot window to plot window @var{n}. If no arguments are +## specified, the next available window number is chosen. +## +## Multiple property-value pairs may be specified for the figure, but they +## must appear in pairs. +## @end deftypefn + +## Author: jwe, Bill Denney + +function h = figure (varargin) + + nargs = nargin; + + f = NaN; + + init_new_figure = false; + if (mod (nargs, 2) == 1) + tmp = varargin{1}; + if (ishandle (tmp) && strcmp (get (tmp, "type"), "figure")) + f = tmp; + varargin(1) = []; + nargs--; + elseif (isnumeric (tmp) && tmp > 0 && tmp == fix (tmp)) + f = tmp; + init_new_figure = true; + varargin(1) = []; + nargs--; + else + error ("figure: expecting figure handle or figure number"); + endif + endif + + ## Check to see if we already have a figure on the screen. If we do, + ## then update it if it is different from the figure we are creating + ## or switching to. + cf = get (0, "currentfigure"); + if (! isempty (cf) && cf != 0) + if (isnan (f) || cf != f) + drawnow (); + endif + endif + + if (rem (nargs, 2) == 0) + if (isnan (f) || init_new_figure) + if (ismac () && strcmp (graphics_toolkit (), "fltk")) + ## FIXME - Hack for fltk-aqua to work around bug # 31931 + f = __go_figure__ (f); + drawnow (); + if (! isempty (varargin)) + set (f, varargin{:}); + endif + else + f = __go_figure__ (f, varargin{:}); + endif + elseif (nargs > 0) + set (f, varargin{:}); + endif + set (0, "currentfigure", f); + else + print_usage (); + endif + + cf = get (0, "currentfigure"); + if (strcmp (get (cf, "__graphics_toolkit__"), "fltk")) + __add_default_menu__ (cf); + endif + + if (nargout > 0) + h = f; + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (gcf, hf); +%! assert (isfigure (hf)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/fill.m b/octave_packages/m/plot/fill.m new file mode 100644 index 0000000..91caa3d --- /dev/null +++ b/octave_packages/m/plot/fill.m @@ -0,0 +1,131 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fill (@var{x}, @var{y}, @var{c}) +## @deftypefnx {Function File} {} fill (@var{x1}, @var{y1}, @var{c1}, @var{x2}, @var{y2}, @var{c2}) +## @deftypefnx {Function File} {} fill (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {} fill (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} fill (@dots{}) +## Create one or more filled patch objects. +## +## The optional return value @var{h} is an array of graphics handles to +## the created patch objects. +## @seealso{patch} +## @end deftypefn + +function retval = fill (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("fill", varargin{:}); + + htmp = []; + iargs = __find_patches__ (varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + + nextplot = get (h, "nextplot"); + for i = 1 : length (iargs) + if (i > 1 && strncmp (nextplot, "replace", 7)) + set (h, "nextplot", "add"); + endif + if (i == length (iargs)) + args = varargin (iargs(i):end); + else + args = varargin (iargs(i):iargs(i+1)-1); + endif + newplot (); + [tmp, fail] = __patch__ (h, args{:}); + if (fail) + print_usage(); + endif + htmp (end + 1) = tmp; + endfor + if (strncmp (nextplot, "replace", 7)) + set (h, "nextplot", nextplot); + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + retval = htmp; + endif + +endfunction + +function iargs = __find_patches__ (varargin) + iargs = []; + i = 1; + while (i < nargin) + iargs (end + 1) = i; + if (ischar (varargin{i}) + && (strcmpi (varargin{i}, "faces") + || strcmpi (varargin{i}, "vertices"))) + i += 4; + elseif (isnumeric (varargin{i})) + i += 2; + endif + + if (i <= nargin) + while (true); + if (ischar (varargin{i}) + && (strcmpi (varargin{i}, "faces") + || strcmpi (varargin{i}, "vertices"))) + break; + elseif (isnumeric (varargin{i})) + ## Assume its the colorspec + i++; + break; + elseif (ischar (varargin{i})) + colspec = tolower (varargin{i}); + collen = length (colspec); + + if (strncmp (colspec, "blue", collen) + || strncmp (colspec, "black", collen) + || strncmp (colspec, "k", collen) + || strncmp (colspec, "black", collen) + || strncmp (colspec, "red", collen) + || strncmp (colspec, "green", collen) + || strncmp (colspec, "yellow", collen) + || strncmp (colspec, "magenta", collen) + || strncmp (colspec, "cyan", collen) + || strncmp (colspec, "white", collen)) + i++; + break; + endif + else + i += 2; + endif + endwhile + endif + endwhile +endfunction + + +%!demo +%! clf +%! t1 = (1/16:1/8:1)*2*pi; +%! t2 = ((1/16:1/8:1) + 1/32)*2*pi; +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); +%! h = fill (x1,y1,'r', x2,y2,'g'); + diff --git a/octave_packages/m/plot/findall.m b/octave_packages/m/plot/findall.m new file mode 100644 index 0000000..dd80211 --- /dev/null +++ b/octave_packages/m/plot/findall.m @@ -0,0 +1,60 @@ +## Copyright (C) 2008-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} findall () +## @deftypefnx {Function File} {@var{h} =} findall (@var{prop_name}, @var{prop_value}) +## @deftypefnx {Function File} {@var{h} =} findall (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} findall (@var{h}, "-depth", @var{d}, @dots{}) +## Find graphics object with specified property values including hidden handles. +## +## This function performs the same function as @code{findobj}, but it +## includes hidden objects in its search. For full documentation, see +## @code{findobj}. +## @seealso{get, set, findobj, allchild} +## @end deftypefn + +## Author: Bill Denney + +function h = findall (varargin) + + unwind_protect + shh = get (0, "showhiddenhandles"); + set (0, "showhiddenhandles", "on"); + h = findobj (varargin{:}); + unwind_protect_cleanup + set (0, "showhiddenhandles", shh); + end_unwind_protect + +endfunction + + +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = findall (hf); +%! all_handles(1:13,1) = {"uimenu"}; +%! all_handles(14) = {"figure"}; +%! assert (get (h, "type"), all_handles); +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/findobj.m b/octave_packages/m/plot/findobj.m new file mode 100644 index 0000000..5019d4c --- /dev/null +++ b/octave_packages/m/plot/findobj.m @@ -0,0 +1,259 @@ +## Copyright (C) 2007-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} findobj () +## @deftypefnx {Function File} {@var{h} =} findobj (@var{prop_name}, @var{prop_value}) +## @deftypefnx {Function File} {@var{h} =} findobj ("-property", @var{prop_name}) +## @deftypefnx {Function File} {@var{h} =} findobj ("-regexp", @var{prop_name}, @var{pattern}) +## @deftypefnx {Function File} {@var{h} =} findobj ("flat", @dots{}) +## @deftypefnx {Function File} {@var{h} =} findobj (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} findobj (@var{h}, "-depth", @var{d}, @dots{}) +## Find graphics object with specified property values. The simplest form is +## +## @example +## findobj (@var{prop_name}, @var{prop_value}) +## @end example +## +## @noindent +## which returns all of the handles to the objects with the name +## @var{prop_name} and the name @var{prop_value}. The search can be limited +## to a particular object or set of objects and their descendants by +## passing a handle or set of handles @var{h} as the first argument to +## @code{findobj}. +## +## The depth of hierarchy of objects to which to search to can be limited +## with the "-depth" argument. To limit the number depth of the hierarchy +## to search to @var{d} generations of children, and example is +## +## @example +## findobj (@var{h}, "-depth", @var{d}, @var{prop_name}, @var{prop_value}) +## @end example +## +## Specifying a depth @var{d} of 0, limits the search to the set of object +## passed in @var{h}. A depth @var{d} of 0 is equivalent to the "-flat" +## argument. +## +## A specified logical operator may be applied to the pairs of @var{prop_name} +## and @var{prop_value}. The supported logical operators are "-and", "-or", +## "-xor", "-not". +## +## The objects may also be matched by comparing a regular expression to the +## property values, where property values that match @code{regexp +## (@var{prop_value}, @var{pattern})} are returned. Finally, objects may be +## matched by property name only, using the "-property" option. +## @seealso{get, set} +## @end deftypefn + +## Author: Ben Abbott + +function h = findobj (varargin) + + depth = NaN; + if (nargin == 0) + handles = 0; + n1 = 0; + else + if (! isempty (varargin{1})) + if (ishandle (varargin{1}(1))) + handles = varargin{1}; + n1 = 2; + else + handles = 0; + n1 = 1; + endif + else + ## Return [](0x1) for compatibility. + h = zeros (0, 1); + return; + endif + if (n1 <= nargin) + if (ischar (varargin{n1})) + if (strcmpi (varargin{n1}, "flat")) + depth = 0; + n1 = n1 + 1; + elseif (strcmpi (varargin{n1}, "-depth")) + depth = varargin{n1+1}; + n1 = n1 + 2; + endif + else + error ("findobj: properties and options must be strings"); + endif + endif + endif + + if (n1 <= nargin && nargin > 0) + args = varargin(n1 : nargin); + else + args = {}; + endif + + regularexpression = []; + property = []; + logicaloperator = {}; + pname = {}; + pvalue = {}; + np = 1; + na = 1; + + while (na <= numel (args)) + regularexpression(np) = 0; + property(np) = 0; + logicaloperator{np} = "and"; + if (ischar (args{na})) + if (strcmpi (args{na}, "-regexp")) + if (na + 2 <= numel (args)) + regularexpression(np) = 1; + na = na + 1; + pname{np} = args{na}; + na = na + 1; + pvalue{np} = args{na}; + na = na + 1; + np = np + 1; + else + error ("findobj: inconsistent number of arguments"); + endif + elseif (strcmpi (args{na}, "-property")) + if (na + 1 <= numel (args)) + na = na + 1; + property(np) = 1; + pname{np} = args{na}; + na = na + 1; + pvalue{np} = []; + np = np + 1; + else + error ("findobj: inconsistent number of arguments"); + endif + elseif (! strcmp (args{na}(1), "-")) + ## Parameter/value pairs. + if (na + 1 <= numel (args)) + pname{np} = args{na}; + na = na + 1; + pvalue{np} = args{na}; + na = na + 1; + if (na <= numel(args)) + if (ischar (args{na})) + if strcmpi(args{na}, "-and") + logicaloperator{np} = "and"; + na = na+1; + elseif strcmpi(args{na}, "-or") + logicaloperator{np} = "or"; + na = na+1; + elseif strcmpi(args{na}, "-xor") + logicaloperator{np} = "xor"; + na = na+1; + elseif strcmpi(args{na}, "-not") + logicaloperator{np} = "not"; + na = na+1; + endif + else + error ("findobj: properties and options must be strings"); + endif + else + logicaloperator{np} = "and"; + endif + np = np + 1; + else + error ("findobj: inconsistent number of arguments"); + endif + else + ## This is sloppy ... but works like Matlab. + if strcmpi(args{na}, "-not") + h = []; + return + endif + na = na + 1; + endif + else + error ("findobj: properties and options must be strings"); + endif + endwhile + + numpairs = np - 1; + + ## Load all objects which qualify for being searched. + idepth = 0; + h = handles; + while (numel (handles) && ! (idepth >= depth)) + children = []; + for n = 1 : numel (handles) + children = union (children, get(handles(n), "children")); + endfor + handles = children; + h = union (h, children); + idepth = idepth + 1; + endwhile + + keepers = ones (size (h)); + if (numpairs > 0) + for nh = 1 : numel(h) + p = get (h (nh)); + for np = 1 : numpairs + fields = fieldnames (p); + fieldindex = find (strcmpi (fields, pname{np}), 1); + if (numel (fieldindex)) + pname{np} = fields{fieldindex}; + if (property(np)) + match = 1; + else + if (regularexpression(np)) + match = regexp (p.(pname{np}), pvalue{np}); + if isempty (match) + match = 0; + endif + elseif (numel (p.(pname{np})) == numel (pvalue{np})) + if (ischar (pvalue{np})) + match = strcmpi (pvalue{np}, p.(pname{np})); + else + match = (pvalue{np} == p.(pname{np})); + endif + else + match = 0; + endif + match = all (match); + endif + if (strcmpi (logicaloperator{np}, "not")) + keepers(nh) = ! keepers(nh) & ! match; + else + keepers(nh) = feval (logicaloperator{np}, keepers(nh), match); + endif + else + keepers(nh) = 0; + endif + endfor + endfor + endif + + h = h (keepers != 0); + h = reshape (h, [numel(h), 1]); +endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! obj = findobj (hf, "type", "line"); +%! assert (l, obj); +%! assert (gca, findobj (hf, "type", "axes")); +%! assert (hf, findobj (hf, "type", "figure")); +%! assert (isempty (findobj (hf, "type", "xyzxyz"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/fplot.m b/octave_packages/m/plot/fplot.m new file mode 100644 index 0000000..2a2656c --- /dev/null +++ b/octave_packages/m/plot/fplot.m @@ -0,0 +1,136 @@ +## Copyright (C) 2005-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fplot (@var{fn}, @var{limits}) +## @deftypefnx {Function File} {} fplot (@var{fn}, @var{limits}, @var{tol}) +## @deftypefnx {Function File} {} fplot (@var{fn}, @var{limits}, @var{n}) +## @deftypefnx {Function File} {} fplot (@dots{}, @var{fmt}) +## Plot a function @var{fn} within defined limits. +## @var{fn} is a function handle, inline function, or string +## containing the name of the function to evaluate. +## The limits of the plot are given by @var{limits} of the form +## @code{[@var{xlo}, @var{xhi}]} or @code{[@var{xlo}, @var{xhi}, +## @var{ylo}, @var{yhi}]}. @var{tol} is the default tolerance to use for the +## plot, and if @var{tol} is an integer it is assumed that it defines the +## number points to use in the plot. The @var{fmt} argument is passed +## to the plot command. +## +## @example +## @group +## fplot ("cos", [0, 2*pi]) +## fplot ("[cos(x), sin(x)]", [0, 2*pi]) +## @end group +## @end example +## @seealso{plot} +## @end deftypefn + +## Author: Paul Kienzle + +function fplot (fn, limits, n, fmt) + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (!isreal (limits) || (numel (limits) != 2 && numel (limits) != 4)) + error ("fplot: second input argument must be a real vector with 2 or 4 elements"); + endif + + if (nargin < 3) + n = 0.002; + endif + + have_linespec = true; + if (nargin < 4) + have_linespec = false; + endif + + if (ischar (n)) + have_linespec = true; + fmt = n; + n = 0.002; + endif + + if (strcmp (typeinfo (fn), "inline function")) + fn = vectorize (fn); + nam = formula (fn); + elseif (isa (fn, "function_handle")) + nam = func2str (fn); + elseif (all (isalnum (fn))) + nam = fn; + elseif (ischar (fn)) + fn = vectorize (inline (fn)); + nam = formula (fn); + else + error ("fplot: first input argument must be a function handle, inline function or string"); + endif + + if (floor(n) != n) + tol = n; + x0 = linspace (limits(1), limits(2), 5)'; + y0 = feval (fn, x0); + err0 = Inf; + n = 8; + x = linspace (limits(1), limits(2), n)'; + y = feval (fn, x); + + while (n < 2 .^ 20) + y00 = interp1 (x0, y0, x, "linear"); + err = 0.5 * max (abs ((y00 - y) ./ (y00 + y))(:)); + if (err == err0 || 0.5 * max (abs ((y00 - y) ./ (y00 + y))(:)) < tol) + break; + endif + x0 = x; + y0 = y; + err0 = err; + n = 2 * (n - 1) + 1; + x = linspace (limits(1), limits(2), n)'; + y = feval (fn, x); + endwhile + else + x = linspace (limits(1), limits(2), n)'; + y = feval (fn, x); + endif + + if (have_linespec) + plot (x, y, fmt); + else + plot (x, y); + endif + + if (length (limits) > 2) + axis (limits); + endif + + if (isvector (y)) + legend (nam); + else + for i = 1:columns (y) + nams{i} = sprintf ("%s(:,%i)", nam, i); + endfor + legend (nams{:}); + endif +endfunction + +%!demo +%! clf +%! fplot ("cos", [0, 2*pi]) + +%!demo +%! clf +%! fplot ("[cos(x), sin(x)]", [0, 2*pi]) diff --git a/octave_packages/m/plot/gca.m b/octave_packages/m/plot/gca.m new file mode 100644 index 0000000..74e0e6a --- /dev/null +++ b/octave_packages/m/plot/gca.m @@ -0,0 +1,60 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gca () +## Return a handle to the current axis object. If no axis object +## exists, create one and return its handle. The handle may then be +## used to examine or set properties of the axes. For example, +## +## @example +## @group +## ax = gca (); +## set (ax, "position", [0.5, 0.5, 0.5, 0.5]); +## @end group +## @end example +## +## @noindent +## creates an empty axes object, then changes its location and size in +## the figure window. +## @seealso{get, set} +## @end deftypefn + +## Author: jwe + +function h = gca () + + if (nargin == 0) + h = get (gcf (), "currentaxes"); + if (isempty (h)) + h = axes (); + endif + else + print_usage (); + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! ax = axes; +%! unwind_protect +%! assert (gca, ax); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/gcbf.m b/octave_packages/m/plot/gcbf.m new file mode 100644 index 0000000..47ab905 --- /dev/null +++ b/octave_packages/m/plot/gcbf.m @@ -0,0 +1,36 @@ +## Copyright (C) 2008-2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{fig} =} gcbf () +## Return a handle to the figure containing the object whose callback +## is currently executing. If no callback is executing, this function +## returns the empty matrix. The handle returned by this function is +## the same as the second output argument of gcbo. +## +##@seealso{gcf, gca, gcbo} +##@end deftypefn + +function fig = gcbf () + + [dummy, fig] = gcbo (); + +endfunction + +%!test +%! assert (isempty (gcbf )); diff --git a/octave_packages/m/plot/gcbo.m b/octave_packages/m/plot/gcbo.m new file mode 100644 index 0000000..9113367 --- /dev/null +++ b/octave_packages/m/plot/gcbo.m @@ -0,0 +1,46 @@ +## Copyright (C) 2008-2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} gcbo () +## @deftypefnx {Function File} {[@var{h}, @var{fig}] =} gcbo () +## Return a handle to the object whose callback is currently +## executing. If no callback is executing, this function returns the +## empty matrix. This handle is obtained from the root object property +## "CallbackObject". +## +## Additionally return the handle of the figure containing the +## object whose callback is currently executing. If no callback is +## executing, the second output is also set to the empty matrix. +## +##@seealso{gcf, gca, gcbf} +##@end deftypefn + +function [h, fig] = gcbo () + + h = get (0, "callbackobject"); + fig = []; + + if (! isempty (h) && nargout > 1) + fig = ancestor (h, "figure"); + endif + +endfunction + +%!test +%! assert (isempty (gcbo )); diff --git a/octave_packages/m/plot/gcf.m b/octave_packages/m/plot/gcf.m new file mode 100644 index 0000000..292b649 --- /dev/null +++ b/octave_packages/m/plot/gcf.m @@ -0,0 +1,63 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gcf () +## Return the current figure handle. If a figure does not exist, create +## one and return its handle. The handle may then be used to examine or +## set properties of the figure. For example, +## +## @example +## @group +## fplot (@@sin, [-10, 10]); +## fig = gcf (); +## set (fig, "visible", "off"); +## @end group +## @end example +## +## @noindent +## plots a sine wave, finds the handle of the current figure, and then +## makes that figure invisible. Setting the visible property of the +## figure to @code{"on"} will cause it to be displayed again. +## @seealso{get, set} +## @end deftypefn + +## Author: jwe, Bill Denney + +function h = gcf () + + if (nargin == 0) + h = get (0, "currentfigure"); + if (isempty (h) || h == 0) + ## We only have a root figure object, so create a new figure + ## object and make it the current figure. + h = figure (1); + endif + else + print_usage (); + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (gcf, hf); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/ginput.m b/octave_packages/m/plot/ginput.m new file mode 100644 index 0000000..042fdc3 --- /dev/null +++ b/octave_packages/m/plot/ginput.m @@ -0,0 +1,48 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{y}, @var{buttons}] =} ginput (@var{n}) +## Return which mouse buttons were pressed and keys were hit on the current +## figure. If @var{n} is defined, then wait for @var{n} mouse clicks +## before returning. If @var{n} is not defined, then @code{ginput} will +## loop until the return key @key{RET} is pressed. +## @end deftypefn + +function varargout = ginput (n) + + if (nargin > 1) + print_usage (); + endif + + f = gcf (); + drawnow (); + toolkit = (get (f, "__graphics_toolkit__")); + + varargout = cell (1, nargout); + if (nargin == 0) + [varargout{:}] = feval (strcat ("__", toolkit, "_ginput__"), f); + else + [varargout{:}] = feval (strcat ("__", toolkit, "_ginput__"), f, n); + endif + +endfunction + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1); diff --git a/octave_packages/m/plot/gnuplot_binary.m b/octave_packages/m/plot/gnuplot_binary.m new file mode 100644 index 0000000..ce3bcb9 --- /dev/null +++ b/octave_packages/m/plot/gnuplot_binary.m @@ -0,0 +1,61 @@ +## Copyright (C) 2008-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {[@var{prog}, @var{args}] =} gnuplot_binary () +## @deftypefnx {Loadable Function} {[@var{old_prog}, @var{old_args}] =} gnuplot_binary (@var{new_prog}, @var{arg1}, @dots{}) +## Query or set the name of the program invoked by the plot command +## when the graphics toolkit is set to "gnuplot". Additional arguments to +## pass to the external plotting program may also be given. +## The default value is @code{"gnuplot"} without additional arguments. +## @xref{Installation}. +## @end deftypefn + +## Author: jwe + +function [prog, args] = gnuplot_binary (new_prog, varargin) + + persistent gp_binary = "gnuplot"; + persistent gp_args = {}; + + if (nargout > 0 || nargin == 0) + prog = gp_binary; + args = gp_args; + endif + + if (nargin == 1) + if (ischar (new_prog)) + if (! isempty (new_prog)) + gp_binary = new_prog; + else + error ("gnuplot_binary: value must not be empty"); + endif + else + error ("gnuplot_binary: expecting program to be a character string"); + endif + endif + + if (nargin > 1) + if (iscellstr (varargin)) + gp_args = varargin; + else + error ("gnuplot_binary: expecting arguments to be character strings"); + endif + endif + +endfunction diff --git a/octave_packages/m/plot/graphics_toolkit.m b/octave_packages/m/plot/graphics_toolkit.m new file mode 100644 index 0000000..bbb4b5c --- /dev/null +++ b/octave_packages/m/plot/graphics_toolkit.m @@ -0,0 +1,95 @@ +## Copyright (C) 2008-2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{name} =} graphics_toolkit () +## @deftypefnx {Function File} {@var{old_name} =} graphics_toolkit (@var{name}) +## @deftypefnx {Function File} {} graphics_toolkit (@var{hlist}, @var{name}) +## Query or set the default graphics toolkit to @var{name}. If the +## toolkit is not already loaded, it is first initialized by calling the +## function @code{__init_@var{name}__}. +## +## When called with a list of figure handles, @var{hlist}, the graphics +## toolkit is changed only for the listed figures. +## @seealso{available_graphics_toolkits} +## @end deftypefn + +function retval = graphics_toolkit (name, hlist = []) + + if (nargin > 2) + print_usage (); + endif + + if (nargout > 0 || nargin == 0) + retval = get (0, "defaultfigure__graphics_toolkit__"); + endif + + if (nargin == 0) + return; + elseif (nargin == 1) + if (! ischar (name)) + error ("graphics_toolkit: invalid graphics toolkit NAME"); + endif + elseif (nargin == 2) + ## Swap input arguments + [hlist, name] = deal (name, hlist); + if (! all (isfigure (hlist))) + error ("graphics_toolkit: invalid figure handle list HLIST"); + elseif (! ischar (name)) + error ("graphics_toolkit: invalid graphics toolkit NAME"); + endif + endif + + if (! any (strcmp (loaded_graphics_toolkits (), name))) + feval (["__init_", name, "__"]); + if (! any (strcmp (loaded_graphics_toolkits (), name))) + error ("graphics_toolkit: %s toolkit was not correctly loaded", name); + endif + endif + + if (isempty (hlist)) + set (0, "defaultfigure__graphics_toolkit__", name); + else + set (hlist, "__graphics_toolkit__", name); + endif + +endfunction + + +%!testif HAVE_FLTK +%! unwind_protect +%! hf = figure ("visible", "off"); +%! toolkit = graphics_toolkit (); +%! assert (get (0, "defaultfigure__graphics_toolkit__"), toolkit); +%! graphics_toolkit (hf, "fltk"); +%! assert (get (hf, "__graphics_toolkit__"), "fltk"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!testif HAVE_FLTK +%! old_toolkit = graphics_toolkit (); +%! switch old_toolkit +%! case {"gnuplot"} +%! new_toolkit = "fltk"; +%! otherwise +%! new_toolkit = "gnuplot"; +%! endswitch +%! assert (graphics_toolkit (new_toolkit), old_toolkit) +%! assert (graphics_toolkit (old_toolkit), new_toolkit) + diff --git a/octave_packages/m/plot/grid.m b/octave_packages/m/plot/grid.m new file mode 100644 index 0000000..f4cebf9 --- /dev/null +++ b/octave_packages/m/plot/grid.m @@ -0,0 +1,121 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} grid (@var{arg}) +## @deftypefnx {Function File} {} grid ("minor", @var{arg2}) +## @deftypefnx {Function File} {} grid (@var{hax}, @dots{}) +## Force the display of a grid on the plot. +## The argument may be either @code{"on"}, or @code{"off"}. +## If it is omitted, the current grid state is toggled. +## +## If @var{arg} is @code{"minor"} then the minor grid is toggled. When +## using a minor grid a second argument @var{arg2} is allowed, which can +## be either @code{"on"} or @code{"off"} to explicitly set the state of +## the minor grid. +## +## If the first argument is an axis handle, @var{hax}, operate on the +## specified axis object. +## @seealso{plot} +## @end deftypefn + +## Author: jwe + +function grid (varargin) + + [ax, varargin, nargs] = __plt_get_axis_arg__ ("grid", varargin{:}); + + grid_on = (strcmp (get (ax, "xgrid"), "on") + && strcmp (get (ax, "ygrid"), "on") + && strcmp (get (ax, "zgrid"), "on")); + + minor_on = (strcmp (get (ax, "xminorgrid"), "on") + && strcmp (get (ax, "yminorgrid"), "on") + && strcmp (get (ax, "zminorgrid"), "on")); + + if (nargs > 2) + print_usage (); + elseif (nargs == 0) + grid_on = ! grid_on; + else + x = varargin{1}; + if (ischar (x)) + if (strcmpi (x, "off")) + grid_on = false; + elseif (strcmpi (x, "on")) + grid_on = true; + elseif (strcmpi (x, "minor")) + if (nargs == 2) + x2 = varargin{2}; + if (strcmpi (x2, "on")) + minor_on = true; + grid_on = true; + elseif (strcmpi (x2, "off")) + minor_on = false; + else + print_usage (); + endif + else + minor_on = ! minor_on; + if (minor_on) + grid_on = true; + endif + endif + else + print_usage (); + endif + else + error ("grid: argument must be a string"); + endif + endif + + if (grid_on) + set (ax, "xgrid", "on", "ygrid", "on", "zgrid", "on"); + if (minor_on) + set (ax, "xminorgrid", "on", "yminorgrid", "on", "zminorgrid", "on"); + else + set (ax, "xminorgrid", "off", "yminorgrid", "off", "zminorgrid", "off"); + endif + else + set (ax, "xgrid", "off", "ygrid", "off", "zgrid", "off"); + set (ax, "xminorgrid", "off", "yminorgrid", "off", "zminorgrid", "off"); + endif + +endfunction + +%!demo +%! clf +%! subplot (2,2,1) +%! plot (1:100) +%! grid minor +%! grid minor +%! grid +%! title ("no grid") +%! subplot (2,2,2) +%! plot (1:100) +%! grid +%! title ("grid on") +%! subplot (2,2,3) +%! plot (1:100) +%! grid minor +%! title ("grid minor") +%! subplot (2,2,4) +%! semilogy (1:100) +%! grid minor +%! title ("grid minor") + diff --git a/octave_packages/m/plot/gtext.m b/octave_packages/m/plot/gtext.m new file mode 100644 index 0000000..acbb1b3 --- /dev/null +++ b/octave_packages/m/plot/gtext.m @@ -0,0 +1,49 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gtext (@var{s}) +## @deftypefnx {Function File} {} gtext (@{@var{s1}; @var{s2}; @dots{}@}) +## @deftypefnx {Function File} {} gtext (@dots{}, @var{prop}, @var{val}) +## Place text on the current figure using the mouse. The text is defined +## by the string @var{s}. If @var{s} is a cell array, each element of the cell +## array is written to a separate line. Additional arguments are passed to +## the underlying text object as properties. +## @seealso{ginput, text} +## @end deftypefn + +function gtext (s, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (! (ischar (s) || iscellstr (s))) + error ("gtext: S must be a string or cell array of strings"); + endif + + if (! isempty (s)) + [x, y] = ginput (1); + text (x, y, s, varargin{:}); + endif + +endfunction + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1); diff --git a/octave_packages/m/plot/guidata.m b/octave_packages/m/plot/guidata.m new file mode 100644 index 0000000..560a709 --- /dev/null +++ b/octave_packages/m/plot/guidata.m @@ -0,0 +1,52 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{data} =} guidata (@var{handle}) +## @deftypefnx {Function File} {} guidata (@var{handle}, @var{data}) +## @end deftypefn + +## Author: goffioul + +function varargout = guidata (varargin) + + if (nargin == 1 || nargin == 2) + h = varargin{1}; + if (ishandle (h)) + h = ancestor (h, "figure"); + if (! isempty (h)) + if (nargin == 1) + varargout{1} = get (h, "__guidata__"); + else + data = varargin{2}; + set (h, "__guidata__", data); + if (nargout == 1) + varargout{1} = data; + endif + endif + else + error ("no ancestor figure found"); + endif + else + error ("invalid object handle"); + endif + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/plot/guihandles.m b/octave_packages/m/plot/guihandles.m new file mode 100644 index 0000000..80a0c86 --- /dev/null +++ b/octave_packages/m/plot/guihandles.m @@ -0,0 +1,70 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hdata} =} guihandles (@var{handle}) +## @deftypefnx {Function File} {@var{hdata} =} guihandles +## @end deftypefn + +## Author: goffioul + +function hdata = guihandles (varargin) + + hdata = []; + + if (nargin == 0 || nargin == 1) + if (nargin == 1) + h = varargin{1}; + if (ishandle (h)) + h = ancestor (h, "figure"); + if (isempty (h)) + error ("no ancestor figure found"); + endif + else + error ("invalid object handle"); + endif + else + h = gcf (); + endif + hdata = __make_guihandles_struct__ (h, hdata); + else + print_usage (); + endif + +endfunction + +function hdata = __make_guihandles_struct__ (h, hdata) + + tag = get (h, "tag"); + if (! isempty (tag)) + if (isfield (hdata, tag)) + hdata.(tag) = [hdata.(tag), h]; + else + try + hdata.(tag) = h; + catch + end_try_catch + endif + endif + + kids = allchild (h); + for i = 1 : length (kids) + hdata = __make_guihandles_struct__ (kids(i), hdata); + endfor + +endfunction diff --git a/octave_packages/m/plot/hggroup.m b/octave_packages/m/plot/hggroup.m new file mode 100644 index 0000000..c29b42a --- /dev/null +++ b/octave_packages/m/plot/hggroup.m @@ -0,0 +1,53 @@ +## Copyright (C) 2008-2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hggroup () +## @deftypefnx {Function File} {} hggroup (@var{h}) +## @deftypefnx {Function File} {} hggroup (@dots{}, @var{property}, @var{value}, @dots{}) +## Create group object with parent @var{h}. If no parent is specified, +## the group is created in the current axes. Return the handle of the +## group object created. +## +## Multiple property-value pairs may be specified for the group, but they +## must appear in pairs. +## @end deftypefn + +## Author: goffioul + +function h = hggroup (varargin) + + [ax, varargin] = __plt_get_axis_arg__ ("hggroup", varargin{:}); + + tmp = __go_hggroup__ (ax, varargin{:}); + + if (nargout > 0) + h = tmp; + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = hggroup; +%! assert (findobj (hf, "type", "hggroup"), h); +%! assert (get (h, "type"), "hggroup"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/hidden.m b/octave_packages/m/plot/hidden.m new file mode 100644 index 0000000..a476b95 --- /dev/null +++ b/octave_packages/m/plot/hidden.m @@ -0,0 +1,77 @@ +## Copyright (C) 2007-2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hidden (@var{mode}) +## @deftypefnx {Function File} {} hidden () +## Manipulation the mesh hidden line removal. Called with no argument +## the hidden line removal is toggled. The argument @var{mode} can be either +## 'on' or 'off' and the set of the hidden line removal is set accordingly. +## @seealso{mesh, meshc, surf} +## @end deftypefn + +function retval = hidden (mode) + + if (nargin == 0) + mode = "swap"; + elseif (nargin == 1); + if (ischar (mode)) + mode = tolower (mode); + if (! strcmp (mode, "on") && ! strcmp (mode, "off")) + error ("hidden: MODE expected to be 'on' or 'off'"); + endif + else + error ("hidden: expecting MODE to be a string"); + endif + else + print_usage (); + endif + + for h = get (gca (), "children"); + htype = lower (get (h, "type")); + if (strcmp (htype, "surface")) + fc = get (h, "facecolor"); + if ((! ischar (fc) && is_white (fc)) + || (ischar (fc) && strcmpi (fc, "none"))) + switch (mode) + case "on" + set (h, "facecolor", "w"); + case "off" + set (h, "facecolor", "none"); + case "swap" + if (ischar (fc)) + set (h, "facecolor", "w"); + mode = "on"; + else + set (h, "facecolor", "none"); + mode = "off"; + endif + endswitch + endif + endif + endfor + + if (nargout > 0) + retval = mode; + endif + +endfunction + +function retval = is_white (color) + retval = all (color == 1); +endfunction diff --git a/octave_packages/m/plot/hist.m b/octave_packages/m/plot/hist.m new file mode 100644 index 0000000..8c9114f --- /dev/null +++ b/octave_packages/m/plot/hist.m @@ -0,0 +1,197 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hist (@var{y}) +## @deftypefnx {Function File} {} hist (@var{y}, @var{x}) +## @deftypefnx {Function File} {} hist (@var{y}, @var{nbins}) +## @deftypefnx {Function File} {} hist (@var{y}, @var{x}, @var{norm}) +## @deftypefnx {Function File} {[@var{nn}, @var{xx}] =} hist (@dots{}) +## @deftypefnx {Function File} {[@dots{}] =} hist (@dots{}, @var{prop}, @var{val}) +## +## Produce histogram counts or plots. +## +## With one vector input argument, @var{y}, plot a histogram of the values +## with 10 bins. The range of the histogram bins is determined by the +## range of the data. With one matrix input argument, @var{y}, plot a +## histogram where each bin contains a bar per input column. +## +## Given a second vector argument, @var{x}, use that as the centers of +## the bins, with the width of the bins determined from the adjacent +## values in the vector. +## +## If scalar, the second argument, @var{nbins}, defines the number of bins. +## +## If a third argument is provided, the histogram is normalized such that +## the sum of the bars is equal to @var{norm}. +## +## Extreme values are lumped in the first and last bins. +## +## With two output arguments, produce the values @var{nn} and @var{xx} such +## that @code{bar (@var{xx}, @var{nn})} will plot the histogram. +## +## The histogram's appearance may be modified by specifying property/value +## pairs, @var{prop} and @var{val} pairs. For example the face and edge +## color may be modified. +## +## @example +## @group +## hist (randn (1, 100), 25, "facecolor", "r", "edgecolor", "b"); +## @end group +## @end example +## +## @noindent +## The histograms colors also depend upon the colormap. +## +## @example +## @group +## hist (rand (10, 3)); +## colormap (summer ()); +## @end group +## @end example +## +## @seealso{bar} +## @end deftypefn + +## Author: jwe + +function [nn, xx] = hist (y, varargin) + + if (nargin < 1) + print_usage (); + endif + + arg_is_vector = isvector (y); + + if (rows (y) == 1) + y = y(:); + endif + + if (isreal (y)) + max_val = max (y(:)); + min_val = min (y(:)); + else + error ("hist: first argument must be real valued"); + endif + + iarg = 1; + if (nargin == 1 || ischar (varargin{iarg})) + n = 10; + x = [0.5:n]'/n; + x = x * (max_val - min_val) + ones(size(x)) * min_val; + else + ## nargin is either 2 or 3 + x = varargin{iarg++}; + if (isscalar (x)) + n = x; + if (n <= 0) + error ("hist: number of bins must be positive"); + endif + x = [0.5:n]'/n; + x = x * (max_val - min_val) + ones (size (x)) * min_val; + elseif (isreal (x)) + if (isvector (x)) + x = x(:); + endif + tmp = sort (x); + if (any (tmp != x)) + warning ("hist: bin values not sorted on input"); + x = tmp; + endif + else + error ("hist: second argument must be a scalar or a vector"); + endif + endif + + ## Avoid issues with integer types for x and y + x = double (x); + y = double (y); + + cutoff = (x(1:end-1,:) + x(2:end,:)) / 2; + n = rows (x); + y_nc = columns (y); + if (n < 30 && columns (x) == 1) + ## The following algorithm works fastest for n less than about 30. + chist = zeros (n+1, y_nc); + for i = 1:n-1 + chist(i+1,:) = sum (y <= cutoff(i)); + endfor + chist(n+1,:) = sum (! isnan (y)); + else + ## The following algorithm works fastest for n greater than about 30. + ## Put cutoff elements between boundaries, integrate over all + ## elements, keep totals at boundaries. + [s, idx] = sort ([y; repmat(cutoff, 1, y_nc)]); + len = rows (y); + chist = cumsum (idx <= len); + chist = [(zeros (1, y_nc)); + (reshape (chist(idx > len), rows (cutoff), y_nc)); + (chist(end,:) - sum (isnan (y)))]; + endif + + freq = diff (chist); + + if (nargin > 2 && ! ischar (varargin{iarg})) + ## Normalise the histogram. + norm = varargin{iarg++}; + freq = freq / rows (y) * norm; + endif + + if (nargout > 0) + if (arg_is_vector) + nn = freq'; + xx = x'; + else + nn = freq; + xx = x; + endif + elseif (size (freq, 2) != 1) + bar (x, freq, 0.8, varargin{iarg:end}); + else + bar (x, freq, 1.0, varargin{iarg:end}); + endif + +endfunction + +%!test +%! [nn,xx]=hist([1:4],3); +%! assert(xx, [1.5,2.5,3.5]); +%! assert(nn, [2,1,1]); +%!test +%! [nn,xx]=hist([1:4]',3); +%! assert(xx, [1.5,2.5,3.5]); +%! assert(nn, [2,1,1]); +%!test +%! [nn,xx]=hist([1 1 1 NaN NaN NaN 2 2 3],[1 2 3]); +%! assert(xx, [1,2,3]); +%! assert(nn, [3,2,1]); +%!test +%! [nn,xx]=hist([[1:4]',[1:4]'],3); +%! assert(xx, [1.5;2.5;3.5]); +%! assert(nn, [[2,1,1]',[2,1,1]']); +%!assert(hist(1,1),1); +%!test +%! for n = [10, 30, 100, 1000] +%! assert(sum(hist([1:n], n)), n); +%! assert(sum(hist([1:n], [2:n-1])), n); +%! assert(sum(hist([1:n], [1:n])), n); +%! assert(sum(hist([1:n], 29)), n); +%! assert(sum(hist([1:n], 30)), n); +%! endfor +%!test +%! assert (size (hist(randn(750,240), 200)), [200,240]); diff --git a/octave_packages/m/plot/hold.m b/octave_packages/m/plot/hold.m new file mode 100644 index 0000000..2cb6969 --- /dev/null +++ b/octave_packages/m/plot/hold.m @@ -0,0 +1,173 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} hold +## @deftypefnx {Command} {} hold @var{state} +## @deftypefnx {Function File} {} hold (@var{hax}, @dots{}) +## Toggle or set the 'hold' state of the plotting engine which determines +## whether new graphic objects are added to the plot or replace the existing +## objects. +## +## @table @code +## @item hold on +## Retain plot data and settings so that subsequent plot commands are displayed +## on a single graph. +## +## @item hold all +## Retain plot line color, line style, data and settings so that subsequent +## plot commands are displayed on a single graph with the next line color and +## style. +## +## @item hold off +## Clear plot and restore default graphics settings before each new plot +## command. (default). +## +## @item hold +## Toggle the current 'hold' state. +## @end table +## +## When given the additional argument @var{hax}, the hold state is modified +## only for the given axis handle. +## +## To query the current 'hold' state use the @code{ishold} function. +## @seealso{ishold, cla, newplot, clf} +## @end deftypefn + +function hold (varargin) + + if (nargin > 0 && numel (varargin{1}) == 1 && ishandle (varargin{1}) + && strcmp (get (varargin{1}, "type"), "axes")) + [ax, varargin, nargs] = __plt_get_axis_arg__ ("hold", varargin{:}); + fig = get (ax, "parent"); + elseif (nargin > 0 && numel (varargin{1}) > 1 && ishandle (varargin{1})) + print_usage (); + else + ax = gca (); + fig = gcf (); + nargs = numel (varargin); + endif + + hold_all = false; + if (nargs == 0) + turn_hold_off = ishold (ax); + elseif (nargs == 1) + state = varargin{1}; + if (ischar (state)) + if (strcmpi (state, "off")) + turn_hold_off = true; + elseif (strcmpi (state, "all")) + turn_hold_off = false; + hold_all = true; + elseif (strcmpi (state, "on")) + turn_hold_off = false; + else + error ("hold: invalid hold STATE"); + endif + endif + else + print_usage (); + endif + + if (turn_hold_off) + set (ax, "nextplot", "replace"); + else + set (ax, "nextplot", "add"); + set (fig, "nextplot", "add"); + endif + set (ax, "__hold_all__", hold_all); + +endfunction + +%!demo +%! clf +%! A = rand (100); +%! [X, Y] = find (A > 0.9); +%! imshow (A) +%! hold on +%! plot (X, Y, 'o') +%! hold off + +%!demo +%! clf +%! hold on +%! imagesc(1./hilb(4)); +%! plot (1:4, "-s") +%! hold off + +%!demo +%! clf +%! hold on +%! imagesc(1./hilb(2)); +%! imagesc(1./hilb(4)); +%! hold off + +%!demo +%! clf +%! hold on +%! plot (1:4, "-s") +%! imagesc(1./hilb(4)); +%! hold off + +%!demo +%! clf +%! colormap (jet) +%! t = linspace (-3, 3, 50); +%! [x, y] = meshgrid (t, t); +%! z = peaks (x, y); +%! contourf (x, y, z, 10); +%! hold ("on"); +%! plot (vec (x), vec (y), "^"); +%! patch ([-1.0 1.0 1.0 -1.0 -1.0], [-1.0 -1.0 1.0 1.0 -1.0], "red"); +%! xlim ([-2.0 2.0]); +%! ylim ([-2.0 2.0]); +%! colorbar ("SouthOutside"); +%! title ("Test script for some plot functions"); + +##hold on +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0 1]); +%! assert (!ishold); +%! hold on; +%! assert (ishold); +%! p1 = fill ([0 1 1], [0 0 1],"black"); +%! p2 = fill ([0 1 0], [0 1 1], "red"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 3); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +##hold off +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0 1]); +%! assert (!ishold); +%! hold on; +%! assert (ishold); +%! p1 = fill ([0 1 1], [0 0 1],"black"); +%! hold off +%! p2 = fill ([0 1 0], [0 1 1], "red"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 1); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/isfigure.m b/octave_packages/m/plot/isfigure.m new file mode 100644 index 0000000..db62b71 --- /dev/null +++ b/octave_packages/m/plot/isfigure.m @@ -0,0 +1,45 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isfigure (@var{h}) +## Return true if @var{h} is a graphics handle that contains a figure +## object. +## @seealso{ishandle} +## @end deftypefn + +## Author: jwe + +function retval = isfigure (h) + + if (nargin == 1) + retval = (ishandle (h) && strcmp (get (h, "type"), "figure")); + else + print_usage (); + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (isfigure (hf)); +%! assert (!isfigure (-hf)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/ishghandle.m b/octave_packages/m/plot/ishghandle.m new file mode 100644 index 0000000..3790547 --- /dev/null +++ b/octave_packages/m/plot/ishghandle.m @@ -0,0 +1,59 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ishghandle (@var{h}) +## Return true if @var{h} is a graphics handle and false otherwise. +## @end deftypefn + +function retval = ishghandle (h) + ## This function is just included for compatibility as Octave has + ## no simulink equivalent. + retval = ishandle (h); +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (ishghandle (hf)); +%! assert (!ishghandle (-hf)); +%! l = line; +%! ax = gca(); +%! assert (ishghandle (ax)); +%! assert (!ishghandle (-ax)); +%! assert (ishghandle (l)); +%! assert (!ishghandle (-l)); +%! p = patch; +%! assert (ishghandle (p)); +%! assert (!ishghandle (-p)); +%! s = surface; +%! assert (ishghandle (s)); +%! assert (!ishghandle (-s)); +%! t = text; +%! assert (ishghandle (t)); +%! assert (!ishghandle (-t)); +%! i = image; +%! assert (ishghandle (i)); +%! assert (!ishghandle (-i)); +%! hg = hggroup; +%! assert (ishghandle (hg)); +%! assert (!ishghandle (-hg)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/ishold.m b/octave_packages/m/plot/ishold.m new file mode 100644 index 0000000..ea08bd4 --- /dev/null +++ b/octave_packages/m/plot/ishold.m @@ -0,0 +1,79 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} ishold +## @deftypefnx {Function File} {} ishold (@var{h}) +## Return true if the next plot will be added to the current plot, or +## false if the plot device will be cleared before drawing the next plot. +## +## Optionally, operate on the graphics handle @var{h} rather than the current +## plot. +## @seealso{hold} +## @end deftypefn + +function retval = ishold (h) + + if (nargin == 0) + fig = gcf (); + ax = get (fig, "currentaxes"); + elseif (nargin == 1) + if (ishandle (h)) + if (isfigure (h)) + ax = get (h, "currentaxes"); + fig = h; + elseif (strcmpi (get (h, "type"), "axes")) + ax = h; + fig = get (h, "parent"); + else + error ("ishold: expecting argument to be axes or figure graphics handle"); + endif + else + error ("ishold: expecting argument to be axes or figure graphics handle"); + endif + else + print_usage (); + endif + + retval = (strcmpi (get (fig, "nextplot"), "add") + && ! isempty (ax) && strcmpi (get (ax, "nextplot"), "add")); + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! assert (!ishold); +%! assert (isempty (get (hf, "currentaxes"))); +%! assert (get (hf, "NextPlot"), "add"); +%! l = plot ([0 1]); +%! assert (!ishold); +%! assert (!ishold (gca)); +%! assert (get (gca, "NextPlot"), "replace"); +%! assert (get (hf, "NextPlot"), "add"); +%! hold; +%! assert (ishold); +%! assert (ishold (gca)); +%! assert (get (gca, "NextPlot"), "add"); +%! assert (get (hf, "NextPlot"), "add"); +%! p = fill ([0 1 1], [0 0 1],"black"); +%! assert (length (get (hf, "children")), 1); +%! assert (length (get (gca, "children")), 2); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/isocolors.m b/octave_packages/m/plot/isocolors.m new file mode 100644 index 0000000..ad33e76 --- /dev/null +++ b/octave_packages/m/plot/isocolors.m @@ -0,0 +1,172 @@ +## Copyright (C) 2009-2012 Martin Helm +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{cd}] =} isocolors (@var{c}, @var{v}) +## @deftypefnx {Function File} {[@var{cd}] =} isocolors (@var{x}, @var{y}, @var{z}, @var{c}, @var{v}) +## @deftypefnx {Function File} {[@var{cd}] =} isocolors (@var{x}, @var{y}, @var{z}, @var{r}, @var{g}, @var{b}, @var{v}) +## @deftypefnx {Function File} {[@var{cd}] =} isocolors (@var{r}, @var{g}, @var{b}, @var{v}) +## @deftypefnx {Function File} {[@var{cd}] =} isocolors (@dots{}, @var{p}) +## @deftypefnx {Function File} {} isocolors (@dots{}) +## +## If called with one output argument and the first input argument +## @var{c} is a three-dimensional array that contains color values and +## the second input argument @var{v} keeps the vertices of a geometry +## then return a matrix @var{cd} with color data information for the +## geometry at computed points +## @command{[x, y, z] = meshgrid (1:l, 1:m, 1:n)}. The output argument +## @var{cd} can be taken to manually set FaceVertexCData of a patch. +## +## If called with further input arguments @var{x}, @var{y} and @var{z} +## which are three--dimensional arrays of the same size than @var{c} +## then the color data is taken at those given points. Instead of the +## color data @var{c} this function can also be called with RGB values +## @var{r}, @var{g}, @var{b}. If input argumnets @var{x}, @var{y}, +## @var{z} are not given then again @command{meshgrid} computed values +## are taken. +## +## Optionally, the patch handle @var{p} can be given as the last input +## argument to all variations of function calls instead of the vertices +## data @var{v}. Finally, if no output argument is given then directly +## change the colors of a patch that is given by the patch handle +## @var{p}. +## +## For example: +## +## @example +## function [] = isofinish (p) +## set (gca, "PlotBoxAspectRatioMode", "manual", ... +## "PlotBoxAspectRatio", [1 1 1]); +## set (p, "FaceColor", "interp"); +## ## set (p, "FaceLighting", "flat"); +## ## light ("Position", [1 1 5]); ## Available with JHandles +## endfunction +## +## N = 15; # Increase number of vertices in each direction +## iso = .4; # Change isovalue to .1 to display a sphere +## lin = linspace (0, 2, N); +## [x, y, z] = meshgrid (lin, lin, lin); +## c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); +## figure (); # Open another figure window +## +## subplot (2,2,1); view (-38, 20); +## [f, v] = isosurface (x, y, z, c, iso); +## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "none"); +## cdat = rand (size (c)); # Compute random patch color data +## isocolors (x, y, z, cdat, p); # Directly set colors of patch +## isofinish (p); # Call user function isofinish +## +## subplot (2,2,2); view (-38, 20); +## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "none"); +## [r, g, b] = meshgrid (lin, 2-lin, 2-lin); +## cdat = isocolors (x, y, z, c, v); # Compute color data vertices +## set (p, "FaceVertexCData", cdat); # Set color data manually +## isofinish (p); +## +## subplot (2,2,3); view (-38, 20); +## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "none"); +## cdat = isocolors (r, g, b, c, p); # Compute color data patch +## set (p, "FaceVertexCData", cdat); # Set color data manually +## isofinish (p); +## +## subplot (2,2,4); view (-38, 20); +## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "none"); +## r = g = b = repmat ([1:N] / N, [N, 1, N]); # Black to white +## cdat = isocolors (x, y, z, r, g, b, v); +## set (p, "FaceVertexCData", cdat); +## isofinish (p); +## @end example +## +## @seealso{isosurface, isonormals} +## +## @end deftypefn + +## Author: Martin Helm + +function varargout = isocolors(varargin) + calc_rgb = false; + switch (nargin) + case 2 + c = varargin{1}; + vp = varargin{2}; + x = 1:size (c, 2); + y = 1:size (c, 1); + z = 1:size (c, 3); + case 4 + calc_rgb = true; + R = varargin{1}; + G = varargin{2}; + B = varargin{3}; + vp = varargin{4}; + x = 1:size (R, 1); + y = 1:size (R, 2); + z = 1:size (R, 3); + case 5 + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + c = varargin{4}; + vp = varargin{5}; + case 7 + calc_rgb = true; + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + R = varargin{4}; + G = varargin{5}; + B = varargin{6}; + vp = varargin{7}; + otherwise + print_usage (); + endswitch + if (ismatrix (vp) && size (vp,2) == 3) + pa = []; + v = vp; + elseif ( ishandle (vp) ) + pa = vp; + v = get (pa, "Vertices"); + else + error ("isocolors: last argument is not a vertex list or patch handle"); + endif + if (calc_rgb) + new_col = zeros (size (v, 1), 3); + new_col(:,1) = __interp_cube__ (x, y, z, R, v, "values" ); + new_col(:,2) = __interp_cube__ (x, y, z, G, v, "values" ); + new_col(:,3) = __interp_cube__ (x, y, z, B, v, "values" ); + else + new_col = __interp_cube__ (x, y, z, c, v, "values" ); + endif + switch (nargout) + case 0 + if (!isempty (pa)) + set (pa, "FaceVertexCData", new_col); + endif + case 1 + varargout = {new_col}; + otherwise + print_usage (); + endswitch +endfunction + +%!test +%! [x, y, z] = meshgrid (0:.5:2, 0:.5:2, 0:.5:2); +%! c = (x-.5).^2 + (y-.5).^2 + (z-.5).^2; +%! [f, v] = isosurface (x, y, z, c, .4); +%! cdat = isocolors (x, y, z, c, v); +%! assert (size (cdat, 1) == size (v, 1)); +## Can't create a patch handle for tests without a figure diff --git a/octave_packages/m/plot/isonormals.m b/octave_packages/m/plot/isonormals.m new file mode 100644 index 0000000..d837eb3 --- /dev/null +++ b/octave_packages/m/plot/isonormals.m @@ -0,0 +1,163 @@ +## Copyright (C) 2009-2012 Martin Helm +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{n}] =} isonormals (@var{val}, @var{v}) +## @deftypefnx {Function File} {[@var{n}] =} isonormals (@var{val}, @var{p}) +## @deftypefnx {Function File} {[@var{n}] =} isonormals (@var{x}, @var{y}, @var{z}, @var{val}, @var{v}) +## @deftypefnx {Function File} {[@var{n}] =} isonormals (@var{x}, @var{y}, @var{z}, @var{val}, @var{p}) +## @deftypefnx {Function File} {[@var{n}] =} isonormals (@dots{}, "negate") +## @deftypefnx {Function File} {} isonormals (@dots{}, @var{p}) +## +## If called with one output argument and the first input argument +## @var{val} is a three-dimensional array that contains the data for an +## isosurface geometry and the second input argument @var{v} keeps the +## vertices of an isosurface then return the normals @var{n} in form of +## a matrix with the same size than @var{v} at computed points +## @command{[x, y, z] = meshgrid (1:l, 1:m, 1:n)}. The output argument +## @var{n} can be taken to manually set @var{VertexNormals} of a patch. +## +## If called with further input arguments @var{x}, @var{y} and @var{z} +## which are three--dimensional arrays with the same size than @var{val} +## then the volume data is taken at those given points. Instead of the +## vertices data @var{v} a patch handle @var{p} can be passed to this +## function. +## +## If given the string input argument "negate" as last input argument +## then compute the reverse vector normals of an isosurface geometry. +## +## If no output argument is given then directly redraw the patch that is +## given by the patch handle @var{p}. +## +## For example: +## @c Set example in small font to prevent overfull line +## +## @smallexample +## function [] = isofinish (p) +## set (gca, "PlotBoxAspectRatioMode", "manual", ... +## "PlotBoxAspectRatio", [1 1 1]); +## set (p, "VertexNormals", -get (p,"VertexNormals")); # Revert normals +## set (p, "FaceColor", "interp"); +## ## set (p, "FaceLighting", "phong"); +## ## light ("Position", [1 1 5]); # Available with JHandles +## endfunction +## +## N = 15; # Increase number of vertices in each direction +## iso = .4; # Change isovalue to .1 to display a sphere +## lin = linspace (0, 2, N); +## [x, y, z] = meshgrid (lin, lin, lin); +## c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); +## figure (); # Open another figure window +## +## subplot (2,2,1); view (-38, 20); +## [f, v, cdat] = isosurface (x, y, z, c, iso, y); +## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, ... +## "FaceColor", "interp", "EdgeColor", "none"); +## isofinish (p); ## Call user function isofinish +## +## subplot (2,2,2); view (-38, 20); +## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, ... +## "FaceColor", "interp", "EdgeColor", "none"); +## isonormals (x, y, z, c, p); # Directly modify patch +## isofinish (p); +## +## subplot (2,2,3); view (-38, 20); +## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, ... +## "FaceColor", "interp", "EdgeColor", "none"); +## n = isonormals (x, y, z, c, v); # Compute normals of isosurface +## set (p, "VertexNormals", n); # Manually set vertex normals +## isofinish (p); +## +## subplot (2,2,4); view (-38, 20); +## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", cdat, ... +## "FaceColor", "interp", "EdgeColor", "none"); +## isonormals (x, y, z, c, v, "negate"); # Use reverse directly +## isofinish (p); +## @end smallexample +## +## @seealso{isosurface, isocolors} +## @end deftypefn + +## Author: Martin Helm + +function varargout = isonormals(varargin) + na = nargin; + negate = false; + if (ischar (varargin{nargin})) + na = nargin-1; + if (strcmp (lower (varargin{nargin}), "negate")) + negate = true; + else + error ("isonormals: Unknown option '%s'", varargin{nargin}); + endif + endif + switch (na) + case 2 + c = varargin{1}; + vp = varargin{2}; + x = 1:size (c, 2); + y = 1:size (c, 1); + z = 1:size (c, 3); + case 5 + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + c = varargin{4}; + vp = varargin{5}; + otherwise + print_usage (); + endswitch + if (ismatrix (vp) && size (vp,2) == 3) + pa = []; + v = vp; + elseif (ishandle (vp)) + pa = vp; + v = get (pa, "Vertices"); + else + error ("isonormals: Last argument is not a vertex list or a patch handle"); + endif + if (negate) + normals = -__interp_cube__ (x, y, z, c, v, "normals"); + else + normals = __interp_cube__ (x, y, z, c, v, "normals"); + endif + switch (nargout) + case 0 + if (!isempty (pa)) + set (pa, "VertexNormals", normals); + endif + case 1 + varargout = {normals}; + otherwise + print_usage (); + endswitch +endfunction + +%!test +%! [x, y, z] = meshgrid (0:.5:2, 0:.5:2, 0:.5:2); +%! c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); +%! [f, v, cdat] = isosurface (x, y, z, c, .4, y); +%! n = isonormals (x, y, z, c, v); +%! assert (size (v), size (n)); +%!test +%! [x, y, z] = meshgrid (0:.5:2, 0:.5:2, 0:.5:2); +%! c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); +%! [f, v, cdat] = isosurface (x, y, z, c, .4, y); +%! np = isonormals (x, y, z, c, v); +%! nn = isonormals (x, y, z, c, v, "negate"); +%! assert (all (np == -nn)); diff --git a/octave_packages/m/plot/isosurface.m b/octave_packages/m/plot/isosurface.m new file mode 100644 index 0000000..4d1545b --- /dev/null +++ b/octave_packages/m/plot/isosurface.m @@ -0,0 +1,225 @@ +## Copyright (C) 2009-2012 Martin Helm +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fv}] =} isosurface (@var{val}, @var{iso}) +## @deftypefnx {Function File} {[@var{fv}] =} isosurface (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}) +## @deftypefnx {Function File} {[@var{fv}] =} isosurface (@dots{}, "noshare", "verbose") +## @deftypefnx {Function File} {[@var{fvc}] =} isosurface (@dots{}, @var{col}) +## @deftypefnx {Function File} {[@var{f}, @var{v}] =} isosurface (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}) +## @deftypefnx {Function File} {[@var{f}, @var{v}, @var{c}] =} isosurface (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}) +## @deftypefnx {Function File} {} isosurface (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}, @var{opt}) +## +## If called with one output argument and the first input argument +## @var{val} is a three-dimensional array that contains the data of an +## isosurface geometry and the second input argument @var{iso} keeps the +## isovalue as a scalar value then return a structure array @var{fv} +## that contains the fields @var{Faces} and @var{Vertices} at computed +## points @command{[x, y, z] = meshgrid (1:l, 1:m, 1:n)}. The output +## argument @var{fv} can directly be taken as an input argument for the +## @command{patch} function. +## +## If called with further input arguments @var{x}, @var{y} and @var{z} +## which are three--dimensional arrays with the same size than @var{val} +## then the volume data is taken at those given points. +## +## The string input argument "noshare" is only for compatibility and +## has no effect. If given the string input argument +## "verbose" then print messages to the command line interface about the +## current progress. +## +## If called with the input argument @var{col} which is a +## three-dimensional array of the same size than @var{val} then take +## those values for the interpolation of coloring the isosurface +## geometry. Add the field @var{FaceVertexCData} to the structure +## array @var{fv}. +## +## If called with two or three output arguments then return the +## information about the faces @var{f}, vertices @var{v} and color data +## @var{c} as seperate arrays instead of a single structure array. +## +## If called with no output argument then directly process the +## isosurface geometry with the @command{patch} command. +## +## For example, +## +## @example +## @group +## [x, y, z] = meshgrid (1:5, 1:5, 1:5); +## val = rand (5, 5, 5); +## isosurface (x, y, z, val, .5); +## @end group +## @end example +## +## @noindent +## will directly draw a random isosurface geometry in a graphics window. +## Another example for an isosurface geometry with different additional +## coloring +## @c Set example in small font to prevent overfull line +## +## @smallexample +## N = 15; # Increase number of vertices in each direction +## iso = .4; # Change isovalue to .1 to display a sphere +## lin = linspace (0, 2, N); +## [x, y, z] = meshgrid (lin, lin, lin); +## c = abs ((x-.5).^2 + (y-.5).^2 + (z-.5).^2); +## figure (); # Open another figure window +## +## subplot (2,2,1); view (-38, 20); +## [f, v] = isosurface (x, y, z, c, iso); +## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "none"); +## set (gca, "PlotBoxAspectRatioMode", "manual", ... +## "PlotBoxAspectRatio", [1 1 1]); +## # set (p, "FaceColor", "green", "FaceLighting", "phong"); +## # light ("Position", [1 1 5]); # Available with the JHandles package +## +## subplot (2,2,2); view (-38, 20); +## p = patch ("Faces", f, "Vertices", v, "EdgeColor", "blue"); +## set (gca, "PlotBoxAspectRatioMode", "manual", ... +## "PlotBoxAspectRatio", [1 1 1]); +## # set (p, "FaceColor", "none", "FaceLighting", "phong"); +## # light ("Position", [1 1 5]); +## +## subplot (2,2,3); view (-38, 20); +## [f, v, c] = isosurface (x, y, z, c, iso, y); +## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", c, ... +## "FaceColor", "interp", "EdgeColor", "none"); +## set (gca, "PlotBoxAspectRatioMode", "manual", ... +## "PlotBoxAspectRatio", [1 1 1]); +## # set (p, "FaceLighting", "phong"); +## # light ("Position", [1 1 5]); +## +## subplot (2,2,4); view (-38, 20); +## p = patch ("Faces", f, "Vertices", v, "FaceVertexCData", c, ... +## "FaceColor", "interp", "EdgeColor", "blue"); +## set (gca, "PlotBoxAspectRatioMode", "manual", ... +## "PlotBoxAspectRatio", [1 1 1]); +## # set (p, "FaceLighting", "phong"); +## # light ("Position", [1 1 5]); +## @end smallexample +## +## @seealso{isonormals, isocolors} +## @end deftypefn + +## Author: Martin Helm + +function varargout = isosurface(varargin) + + if (nargin < 2 || nargin > 8 || nargout > 3) + print_usage (); + endif + + calc_colors = false; + f = v = c = []; + verbose = false; + noshare = false; + if (nargin >= 5) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + val = varargin{4}; + iso = varargin{5}; + if (nargin >= 6 && ismatrix (varargin{6})) + colors = varargin{6}; + calc_colors = true; + endif + else + val = varargin{1}; + [n2, n1, n3] = size (val); + [x, y, z] = meshgrid (1:n1, 1:n2, 1:n3); + iso = varargin{2}; + if (nargin >= 3 && ismatrix (varargin{3})) + colors = varargin{3}; + calc_colors = true; + endif + endif + if (calc_colors) + if (nargout == 2) + warning ( "Colors will be calculated, but you did not specify an output argument for it!" ); + endif + [fvc.faces, fvc.vertices, fvc.facevertexcdata] = __marching_cube__ (x, y, z, val, iso, colors); + else + [fvc.faces, fvc.vertices] = __marching_cube__ (x, y, z, val, iso); + endif + + if (isempty (fvc.vertices) || isempty (fvc.faces)) + warning ( "The resulting triangulation is empty" ); + endif + + switch (nargout) + case 0 + ## plot the calculated surface + newplot (); + if (calc_colors) + pa = patch ("Faces", fvc.faces, "Vertices", fvc.vertices, + "FaceVertexCData", fvc.facevertexcdata, + "FaceColor", "flat", "EdgeColor", "none"); + else + pa = patch ("Faces", fvc.faces, "Vertices", fvc.vertices, + "FaceColor", "g", "EdgeColor", "k"); + endif + if (! ishold ()) + set (gca(), "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + case 1 + varargout = {fvc}; + case 2 + varargout = {fvc.faces, fvc.vertices}; + case 3 + varargout = {fvc.faces, fvc.vertices, fvc.facevertexcdata}; + otherwise + print_usage (); + endswitch + +endfunction + + +%!shared x, y, z, val +%! [x, y, z] = meshgrid (0:1, 0:1, 0:1); ## Points for single +%! val = [0, 0; 0, 0]; ## cube and a 3--dim +%! val(:,:,2) = [0, 0; 1, 0]; ## array of values +%!test +%! fv = isosurface (x, y, z, val, 0.3); +%! assert (isfield (fv, "vertices"), true); +%! assert (isfield (fv, "faces"), true); +%! assert (size (fv.vertices), [3 3]); +%! assert (size (fv.faces), [1 3]); +%!test +%! fvc = isosurface (x, y, z, val, .3, y); +%! assert (isfield (fvc, "vertices"), true); +%! assert (isfield (fvc, "faces"), true); +%! assert (isfield (fvc, "facevertexcdata"), true); +%! assert (size (fvc.vertices), [3 3]); +%! assert (size (fvc.faces), [1 3]); +%! assert (size (fvc.facevertexcdata), [3 1]); +%!test +%! [f, v] = isosurface (x, y, z, val, .3); +%! assert (size (f), [1 3]); +%! assert (size (v), [3 3]); +%!test +%! [f, v, c] = isosurface (x, y, z, val, .3, y); +%! assert (size (f), [1 3]); +%! assert (size (v), [3 3]); +%! assert (size (c), [3 1]); + +%!demo +%! clf +%! [x,y,z] = meshgrid(-2:0.5:2, -2:0.5:2, -2:0.5:2); +%! v = x.^2 + y.^2 + z.^2; +%! isosurface (x, y, z, v, 1) diff --git a/octave_packages/m/plot/isprop.m b/octave_packages/m/plot/isprop.m new file mode 100644 index 0000000..03bd052 --- /dev/null +++ b/octave_packages/m/plot/isprop.m @@ -0,0 +1,55 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{res} =} isprop (@var{h}, @var{prop}) +## Return true if @var{prop} is a property of the object with handle @var{h}. +## @seealso{get, set} +## @end deftypefn + +## Author: Ben Abbott + +function res = isprop (h, prop) + ## Check input + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (! all (ishandle (h))) + error ("isprop: first input argument must be a handle"); + elseif (! ischar (prop)) + error ("isprop: second input argument must be string"); + endif + + res = false (size (h)); + for n = 1:numel(res) + res(n) = true; + try + v = get (h(n), prop); + catch + res(n) = false; + end_try_catch + endfor +endfunction + +%!assert (isprop (0, "foobar"), false) + +%!assert (isprop (0, "screenpixelsperinch"), true) + +%!assert (isprop (zeros (2, 3), "visible"), true (2, 3)) + diff --git a/octave_packages/m/plot/legend.m b/octave_packages/m/plot/legend.m new file mode 100644 index 0000000..3918cb3 --- /dev/null +++ b/octave_packages/m/plot/legend.m @@ -0,0 +1,1161 @@ +## Copyright (C) 2010-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} legend (@var{str1}, @var{str2}, @dots{}) +## @deftypefnx {Function File} {} legend (@var{matstr}) +## @deftypefnx {Function File} {} legend (@var{cell}) +## @deftypefnx {Function File} {} legend (@dots{}, "location", @var{pos}) +## @deftypefnx {Function File} {} legend (@dots{}, "orientation", @var{orient}) +## @deftypefnx {Function File} {} legend (@var{hax}, @dots{}) +## @deftypefnx {Function File} {} legend (@var{hobjs}, @dots{}) +## @deftypefnx {Function File} {} legend (@var{hax}, @var{hobjs}, @dots{}) +## @deftypefnx {Function File} {} legend ("@var{option}") +## +## Display a legend for the axes with handle @var{hax}, or the current axes, +## using the specified strings as labels. Legend entries may be specified +## as individual character string arguments, a character array, or a cell +## array of character strings. If the handles, @var{hobjs}, are not specified +## then the legend's strings will be associated with the axes' descendants. +## Legend works on line graphs, bar graphs, etc. +## A plot must exist before legend is called. +## +## The optional parameter @var{pos} specifies the location of the legend +## as follows: +## +## @multitable @columnfractions 0.06 0.14 0.80 +## +## @headitem @tab @var{pos} @tab +## location of the legend +## +## @item @tab north @tab +## center top +## +## @item @tab south @tab +## center bottom +## +## @item @tab east @tab +## right center +## +## @item @tab west @tab +## left center +## +## @item @tab northeast @tab +## right top (default) +## +## @item @tab northwest @tab +## left top +## +## @item @tab southeast @tab +## right bottom +## +## @item @tab southwest @tab +## left bottom +## +## @item +## +## @item @tab outside @tab +## can be appended to any location string +## @end multitable +## +## The optional parameter @var{orient} determines if the key elements +## are placed vertically or horizontally. The allowed values are "vertical" +## or "horizontal" with the default being "vertical". +## +## The following customizations are available using @var{option}: +## +## @table @asis +## @item "show" +## Show legend on the plot +## +## @item "hide" +## Hide legend on the plot +## +## @itemx "toggle" +## Toggles between "hide" and "show" +## +## @item "boxon" +## Show a box around legend +## +## @item "boxoff" +## Hide the box around legend +## +## @item "left" +## Place text to the left of the keys +## +## @item "right" +## Place text to the right of the keys +## +## @itemx "off" +## Delete the legend object +## @end table +## @end deftypefn + +function [hlegend2, hobjects2, hplot2, text_strings2] = legend (varargin) + + if (nargin > 0 + && (! ishandle (varargin{1}) + || (strcmp (get (varargin{1}, "type"), "axes") + && ! strcmp (get (varargin{1}, "tag"), "legend")))) + [ca, varargin, nargs] = __plt_get_axis_arg__ ("legend", varargin{:}); + fig = get (ca, "parent"); + else + fig = get (0, "currentfigure"); + if (isempty (fig)) + fig = gcf (); + endif + ca = gca (); + endif + + if (ishandle (ca) && isprop (ca, "__plotyy_axes__")) + plty = get (ca, "__plotyy_axes__"); + if (isscalar (plty) && ishandle (plty)) + ca = [ca, plty]; + elseif (iscell (plty)) + ca = [ca, plty{:}]; + elseif (all (ishandle (plty))) + ca = [ca, plty(:).']; + else + error ("legend.m: This should not happen. File a bug report.") + endif + ## Remove duplicates while preserving order + [~, n] = unique (ca); + ca = ca (sort (n)); + endif + + if (nargin > 0 && all (ishandle (varargin{1}))) + kids = flipud (varargin{1}(:)); + varargin(1) = []; + else + kids = ca; + kids (strcmp (get (ca, "tag"), "legend")) = []; + if (isscalar (kids)) + kids = get(kids, "children")(:); + else + kids = [get(kids, "children"){:}](:); + endif + endif + nargs = numel (varargin); + nkids = numel (kids); + + orientation = "default"; + position = "default"; + show = "create"; + textpos = "default"; + box = "default"; + + if (nargs > 0) + pos = varargin{nargs}; + if (isnumeric (pos) && isscalar (pos) && pos == fix (pos)) + if (pos >= -1 && pos <= 4) + position = [{"northeastoutside", "best", "northeast", + "northwest", "southwest", "southeast"}] {pos + 2}; + nargs--; + else + error ("legend: invalid position specified"); + endif + endif + endif + + while (nargs > 1) + pos = varargin{nargs-1}; + str = varargin{nargs}; + if (strcmpi (pos, "location") && ischar (str)) + position = lower (str); + nargs -= 2; + elseif (strcmpi (pos, "orientation") && ischar (str)) + orientation = lower (str); + nargs -= 2; + else + break; + endif + endwhile + + ## Validate the orientation + switch (orientation) + case {"vertical", "horizontal","default"} + otherwise + error ("legend: unrecognized legend orientation"); + endswitch + + ## Validate the position type is valid + outside = false; + inout = findstr (position, "outside"); + if (! isempty (inout)) + outside = true; + position = position(1:inout-1); + else + outside = false; + endif + + switch (position) + case {"north", "south", "east", "west", "northeast", "northwest", ... + "southeast", "southwest", "default"} + case "best" + warning ("legend: 'Best' not yet implemented for location specifier\n"); + position = "northeast"; + otherwise + error ("legend: unrecognized legend position"); + endswitch + + hlegend = []; + fkids = get (fig, "children"); + for i = 1 : numel(fkids) + if (ishandle (fkids (i)) && strcmp (get (fkids (i), "type"), "axes") + && (strcmp (get (fkids (i), "tag"), "legend"))) + udata = get (fkids (i), "userdata"); + if (! isempty (intersect (udata.handle, ca))) + hlegend = fkids (i); + break; + endif + endif + endfor + + if (nargs == 1) + arg = varargin{1}; + if (ischar (arg)) + if (rows (arg) == 1) + str = tolower (deblank (arg)); + switch (str) + case {"off"} + delete (hlegend); + return + case {"hide"} + show = "off"; + nargs--; + case "show" + show = "on"; + nargs--; + case "toggle" + if (isempty (hlegend) || strcmp (get (hlegend, "visible"), "off")) + show = "on"; + else + show = "off"; + endif + nargs--; + case "boxon" + box = "on"; + nargs--; + case "boxoff" + box = "off"; + nargs--; + case "left" + textpos = "left"; + nargs--; + case "right" + textpos = "right"; + nargs--; + otherwise + endswitch + else + varargin = cellstr (arg); + nargs = numel (varargin); + endif + elseif (iscellstr (arg)) + varargin = arg; + nargs = numel (varargin); + else + error ("legend: expecting argument to be a character string"); + endif + endif + + if (strcmp (show, "off")) + if (! isempty (hlegend)) + set (get (hlegend, "children"), "visible", "off"); + hlegend = []; + endif + hobjects = []; + hplots = []; + text_strings = {}; + elseif (strcmp (show, "on")) + if (! isempty (hlegend)) + set (get (hlegend, "children"), "visible", "on"); + else + hobjects = []; + hplots = []; + text_strings = {}; + endif + elseif (strcmp (box, "on")) + if (! isempty (hlegend)) + set (hlegend, "visible", "on", "box", "on"); + endif + elseif (strcmp (box, "off")) + if (! isempty (hlegend)) + set (hlegend, "box", "off", "visible", "off"); + endif + elseif (nargs == 0 && !(strcmp (position, "default") && + strcmp (orientation, "default"))) + if (! isempty (hlegend)) + hax = getfield (get (hlegend, "userdata"), "handle"); + [hplots, text_strings] = __getlegenddata__ (hlegend); + + if (strcmp (position, "default")) + h = legend (hax, hplots, text_strings, "orientation", orientation); + elseif (strcmp (orientation, "default")) + if (outside) + h = legend (hax, hplots, text_strings, "location", + strcat (position, "outside")); + else + h = legend (hax, hplots, text_strings, "location", position); + endif + else + if (outside) + h = legend (hax, hplots, text_strings, "location", + strcat (position, "outside"), "orientation", orientation); + else + h = legend (hax, hplots, text_strings, "location", position, + "orientation", orientation); + endif + endif + endif + else + hobjects = []; + hplots = []; + text_strings = {}; + + if (nargs > 0) + have_data = false; + for k = 1:nkids + typ = get (kids(k), "type"); + if (strcmp (typ, "line") || strcmp (typ, "surface") + || strcmp (typ, "patch") || strcmp (typ, "hggroup")) + have_data = true; + break; + endif + endfor + + if (! have_data) + warning ("legend: plot data is empty; setting key labels has no effect"); + endif + endif + + if (strcmp (textpos, "default")) + warned = false; + k = nkids; + for i = 1 : nargs + arg = varargin{i}; + if (ischar (arg)) + typ = get (kids(k), "type"); + while (k > 0 + && ! (strcmp (typ, "line") || strcmp (typ, "surface") + || strcmp (typ, "patch") || strcmp (typ, "hggroup"))) + typ = get (kids(--k), "type"); + endwhile + if (k > 0) + if (strcmp (get (kids(k), "type"), "hggroup")) + hgkids = get (kids(k), "children"); + for j = 1 : length (hgkids) + hgobj = get (hgkids (j)); + if (isfield (hgobj, "displayname")) + set (hgkids(j), "displayname", arg); + hplots = [hplots, hgkids(j)]; + text_strings = {text_strings{:}, arg}; + break; + endif + endfor + else + set (kids(k), "displayname", arg); + hplots = [hplots, kids(k)]; + text_strings = {text_strings{:}, arg}; + endif + + if (--k == 0) + break; + endif + elseif (! warned) + break; + endif + else + error ("legend: expecting argument to be a character string"); + endif + endfor + if (i < nargs && ! warned) + warning ("legend: ignoring extra labels"); + endif + else + k = nkids; + while (k > 0) + typ = get (kids(k), "type"); + while (k > 1 + && ! (strcmp (typ, "line") || strcmp (typ, "surface") + || strcmp (typ, "patch") || strcmp (typ, "hggroup"))) + typ = get (kids(--k), "type"); + endwhile + if (! (strcmp (typ, "line") || strcmp (typ, "surface") + || strcmp (typ, "patch") || strcmp (typ, "hggroup"))) + break + endif + if (k > 0) + if (strcmp (get (kids(k), "type"), "hggroup")) + hgkids = get (kids(k), "children"); + for j = 1 : length (hgkids) + hgobj = get (hgkids (j)); + if (isfield (hgobj, "displayname") + && ! isempty (hgobj.displayname)) + hplots = [hplots, hgkids(j)]; + text_strings = {text_strings{:}, hgobj.displayname}; + break; + endif + endfor + else + if (! isempty (get (kids (k), "displayname"))) + hplots = [hplots, kids(k)]; + text_strings = {text_strings{:}, get(kids (k), "displayname")}; + endif + endif + if (--k == 0) + break; + endif + endif + endwhile + endif + + if (isempty (hplots)) + if (! isempty (hlegend)) + fkids = get (fig, "children"); + delete (fkids (fkids == hlegend)); + hlegend = []; + hobjects = []; + hplots = []; + text_strings = {}; + endif + else + ## Delete the old legend if it exists + if (! isempty (hlegend)) + if (strcmp (textpos, "default")) + textpos = get (hlegend, "textposition"); + endif + if (strcmp (position, "default")) + position = get (hlegend, "location"); + inout = findstr (position, "outside"); + if (! isempty (inout)) + outside = true; + position = position(1:inout-1); + else + outside = false; + endif + endif + if (strcmp (orientation, "default")) + orientation = get (hlegend, "orientation"); + endif + box = get (hlegend, "box"); + fkids = get (fig, "children"); + + delete (hlegend); + hlegend = []; + else + if (strcmp (textpos, "default")) + textpos = "left"; + endif + if (strcmp (position, "default")) + position = "northeast"; + endif + if (strcmp (orientation, "default")) + orientation = "vertical"; + endif + box = "off"; + endif + + ## Get axis size and fontsize in points. + ## Rely on listener to handle coversion. + units = get (ca(1), "units"); + fontunits = get (ca(1), "fontunits"); + unwind_protect + set (ca(1), "units", "points"); + set (ca(1), "fontunits", "points"); + ca_pos = get (ca(1), "position"); + ca_outpos = get (ca(1), "outerposition"); + ca_fontsize = get (ca(1), "fontsize"); + unwind_protect_cleanup + set (ca(1), "units", units); + set (ca(1), "fontunits", fontunits); + end_unwind_protect + + ## Padding between legend entries horizontally and vertically + xpad = 2; + ypad = 2; + + ## Length of line segments in the legend in points + linelength = 15; + + ## Create the axis first + ## FIXME hlegend should inherit properties from "ca" + curaxes = get (fig, "currentaxes"); + unwind_protect + ud = ancestor(hplots, "axes"); + if (!isscalar(ud)) + ud = unique ([ud{:}]); + endif + if (isempty (hlegend)) + addprops = true; + hlegend = axes ("tag", "legend", "userdata", struct ("handle", ud), + "box", box, + "xtick", [], "ytick", [], "xticklabel", "", + "yticklabel", "", "zticklabel", "", + "xlim", [0, 1], "ylim", [0, 1], "visible", "off", + "activepositionproperty", "position"); + else + addprops = false; + axes (hlegend); + delete (get (hlegend, "children")); + endif + + ## Add text label to the axis first, checking their extents + nentries = numel (hplots); + texthandle = []; + maxwidth = 0; + maxheight = 0; + for k = 1 : nentries + if (strcmp (textpos, "right")) + texthandle = [texthandle, text(0, 0, text_strings {k}, + "horizontalalignment", "left", + "userdata", hplots(k))]; + else + texthandle = [texthandle, text(0, 0, text_strings {k}, + "horizontalalignment", "right", + "userdata", hplots(k))]; + endif + units = get (texthandle (end), "units"); + unwind_protect + set (texthandle (end), "units", "points"); + extents = get (texthandle (end), "extent"); + maxwidth = max (maxwidth, extents (3)); + maxheight = max (maxheight, extents (4)); + unwind_protect_cleanup + set (texthandle (end), "units", units); + end_unwind_protect + endfor + + num1 = nentries; + if (strcmp (orientation, "vertical")) + height = nentries * (ypad + maxheight); + if (outside) + if (height > ca_pos (4)) + ## Avoid shrinking the height of the axis to zero if outside + num1 = ca_pos(4) / (maxheight + ypad) / 2; + endif + else + if (height > 0.9 * ca_pos (4)) + num1 = 0.9 * ca_pos(4) / (maxheight + ypad); + endif + endif + else + width = nentries * (ypad + maxwidth); + if (outside) + if (width > ca_pos (3)) + ## Avoid shrinking the width of the axis to zero if outside + num1 = ca_pos(3) / (maxwidth + ypad) / 2; + endif + else + if (width > 0.9 * ca_pos (3)) + num1 = 0.9 * ca_pos(3) / (maxwidth + ypad); + endif + endif + endif + num2 = ceil (nentries / num1); + + xstep = 3 * xpad + (maxwidth + linelength); + if (strcmp (textpos, "right")) + xoffset = xpad; + txoffset = 2 * xpad + linelength; + else + xoffset = 2 * xpad + maxwidth; + txoffset = xpad + maxwidth; + endif + ystep = (ypad + maxheight); + yoffset = ystep / 2; + + ## Place the legend in the desired position + if (strcmp (orientation, "vertical")) + lpos = [0, 0, num2 * xstep, num1 * ystep]; + else + lpos = [0, 0, num1 * xstep, num2 * ystep]; + endif + switch (position) + case "north" + if (outside) + lpos = [ca_pos(1) + (ca_pos(3) - lpos(3)) / 2, ... + ca_outpos(2) + ca_outpos(4) - lpos(4) - ypad, lpos(3), ... + lpos(4)]; + + new_pos = [ca_pos(1), ca_pos(2), ca_pos(3), ca_pos(4) - lpos(4)]; + else + lpos = [ca_pos(1) + (ca_pos(3) - lpos(3)) / 2, ... + ca_pos(2) + ca_pos(4) - lpos(4) - ypad, lpos(3), lpos(4)]; + endif + case "south" + if (outside) + lpos = [ca_pos(1) + (ca_pos(3) - lpos(3)) / 2, ... + ca_outpos(2) + ypad, lpos(3), lpos(4)]; + new_pos = [ca_pos(1), ca_pos(2) + lpos(4), ca_pos(3), ... + ca_pos(4) - lpos(4)]; + else + lpos = [ca_pos(1) + (ca_pos(3) - lpos(3)) / 2, ... + ca_pos(2) + ypad, lpos(3), lpos(4)]; + endif + case "east" + if (outside) + lpos = [ca_outpos(1) + ca_outpos(3) - lpos(3) - ypad, ... + ca_pos(2) + (ca_pos(4) - lpos(4)) / 2, lpos(3), lpos(4)]; + new_pos = [ca_pos(1), ca_pos(2), ca_pos(3) - lpos(3), ca_pos(4)]; + else + lpos = [ca_pos(1) + ca_pos(3) - lpos(3) - ypad, ... + ca_pos(2) + (ca_pos(4) - lpos(4)) / 2, lpos(3), lpos(4)]; + endif + case "west" + if (outside) + lpos = [ca_outpos(1) + ypad, ... + ca_pos(2) + (ca_pos(4) - lpos(4)) / 2, ... + lpos(3), lpos(4)]; + new_pos = [ca_pos(1) + lpos(3), ca_pos(2), ... + ca_pos(3) - lpos(3), ca_pos(4)]; + else + lpos = [ca_pos(1) + ypad, ... + ca_pos(2) + (ca_pos(4) - lpos(4)) / 2, lpos(3), lpos(4)]; + endif + case "northeast" + if (outside) + lpos = [ca_outpos(1) + ca_outpos(3) - lpos(3) - ypad, ... + ca_pos(2) + ca_pos(4) - lpos(4), lpos(3), lpos(4)]; + new_pos = [ca_pos(1), ca_pos(2), ca_pos(3) - lpos(3), ca_pos(4)]; + else + lpos = [ca_pos(1) + ca_pos(3) - lpos(3) - ypad, ... + ca_pos(2) + ca_pos(4) - lpos(4) - ypad, lpos(3), lpos(4)]; + endif + case "northwest" + if (outside) + lpos = [ca_outpos(1) + ypad , ca_pos(2) + ca_pos(4) - lpos(4), ... + lpos(3), lpos(4)]; + new_pos = [ca_pos(1) + lpos(3), ca_pos(2), ... + ca_pos(3) - lpos(3), ca_pos(4)]; + else + lpos = [ca_pos(1) + ypad, ... + ca_pos(2) + ca_pos(4) - lpos(4) - ypad, lpos(3), lpos(4)]; + endif + case "southeast" + if (outside) + lpos = [ca_outpos(1) + ca_outpos(3) - lpos(3) - ypad, ... + ca_pos(2), lpos(3), lpos(4)]; + new_pos = [ca_pos(1), ca_pos(2), ... + ca_pos(3) - lpos(3), ca_pos(4)]; + else + lpos = [ca_pos(1) + ca_pos(3) - lpos(3) - ypad, ... + ca_pos(2) + ypad, lpos(3), lpos(4)]; + endif + case "southwest" + if (outside) + lpos = [ca_outpos(1) + ypad, ca_pos(2), lpos(3), lpos(4)]; + new_pos = [ca_pos(1) + lpos(3), ca_pos(2), ... + ca_pos(3) - lpos(3), ca_pos(4)]; + else + lpos = [ca_pos(1) + ypad, ca_pos(2) + ypad, lpos(3), lpos(4)]; + endif + endswitch + + units = get (hlegend, "units"); + unwind_protect + set (hlegend, "units", "points"); + set (hlegend, "position", lpos); + unwind_protect_cleanup + set (hlegend, "units", units); + end_unwind_protect + + ## Now write the line segments and place the text objects correctly + xk = 0; + yk = 0; + for k = 1 : numel (hplots) + hobjects = [hobjects, texthandle (k)]; + switch (get (hplots(k), "type")) + case "line" + color = get (hplots(k), "color"); + style = get (hplots(k), "linestyle"); + if (! strcmp (style, "none")) + l1 = line ("xdata", ([xoffset, xoffset + linelength] + xk * xstep) / lpos(3), + "ydata", [1, 1] .* (lpos(4) - yoffset - yk * ystep) / lpos(4), + "color", color, "linestyle", style, "marker", "none", + "userdata", hplots (k)); + hobjects = [hobjects, l1]; + endif + marker = get (hplots(k), "marker"); + if (! strcmp (marker, "none")) + l1 = line ("xdata", (xoffset + 0.5 * linelength + xk * xstep) / lpos(3), + "ydata", (lpos(4) - yoffset - yk * ystep) / lpos(4), + "color", color, "linestyle", "none", "marker", marker, + "markeredgecolor", get (hplots (k), "markeredgecolor"), + "markerfacecolor", get (hplots (k), "markerfacecolor"), + "markersize", get (hplots (k), "markersize"), + "userdata", hplots (k)); + hobjects = [hobjects, l1]; + endif + + addlistener(hplots(k), "color", {@updateline, hlegend, linelength}); + addlistener(hplots(k), "linestyle", {@updateline, hlegend, linelength}); + addlistener(hplots(k), "marker", {@updateline, hlegend, linelength}); + addlistener(hplots(k), "markeredgecolor", {@updateline, hlegend, linelength}); + addlistener(hplots(k), "markerfacecolor", {@updateline, hlegend, linelength}); + addlistener(hplots(k), "markersize", {@updateline, hlegend, linelength}); + addlistener(hplots(k), "displayname", {@updateline, hlegend, linelength}); + case "patch" + case "surface" + endswitch + set (texthandle (k), "position", [(txoffset + xk * xstep) / lpos(3), ... + (lpos(4) - yoffset - yk * ystep) / lpos(4)]); + if (strcmp (orientation, "vertical")) + yk++; + if (yk > num1) + yk = 0; + xk++; + endif + else + xk++; + if (xk > num1) + xk = 0; + yk++; + endif + endif + endfor + + ## Add an invisible text object to original axis + ## that when it is destroyed will remove the legend + t1 = text (0, 0, "", "parent", ca(1), "tag", "legend", + "handlevisibility", "off", "visible", "off", + "xliminclude", "off", "yliminclude", "off"); + set (t1, "deletefcn", {@deletelegend1, hlegend}); + + ## Resize the axis the legend is attached to if the + ## legend is "outside" the plot and create listener to + ## resize axis to original size if the legend is deleted, + ## hidden or shown + if (outside) + for i = 1 : numel (ca) + units = get (ca(i), "units"); + unwind_protect + set (ca(i), "units", "points"); + set (ca (i), "position", new_pos); + unwind_protect_cleanup + set (ca(i), "units", units); + end_unwind_protect + endfor + + set (hlegend, "deletefcn", {@deletelegend2, ca, ... + ca_pos, ca_outpos, t1, hplots}); + addlistener (hlegend, "visible", {@hideshowlegend, ca, ... + ca_pos, new_pos}); + else + set (hlegend, "deletefcn", {@deletelegend2, ca, [], [], t1, hplots}); + endif + + if (addprops) + addproperty ("edgecolor", hlegend, "color", [0, 0, 0]); + addproperty ("textcolor", hlegend, "color", [0, 0, 0]); + addproperty ("location", hlegend, "radio", "north|south|east|west|{northeast}|southeast|northwest|southwest|northoutside|southoutside|eastoutside|westoutside|northeastoutside|southeastoutside|northwestoutside|southwestoutside"); + addproperty ("orientation", hlegend, "radio", + "{vertical}|horizontal"); + addproperty ("string", hlegend, "any", text_strings); + addproperty ("textposition", hlegend, "radio", "{left}|right"); + else + set (hlegend, "string", text_strings); + endif + + if (outside) + set (hlegend, "location", strcat (position, "outside"), + "orientation", orientation, "textposition", textpos); + else + set (hlegend, "location", position, "orientation", orientation, + "textposition", textpos); + endif + if (addprops) + addlistener (hlegend, "edgecolor", @updatelegendtext); + addlistener (hlegend, "textcolor", @updatelegendtext); + addlistener (hlegend, "interpreter", @updatelegendtext); + addlistener (hlegend, "location", @updatelegend); + addlistener (hlegend, "orientation", @updatelegend); + addlistener (hlegend, "string", @updatelegend); + addlistener (hlegend, "textposition", @updatelegend); + endif + unwind_protect_cleanup + set (fig, "currentaxes", curaxes); + end_unwind_protect + endif + endif + + if (nargout > 0) + hlegend2 = hlegend; + hobjects2 = hobjects; + hplot2 = hplots; + text_strings2 = text_strings; + endif + +endfunction + +function updatelegend (h, d) + persistent recursive = false; + if (! recursive) + recursive = true; + unwind_protect + hax = getfield (get (h, "userdata"), "handle"); + [hplots, text_strings] = __getlegenddata__ (h); + h = legend (hax, hplots, get (h, "string")); + unwind_protect_cleanup + recursive = false; + end_unwind_protect + endif +endfunction + +function updatelegendtext (h, d) + hax = get (h, "userdata").handle; + kids = get (h, "children"); + text_kids = findobj (kids, "-property", "interpreter", "type", "text"); + interpreter = get (h, "interpreter"); + textcolor = get (h, "textcolor"); + set (kids, "interpreter", interpreter, "color", textcolor); + hobj = cell2mat (get (kids, "userdata")); + set (hobj, "interpreter", interpreter); +endfunction + +function hideshowlegend (h, d, ca, pos1, pos2) + isvisible = strcmp (get (h, "visible"), "off"); + if (! isvisible) + kids = get (h, "children"); + for i = 1 : numel (kids) + if (! strcmp (get (kids(i), "visible"), "off")) + isvisible = true; + break; + endif + endfor + endif + + for i = 1 : numel (ca) + if (ishandle (ca(i)) && strcmp (get (ca(i), "type"), "axes") + && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off")) + && strcmp (get (ca(i), "beingdeleted"), "off")) + units = get (ca(i), "units"); + unwind_protect + set (ca(i), "units", "points"); + if (isvisible) + set (ca(i), "position", pos2); + else + set (ca(i), "position", pos1); + endif + unwind_protect_cleanup + set (ca(i), "units", units); + end_unwind_protect + endif + endfor +endfunction + +function deletelegend1 (h, d, ca) + if (ishandle (ca) && strcmp (get (ca, "type"), "axes") + && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off")) + && strcmp (get (ca, "beingdeleted"), "off")) + delete (ca); + endif +endfunction + +function deletelegend2 (h, d, ca, pos, outpos, t1, hplots) + for i = 1 : numel (ca) + if (ishandle (ca(i)) && strcmp (get (ca(i), "type"), "axes") + && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off")) + && strcmp (get (ca(i), "beingdeleted"), "off")) + if (!isempty (pos) && !isempty(outpos)) + units = get (ca(i), "units"); + unwind_protect + set (ca(i), "units", "points"); + set (ca(i), "position", pos, "deletefcn", ""); + unwind_protect_cleanup + set (ca(i), "units", units); + end_unwind_protect + endif + endif + endfor + set (t1, "deletefcn", ""); + delete (t1); + for i = 1 : numel (hplots) + if (strcmp (get (hplots (i), "type"), "line")) + dellistener (hplots (i), "color"); + dellistener (hplots (i), "linestyle"); + dellistener (hplots (i), "marker"); + dellistener (hplots (i), "markeredgecolor"); + dellistener (hplots (i), "markerfacecolor"); + dellistener (hplots (i), "markersize"); + dellistener (hplots (i), "displayname"); + endif + endfor +endfunction + +function updateline (h, d, hlegend, linelength) + lm = []; + ll = []; + kids = get (hlegend, "children"); + for i = 1 : numel (kids) + if (get (kids (i), "userdata") == h + && strcmp (get (kids(i), "type"), "line")) + if (strcmp (get (kids (i), "marker"), "none")) + ll = kids (i); + else + lm = kids (i); + endif + endif + endfor + + linestyle = get (h, "linestyle"); + marker = get (h, "marker"); + displayname = get (h, "displayname"); + + if ((isempty (displayname) + || (strcmp (marker, "none") && strcmp (linestyle, "none"))) + && (! isempty (lm) || isempty (ll))) + ## An element was removed from the legend. Need to recall the + ## legend function to recreate a new legend + [hplots, text_strings] = __getlegenddata__ (hlegend); + for i = 1 : numel (hplots) + if (hplots (i) == h) + hplots(i) = []; + text_strings(i) = []; + break; + endif + endfor + legend (hplots, text_strings); + elseif ((!isempty (displayname) + && (! strcmp (marker, "none") || ! strcmp (linestyle, "none"))) + && isempty (lm) && isempty (ll)) + ## An element was added to the legend. Need to recall the + ## legend function to recreate a new legend + [hplots, text_strings] = __getlegenddata__ (hlegend); + hplots = [hplots, h]; + text_strings = {text_strings{:}, displayname}; + legend (hplots, text_strings); + else + if (! isempty (ll)) + ypos1 = get (ll,"ydata"); + xpos1 = get (ll,"xdata"); + ypos2 = ypos1(1); + xpos2 = sum(xpos1) / 2; + delete (ll); + if (! isempty (lm)) + delete (lm); + endif + else + ypos2 = get (lm,"ydata"); + xpos2 = get (lm,"xdata"); + ypos1 = [ypos2, ypos2]; + xpos1 = xpos2 + [-0.5, 0.5] * linelength; + delete (lm); + endif + if (! strcmp (linestyle, "none")) + line ("xdata", xpos1, "ydata", ypos1, "color", get (h, "color"), + "linestyle", get (h, "linestyle"), "marker", "none", + "userdata", h, "parent", hlegend); + endif + if (! strcmp (marker, "none")) + line ("xdata", xpos2, "ydata", ypos2, "color", get (h, "color"), + "marker", marker, "markeredgecolor", get (h, "markeredgecolor"), + "markerfacecolor", get (h, "markerfacecolor"), + "markersize", get (h, "markersize"), "linestyle", "none", + "userdata", h, "parent", hlegend); + endif + endif +endfunction + +%!demo +%! clf +%! x = 0:1; +%! plot (x, x, ";I am Blue;", x, 2*x, ";I am Green;", x, 3*x, ";I am Red;") + +%!demo +%! clf +%! x = 0:1; +%! plot (x, x, ";I am Blue;", x, 2*x, x, 3*x, ";I am Red;") +%! title ("Blue and Green keys, with Green mising") + +%!demo +%! clf +%! plot(1:10, 1:10, 1:10, fliplr(1:10)); +%! title("incline is blue and decline is green"); +%! legend({"I am blue", "I am green"}, "location", "east"); +%! legend({"I am blue", "I am green"}, "location", "east"); +%! legend hide +%! legend show + +%!demo +%! clf +%! plot(1:10, 1:10, 1:10, fliplr(1:10)); +%! title("Legend is hidden") +%! legend({"I am blue", "I am green"}, "location", "east"); +%! legend hide + +%!demo +%! clf +%! plot(1:10, 1:10, 1:10, fliplr(1:10)); +%! title("Legend with box on") +%! legend({"I am blue", "I am green"}, "location", "east"); +%! legend boxon + +%!demo +%! clf +%! plot(1:10, 1:10, 1:10, fliplr(1:10)); +%! title("Legend with text to the right") +%! legend({"I am blue", "I am green"}, "location", "east"); +%! legend right + +%!demo +%! clf +%! plot(1:10, 1:10); +%! title("a very long label can sometimes cause problems"); +%! legend({"hello world"}, "location", "northeastoutside"); + +%!demo +%! clf +%! plot(1:10, 1:10); +%! title("a very long label can sometimes cause problems"); +%! legend("hello world", "location", "northeastoutside"); + +%!demo +%! clf +%! labels = {}; +%! colororder = get (gca, "colororder"); +%! for i = 1:5 +%! h = plot(1:100, i + rand(100,1)); hold on; +%! set (h, "color", colororder(i,:)) +%! labels = {labels{:}, cstrcat("Signal ", num2str(i))}; +%! endfor +%! hold off; +%! title("Signals with random offset and uniform noise") +%! xlabel("Sample Nr [k]"); ylabel("Amplitude [V]"); +%! legend(labels, "location", "southoutside"); +%! legend("boxon"); + +%!demo +%! clf +%! labels = {}; +%! colororder = get (gca, "colororder"); +%! for i = 1:5 +%! h = plot(1:100, i + rand(100,1)); hold on; +%! set (h, "color", colororder(i,:)) +%! labels = {labels{:}, cstrcat("Signal ", num2str(i))}; +%! endfor +%! hold off; +%! title("Signals with random offset and uniform noise") +%! xlabel("Sample Nr [k]"); ylabel("Amplitude [V]"); +%! legend(labels{:}, "location", "southoutside") +%! legend("boxon") + +%!demo +%! clf +%! x = linspace (0, 10); +%! plot (x, x); +%! hold ("on"); +%! stem (x, x.^2, 'g') +%! legend ("linear"); +%! hold ("off"); + +%!demo +%! clf +%! x = linspace (0, 10); +%! plot (x, x, x, x.^2); +%! legend ("linear"); + +%!demo +%! clf +%! x = linspace (0, 10); +%! plot (x, x, x, x.^2); +%! legend ("linear", "quadratic"); + +%!demo +%! clf +%! rand_2x3_data1 = [0.341447, 0.171220, 0.284370; 0.039773, 0.731725, 0.779382]; +%! bar (rand_2x3_data1); +%! ylim ([0 1.0]); +%! legend ({"1st Bar", "2nd Bar", "3rd Bar"}); + +%!demo +%! clf +%! rand_2x3_data2 = [0.44804, 0.84368, 0.23012; 0.72311, 0.58335, 0.90531]; +%! bar (rand_2x3_data2); +%! ylim ([0 1.2]); +%! legend ("1st Bar", "2nd Bar", "3rd Bar"); +%! legend right + +%!demo +%! clf +%! x = 0:0.1:7; +%! h = plot (x, sin(x), x, cos(x), x, sin(x.^2/10), x, cos(x.^2/10)); +%! title ("Only the sin() objects have keylabels"); +%! legend (h([1, 3]), {"sin(x)", "sin(x^2/10)"}, "location", "southwest"); + +%!demo +%! clf +%! x = 0:0.1:10; +%! plot (x, sin(x), ";sin(x);") +%! hold all +%! plot (x, cos(x), ";cos(x);") +%! hold off + +%!demo +%! clf +%! x = 0:0.1:10; +%! plot (x, sin(x), ";sin(x);") +%! hold all +%! plot (x, cos(x), ";cos(x);") +%! hold off +%! legend ({"sin(x)", "cos(x)"}, "location", "northeastoutside") + +%!demo +%! clf +%! x = 0:10; +%! plot (x, rand (11)); +%! xlabel ("Indices") +%! ylabel ("Random Values") +%! title ("Legend ""off"" should delete the legend") +%! legend (cellstr (num2str ((1:10)')), "location", "northeastoutside") +%! legend off +%! axis ([0, 10, 0 1]) + +%!demo +%! clf +%! x = 1:5; +%! subplot (2, 2, 1) +%! plot (x, rand (numel (x))); +%! legend (cellstr (num2str (x')), "location", "northwestoutside") +%! legend boxon +%! subplot (2, 2, 2) +%! plot (x, rand (numel (x))); +%! legend (cellstr (num2str (x')), "location", "northeastoutside") +%! legend boxon +%! subplot (2, 2, 3); +%! plot (x, rand (numel (x))); +%! legend (cellstr (num2str (x')), "location", "southwestoutside") +%! legend boxon +%! subplot (2, 2, 4) +%! plot (x, rand (numel (x))); +%! legend (cellstr (num2str (x')), "location", "southeastoutside") +%! legend boxon + +%!demo +%! clf +%! plot (rand (2)) +%! title ("Warn of extra labels") +%! legend ("Hello", "World", "interpreter", "foobar") + +%!demo +%! clf +%! plot (rand (2)) +%! title ("Turn off TeX interpreter") +%! h = legend ("Hello_World", "foo^bar"); +%! set (h, "interpreter", "none") + diff --git a/octave_packages/m/plot/line.m b/octave_packages/m/plot/line.m new file mode 100644 index 0000000..ccc4a47 --- /dev/null +++ b/octave_packages/m/plot/line.m @@ -0,0 +1,59 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} line () +## @deftypefnx {Function File} {} line (@var{x}, @var{y}) +## @deftypefnx {Function File} {} line (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {} line (@var{x}, @var{y}, @var{z}, @var{property}, @var{value}, @dots{}) +## Create line object from @var{x} and @var{y} and insert in current +## axes object. Return a handle (or vector of handles) to the line +## objects created. +## +## Multiple property-value pairs may be specified for the line, but they +## must appear in pairs. +## @end deftypefn + +## Author: jwe + +function h = line (varargin) + + ## make a default line object, and make it the current axes for + ## the current figure. + tmp = __line__ (gca (), varargin{:}); + + if (nargout > 0) + h = tmp; + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = line; +%! assert (findobj (hf, "type", "line"), h); +%! assert (get (h, "xdata"), [0 1], eps); +%! assert (get (h, "ydata"), [0 1], eps); +%! assert (get (h, "type"), "line"); +%! assert (get (h, "color"), get (0, "defaultlinecolor")); +%! assert (get (h, "linestyle"), get (0, "defaultlinelinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultlinelinewidth"), eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/linkprop.m b/octave_packages/m/plot/linkprop.m new file mode 100644 index 0000000..facda4d --- /dev/null +++ b/octave_packages/m/plot/linkprop.m @@ -0,0 +1,98 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hlink} =} linkprop (@var{h}, @var{prop}) +## Link graphics object properties, such that a change in one is +## propagated to the others. The properties to link are given as a +## string of cell string array by @var{prop} and the objects containing +## these properties by the handle array @var{h}. +## +## An example of the use of linkprop is +## +## @example +## @group +## x = 0:0.1:10; +## subplot (1,2,1); +## h1 = plot (x, sin (x)); +## subplot (1,2,2); +## h2 = plot (x, cos (x)); +## hlink = linkprop ([h1, h2], @{"color","linestyle"@}); +## set (h1, "color", "green"); +## set (h2, "linestyle", "--"); +## @end group +## @end example +## +## @end deftypefn + +function hlink = linkprop (h, prop) + if (ischar (prop)) + prop = {prop}; + elseif (!iscellstr (prop)) + error ("linkprop: properties must be a string or cell string array"); + endif + + for i = 1 : numel (h) + for j = 1 : numel (prop) + addlistener (h(i), prop{j}, {@update_prop, h, prop{j}}); + endfor + endfor + + ## This should be an object that when destroyed removes the links + ## The below is not quite right. As when you call "clear hlink" the + ## hggroup continues to exist. + hlink = hggroup (); + set (hlink, "deletefcn", {@delete_prop, h, prop}); +endfunction + +function update_prop (h, d, hlist, prop) + persistent recursion = false; + + ## Don't allow recursion + if (! recursion) + unwind_protect + recursion = true; + val = get (h, prop); + for hh = hlist(:)' + if (hh != h) + oldval = get (hh, prop); + if (! isequal (val, oldval)) + set (hh, prop, val); + endif + endif + endfor + unwind_protect_cleanup + recursion = false; + end_unwind_protect + endif +endfunction + +function delete_prop (h, d, hlist, prop) + ## FIXME. Actually need to delete the linked properties. + ## However, only warn if the graphics objects aren't being deleted. + warn = false; + for h = hlist(:)' + if (ishandle (h) && !strcmpi (get (h, "beingdeleted"), "on")) + warn = true; + break; + endif + endfor + if (warn) + warning ("linkprop: can not remove linked properties"); + endif +endfunction diff --git a/octave_packages/m/plot/loglog.m b/octave_packages/m/plot/loglog.m new file mode 100644 index 0000000..c0071b7 --- /dev/null +++ b/octave_packages/m/plot/loglog.m @@ -0,0 +1,109 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} loglog (@var{y}) +## @deftypefnx {Function File} {} loglog (@var{x}, @var{y}) +## @deftypefnx {Function File} {} loglog (@var{x}, @var{y}, @var{property}, @var{value}, @dots{}) +## @deftypefnx {Function File} {} loglog (@var{x}, @var{y}, @var{fmt}) +## @deftypefnx {Function File} {} loglog (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} loglog (@dots{}) +## Produce a two-dimensional plot using log scales for both axes. See +## the documentation of @code{plot} for a description of the arguments +## that @code{loglog} will accept. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## @seealso{plot, semilogx, semilogy} +## @end deftypefn + +## Author: jwe + +function retval = loglog (varargin) + + [h, varargin, nargs] = __plt_get_axis_arg__ ("loglog", varargin{:}); + + if (nargs < 1) + print_usage(); + endif + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + set (h, "xscale", "log", "yscale", "log"); + if (any( strcmp (get (gca, "nextplot"), {"new", "replace"}))) + set (h, "xminortick", "on", "yminortick", "on"); + endif + + tmp = __plt__ ("loglog", h, varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +%!demo +%! clf (); +%! t = 1:0.01:10; +%! x = sort ((t .* (1 + rand (size (t)))) .^ 2); +%! y = ((t .* (1 + rand (size (t)))) .^ 2); +%! loglog (x, y); + +%!demo +%! clf (); +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1) +%! loglog (a, b) +%! xlabel ('loglog (a, b)') +%! +%! subplot (1, 2, 2) +%! loglog (a, abs (b)) +%! set (gca, 'ydir', 'reverse') +%! xlabel ('loglog (a, abs (b))') + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! loglog (a, b) +%! assert (get (gca, "yscale"), "log"); +%! assert (get (gca, "xscale"), "log"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! loglog (a, b) +%! axis tight +%! assert (all (get (gca, "ytick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/loglogerr.m b/octave_packages/m/plot/loglogerr.m new file mode 100644 index 0000000..d3732ef --- /dev/null +++ b/octave_packages/m/plot/loglogerr.m @@ -0,0 +1,71 @@ +## Copyright (C) 2000-2012 Teemu Ikonen +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} loglogerr (@var{args}) +## Produce two-dimensional plots on double logarithm axis with +## errorbars. Many different combinations of arguments are possible. +## The most used form is +## +## @example +## loglogerr (@var{x}, @var{y}, @var{ey}, @var{fmt}) +## @end example +## +## @noindent +## which produces a double logarithm plot of @var{y} versus @var{x} +## with errors in the @var{y}-scale defined by @var{ey} and the plot +## format defined by @var{fmt}. See errorbar for available formats and +## additional information. +## @seealso{errorbar, semilogxerr, semilogyerr} +## @end deftypefn + +## Created: 20.2.2001 +## Author: Teemu Ikonen +## Keywords: errorbar, plotting + +function retval = loglogerr (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("loglogerr", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + set (h, "xscale", "log", "yscale", "log"); + + tmp = __errcomm__ ("loglogerr", h, varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +%!demo +%! clf +%! x = exp (log(0.01):0.2:log(10)); +%! y = wblpdf (x, 3, 2); +%! eyu = 2*rand (size (y)) .* y; +%! eyl = 0.5*rand (size (y)) .* y; +%! loglogerr (x, y, eyl, eyu, "#~x-") +%! xlim (x([1, end])) + diff --git a/octave_packages/m/plot/mesh.m b/octave_packages/m/plot/mesh.m new file mode 100644 index 0000000..69623c1 --- /dev/null +++ b/octave_packages/m/plot/mesh.m @@ -0,0 +1,67 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mesh (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {} mesh (@var{z}) +## @deftypefnx {Function File} {} mesh (@dots{}, @var{c}) +## @deftypefnx {Function File} {} mesh (@var{hax}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} mesh (@dots{}) +## Plot a mesh given matrices @var{x}, and @var{y} from @code{meshgrid} and +## a matrix @var{z} corresponding to the @var{x} and @var{y} coordinates of +## the mesh. If @var{x} and @var{y} are vectors, then a typical vertex +## is (@var{x}(j), @var{y}(i), @var{z}(i,j)). Thus, columns of @var{z} +## correspond to different @var{x} values and rows of @var{z} correspond +## to different @var{y} values. +## +## The color of the mesh is derived from the @code{colormap} +## and the value of @var{z}. Optionally the color of the mesh can be +## specified independent of @var{z}, by adding a fourth matrix, @var{c}. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. +## @seealso{colormap, contour, meshgrid, surf} +## @end deftypefn + +## Author: jwe + +function h = mesh (varargin) + + newplot (); + + tmp = surface (varargin{:}); + + ax = get (tmp, "parent"); + + set (tmp, "facecolor", "w"); + set (tmp, "edgecolor", "flat"); + + if (! ishold ()) + set (ax, "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + + if (nargout > 0) + h = tmp; + endif + +endfunction + + +%% FIXME: Need demo or test for function + diff --git a/octave_packages/m/plot/meshc.m b/octave_packages/m/plot/meshc.m new file mode 100644 index 0000000..0ce9034 --- /dev/null +++ b/octave_packages/m/plot/meshc.m @@ -0,0 +1,61 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} meshc (@var{x}, @var{y}, @var{z}) +## Plot a mesh and contour given matrices @var{x}, and @var{y} from +## @code{meshgrid} and a matrix @var{z} corresponding to the @var{x} and +## @var{y} coordinates of the mesh. If @var{x} and @var{y} are vectors, +## then a typical vertex is (@var{x}(j), @var{y}(i), @var{z}(i,j)). Thus, +## columns of @var{z} correspond to different @var{x} values and rows of +## @var{z} correspond to different @var{y} values. +## @seealso{meshgrid, mesh, contour} +## @end deftypefn + +function h = meshc (varargin) + + newplot (); + + tmp = surface (varargin{:}); + + ax = get (tmp, "parent"); + + set (tmp, "facecolor", "w"); + set (tmp, "edgecolor", "flat"); + ## FIXME - gnuplot does not support a filled surface and a + ## non-filled contour. 3D filled patches are also not supported. + ## Thus, the facecolor will be transparent for the gnuplot + ## backend. + + if (! ishold ()) + set (ax, "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + + drawnow (); + zmin = get (ax, "zlim")(1); + + [c, tmp2] = __contour__ (ax, zmin, varargin{:}); + + tmp = [tmp; tmp2]; + + if (nargout > 0) + h = tmp; + endif + +endfunction diff --git a/octave_packages/m/plot/meshgrid.m b/octave_packages/m/plot/meshgrid.m new file mode 100644 index 0000000..58b86d9 --- /dev/null +++ b/octave_packages/m/plot/meshgrid.m @@ -0,0 +1,103 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{xx}, @var{yy}, @var{zz}] =} meshgrid (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {[@var{xx}, @var{yy}] =} meshgrid (@var{x}, @var{y}) +## @deftypefnx {Function File} {[@var{xx}, @var{yy}] =} meshgrid (@var{x}) +## Given vectors of @var{x} and @var{y} and @var{z} coordinates, and +## returning 3 arguments, return three-dimensional arrays corresponding +## to the @var{x}, @var{y}, and @var{z} coordinates of a mesh. When +## returning only 2 arguments, return matrices corresponding to the +## @var{x} and @var{y} coordinates of a mesh. The rows of @var{xx} are +## copies of @var{x}, and the columns of @var{yy} are copies of @var{y}. +## If @var{y} is omitted, then it is assumed to be the same as @var{x}, +## and @var{z} is assumed the same as @var{y}. +## @seealso{mesh, contour} +## @end deftypefn + +## Author: jwe + +function [xx, yy, zz] = meshgrid (x, y, z) + + if (nargin == 0 || nargin > 3) + print_usage (); + endif + + if (nargin < 2) + y = x; + endif + + ## Use repmat to ensure that the result values have the same type as + ## the arguments. + + if (nargout < 3) + if (isvector (x) && isvector (y)) + xx = repmat (x(:).', length (y), 1); + yy = repmat (y(:), 1, length (x)); + else + error ("meshgrid: arguments must be vectors"); + endif + else + if (nargin < 3) + z = y; + endif + if (isvector (x) && isvector (y) && isvector (z)) + lenx = length (x); + leny = length (y); + lenz = length (z); + xx = repmat (repmat (x(:).', leny, 1), [1, 1, lenz]); + yy = repmat (repmat (y(:), 1, lenx), [1, 1, lenz]); + zz = reshape (repmat (z(:).', lenx*leny, 1)(:), leny, lenx, lenz); + else + error ("meshgrid: arguments must be vectors"); + endif + endif + +endfunction + +%!test +%! x = 1:2; +%! y = 1:3; +%! z = 1:4; +%! [XX, YY, ZZ] = meshgrid (x, y, z); +%! assert (size_equal (XX, YY, ZZ)); +%! assert (ndims (XX), 3); +%! assert (size (XX), [3, 2, 4]); +%! assert (XX(1) * YY(1) * ZZ(1), x(1) * y(1) * z(1)); +%! assert (XX(end) * YY(end) * ZZ(end), x(end) * y(end) * z(end)); + +%!test +%! x = 1:2; +%! y = 1:3; +%! [XX, YY] = meshgrid (x, y); +%! assert (size_equal (XX, YY)); +%! assert (ndims (XX), 2); +%! assert (size (XX), [3, 2]); +%! assert (XX(1) * YY(1), x(1) * y(1)); +%! assert (XX(end) * YY(end), x(end) * y(end)); + +%!test +%! x = 1:3; +%! [XX1, YY1] = meshgrid (x, x); +%! [XX2, YY2] = meshgrid (x); +%! assert (size_equal (XX1, XX2, YY1, YY2)); +%! assert (ndims (XX1), 2); +%! assert (size (XX1), [3, 3]); +%! assert (XX1, XX2); +%! assert (YY1, YY2); \ No newline at end of file diff --git a/octave_packages/m/plot/meshz.m b/octave_packages/m/plot/meshz.m new file mode 100644 index 0000000..c44e5d9 --- /dev/null +++ b/octave_packages/m/plot/meshz.m @@ -0,0 +1,88 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} meshz (@var{x}, @var{y}, @var{z}) +## Plot a curtain mesh given matrices @var{x}, and @var{y} from +## @code{meshgrid} and a matrix @var{z} corresponding to the @var{x} and +## @var{y} coordinates of the mesh. If @var{x} and @var{y} are vectors, +## then a typical vertex is (@var{x}(j), @var{y}(i), @var{z}(i,j)). Thus, +## columns of @var{z} correspond to different @var{x} values and rows of +## @var{z} correspond to different @var{y} values. +## @seealso{meshgrid, mesh, contour} +## @end deftypefn + +function retval = meshz (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("meshz", varargin{:}); + + ioff = nargin + 1; + for i = 1:nargin + if (ischar (varargin{i})) + ioff = i; + break; + endif + endfor + + ## Bundle C matrix back into varargin + if (ioff == 3 || ioff == 5) + ioff --; + endif + + if (ioff == 2) + z = varargin{1}; + [m, n] = size (z); + x = 1:n; + y = (1:m).'; + else + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + endif + + + if (isvector (x) && isvector (y)) + x = [x(1), x(:).', x(end)]; + y = [y(1); y(:); y(end)]; + else + x = [x(1, 1), x(1, :), x(1, end); + x(:, 1), x, x(:, end); + x(end, 1), x(end, :), x(end, end)]; + y = [y(1, 1), y(1, :), y(1, end); + y(:, 1), y, y(:, end); + y(end, 1), y(end, :), y(end, end)]; + endif + + zref = min(z(isfinite(z))); + z = [zref .* ones(1, size(z, 2) + 2); + zref .* ones(size(z, 1), 1), z, zref .* ones(size(z, 1), 1); + zref.* ones(1, size(z, 2) + 2)]; + + oldh = gca (); + unwind_protect + axes (h); + tmp = mesh (x, y, z, varargin{ioff:end}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + retval = tmp; + endif + +endfunction diff --git a/octave_packages/m/plot/ndgrid.m b/octave_packages/m/plot/ndgrid.m new file mode 100644 index 0000000..32aeeb4 --- /dev/null +++ b/octave_packages/m/plot/ndgrid.m @@ -0,0 +1,97 @@ +## Copyright (C) 2006-2012 Alexander Barth +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y1}, @var{y2}, @dots{}, @var{y}n] =} ndgrid (@var{x1}, @var{x2}, @dots{}, @var{x}n) +## @deftypefnx {Function File} {[@var{y1}, @var{y2}, @dots{}, @var{y}n] =} ndgrid (@var{x}) +## Given n vectors @var{x1}, @dots{} @var{x}n, @code{ndgrid} returns +## n arrays of dimension n. The elements of the i-th output argument +## contains the elements of the vector @var{x}i repeated over all +## dimensions different from the i-th dimension. Calling ndgrid with +## only one input argument @var{x} is equivalent of calling ndgrid with +## all n input arguments equal to @var{x}: +## +## [@var{y1}, @var{y2}, @dots{}, @var{y}n] = ndgrid (@var{x}, @dots{}, @var{x}) +## @seealso{meshgrid} +## @end deftypefn + +## Author: Alexander Barth + +function varargout = ndgrid (varargin) + + if (nargin == 1) + n = max ([nargout, 2]); + ## If only one input argument is given, repeat it n-times + varargin(1:n) = varargin(1); + elseif (nargin >= nargout) + n = max ([nargin, 2]); + else + error ("ndgrid: wrong number of input arguments"); + endif + + ## Determine the size of the output arguments + + shape = zeros (1, n); + + for i = 1:n + if (! isvector (varargin{i})) + error ("ndgrid: arguments must be vectors"); + endif + + shape(i) = length (varargin{i}); + endfor + + for i = 1:n + ## size for reshape + r = ones (1, n); + r(i) = shape(i); + + ## size for repmat + s = shape; + s(i) = 1; + + varargout{i} = repmat (reshape (varargin{i}, r), s); + endfor + +endfunction + +%!test +%! x = 1:2; +%! y = 1:3; +%! z = 1:4; +%! [XX, YY, ZZ] = ndgrid (x, y, z); +%! assert (size_equal (XX, YY, ZZ)); +%! assert (ndims (XX), 3); +%! assert (size (XX), [2, 3, 4]); +%! assert (XX(1) * YY(1) * ZZ(1), x(1) * y(1) * z(1)); +%! assert (XX(end) * YY(end) * ZZ(end), x(end) * y(end) * z(end)); + +%!test +%! x = 1:2; +%! y = 1:3; +%! [XX1, YY1] = meshgrid (x, y); +%! [XX2, YY2] = ndgrid (x, y); +%! assert (size_equal (XX1, YY1)); +%! assert (size_equal (XX2, YY2)); +%! assert (ndims (XX1), 2); +%! assert (size (XX1), [3, 2]); +%! assert (size (XX2), [2, 3]); +%! assert (XX2(1) * YY2(1), x(1) * y(1)); +%! assert (XX2(end) * YY2(end), x(end) * y(end)); +%! assert (XX1, XX2.'); +%! assert (YY1, YY2.'); diff --git a/octave_packages/m/plot/newplot.m b/octave_packages/m/plot/newplot.m new file mode 100644 index 0000000..677a483 --- /dev/null +++ b/octave_packages/m/plot/newplot.m @@ -0,0 +1,76 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} newplot () +## Prepare graphics engine to produce a new plot. This function is +## called at the beginning of all high-level plotting functions. +## It is not normally required in user programs. +## @end deftypefn + +function newplot () + + if (nargin == 0) + cf = gcf (); + fnp = get (cf, "nextplot"); + switch (fnp) + ## FIXME -- probably we should do more than validate the nextplot + ## property value... + case "new" + case "add" + case "replacechildren" + delete (get (cf, "children")); + case "replace" + otherwise + error ("newplot: unrecognized nextplot property for current figure"); + endswitch + ca = gca (); + anp = get (ca, "nextplot"); + if (strcmp (get (ca, "__hold_all__"), "off")) + __next_line_color__ (true); + __next_line_style__ (true); + else + __next_line_color__ (false); + __next_line_style__ (false); + endif + switch (anp) + case "new" + case "add" + case "replacechildren" + delete (get (ca, "children")); + case "replace" + __go_axes_init__ (ca, "replace"); + __request_drawnow__ (); + otherwise + error ("newplot: unrecognized nextplot property for current axes"); + endswitch + else + print_usage (); + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! p = plot ([0, 1]); +%! newplot; +%! assert (isempty (get (gca, "children"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/orient.m b/octave_packages/m/plot/orient.m new file mode 100644 index 0000000..d71122a --- /dev/null +++ b/octave_packages/m/plot/orient.m @@ -0,0 +1,109 @@ +## Copyright (C) 2001-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} orient (@var{orientation}) +## Set the default print orientation. Valid values for +## @var{orientation} include @code{"landscape"}, @code{"portrait"}, +## and @code{"tall"}. +## +## The @code{"tall"} option sets the orientation to portait and fills +## the page with the plot, while leaving a 0.25in border. +## +## If called with no arguments, return the default print orientation. +## @end deftypefn + +## Author: Paul Kienzle +## Adapted-By: jwe + +function retval = orient (varargin) + + nargs = nargin; + + if (nargs > 0 && numel (varargin{1}) == 1 && isfigure (varargin{1})) + cf = varargin{1}; + varargin(1) = []; + nargs--; + else + cf = gcf (); + endif + + if (nargs == 0) + retval = get (cf, "paperorientation"); + elseif (nargin == 1) + orientation = varargin{1}; + if (strcmpi (orientation, "landscape") || strcmpi (orientation, "portrait")) + if (! strcmpi (get (cf, "paperorientation"), orientation)) + ## FIXME - with the proper listeners in place there won't be a need to set + ## the papersize and paperpostion here. + papersize = get (cf, "papersize"); + paperposition = get (cf, "paperposition"); + set (cf, "paperorientation", orientation); + set (cf, "papersize", papersize([2, 1])); + set (cf, "paperposition", paperposition([2, 1, 4, 3])); + endif + elseif (strcmpi (varargin{1}, 'tall')) + orient ("portrait"); + papersize = get (cf, "papersize"); + set (cf, "paperposition", [0.25, 0.25, (papersize - 0.5)]); + else + error ("orient: unknown ORIENTATION"); + endif + else + print_usage (); + endif + +endfunction + +%!shared papersize, paperposition, tallpaperposition, hfig +%! papersize = [8.5, 11]; +%! paperposition = [0.25, 2.5, 8, 6]; +%! tallpaperposition = [0.25, 0.25, (papersize-0.5)]; +%! hfig = figure (); +%! set (hfig, "visible", "off") +%! set (hfig, "paperorientation", "portrait") +%! set (hfig, "papersize", papersize) +%! set (hfig, "paperposition", paperposition) +%!test +%! orient portrait +%! assert (orient, "portrait") # default +%! assert (get (hfig, "papersize"), papersize) +%! assert (get (hfig, "paperposition"), paperposition) +%!test +%! orient landscape +%! assert (orient,"landscape") # change to landscape +%! assert (get (hfig, "papersize"), papersize([2, 1])) +%! assert (get (hfig, "paperposition"), paperposition([2, 1, 4, 3])) +%!test +%! orient portrait # change back to portrait +%! assert (orient, "portrait") +%! assert (get (hfig, "papersize"), papersize) +%! assert (get (hfig, "paperposition"), paperposition) +%!test +%! orient landscape +%! orient tall +%! assert (orient, "portrait") +%! assert (get (hfig, "papersize"), papersize) +%! assert (get (hfig, "paperposition"), tallpaperposition) +%!fail ("orient ('nobody')", "unknown ORIENTATION") +%!test +%! orient portrait # errors don't change the state +%! assert (orient, "portrait") +%! assert (get (hfig, "papersize"), papersize) +%! assert (get (hfig, "paperposition"), tallpaperposition) +%! close (hfig) diff --git a/octave_packages/m/plot/pareto.m b/octave_packages/m/plot/pareto.m new file mode 100644 index 0000000..ec6749d --- /dev/null +++ b/octave_packages/m/plot/pareto.m @@ -0,0 +1,122 @@ +## Copyright (C) 2007-2012 David Bateman +## Copyright (C) 2003 Alberto Terruzzi +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pareto (@var{x}) +## @deftypefnx {Function File} {} pareto (@var{x}, @var{y}) +## @deftypefnx {Function File} {} pareto (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} pareto (@dots{}) +## Draw a Pareto chart, also called ABC chart. A Pareto chart is a bar graph +## used to arrange information in such a way that priorities for process +## improvement can be established. It organizes and displays information +## to show the relative importance of data. The chart is similar to the +## histogram or bar chart, except that the bars are arranged in decreasing +## order from left to right along the abscissa. +## +## The fundamental idea (Pareto principle) behind the use of Pareto +## diagrams is that the majority of an effect is due to a small subset of the +## causes, so for quality improvement the first few (as presented on the +## diagram) contributing causes to a problem usually account for the majority +## of the result. Thus, targeting these "major causes" for elimination +## results in the most cost-effective improvement scheme. +## +## The data are passed as @var{x} and the abscissa as @var{y}. If @var{y} is +## absent, then the abscissa are assumed to be @code{1 : length (@var{x})}. +## @var{y} can be a string array, a cell array of strings or a numerical +## vector. +## +## The optional return value @var{h} is a 2-element vector with a graphics +## handle for the created bar plot and a second handle for the created line +## plot. +## +## An example of the use of @code{pareto} is +## +## @example +## @group +## Cheese = @{"Cheddar", "Swiss", "Camembert", ... +## "Munster", "Stilton", "Blue"@}; +## Sold = [105, 30, 70, 10, 15, 20]; +## pareto (Sold, Cheese); +## @end group +## @end example +## @end deftypefn + +function h = pareto (varargin) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + x = varargin {1}(:).'; + if (nargin == 2) + y = varargin {2}(:).'; + if (! iscell (y)) + if (ischar (y)) + y = cellstr (y); + else + y = cellfun ("num2str", num2cell (y), "uniformoutput", false); + endif + endif + else + y = cellfun ("int2str", num2cell (1 : numel(x)), + "uniformoutput", false); + endif + + [x, idx] = sort (x, "descend"); + y = y (idx); + cdf = cumsum (x); + maxcdf = max(cdf); + cdf = cdf ./ maxcdf; + cdf95 = cdf - 0.95; + idx95 = find(sign(cdf95(1:end-1)) != sign(cdf95(2:end)))(1); + + [ax, hbar, hline] = plotyy (1 : idx95, x (1 : idx95), + 1 : length(cdf), 100 .* cdf, + @bar, @plot); + + axis (ax(1), [1 - 0.6, idx95 + 0.6, 0, maxcdf]); + axis (ax(2), [1 - 0.6, idx95 + 0.6, 0, 100]); + set (ax(2), "ytick", [0, 20, 40, 60, 80, 100], + "yticklabel", {"0%", "20%", "40%", "60%", "80%", "100%"}); + set (ax(1), "xtick", 1 : idx95, "xticklabel", y (1: idx95)); + set (ax(2), "xtick", 1 : idx95, "xticklabel", y (1: idx95)); + + if (nargout > 0) + h = [hbar; hline]; + endif + +endfunction + + +%!demo +%! clf +%! colormap (jet (64)); +%! Cheese = {"Cheddar", "Swiss", "Camembert", "Munster", "Stilton", "Blue"}; +%! Sold = [105, 30, 70, 10, 15, 20]; +%! pareto (Sold, Cheese); + +%!demo +%! clf +%! % Suppose that we want establish which products makes 80 % of turnover. +%! Codes = {"AB4","BD7","CF8","CC5","AD11","BB5","BB3","AD8","DF3","DE7"}; +%! Value = [2.35 7.9 2.45 1.1 0.15 13.45 5.4 2.05 0.85 1.65]'; +%! SoldUnits = [54723 41114 16939 1576091 168000 687197 120222 168195, ... +%! 1084118 55576]'; +%! pareto (Value.*SoldUnits, Codes); + diff --git a/octave_packages/m/plot/patch.m b/octave_packages/m/plot/patch.m new file mode 100644 index 0000000..f23ab67 --- /dev/null +++ b/octave_packages/m/plot/patch.m @@ -0,0 +1,235 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} patch () +## @deftypefnx {Function File} {} patch (@var{x}, @var{y}, @var{c}) +## @deftypefnx {Function File} {} patch (@var{x}, @var{y}, @var{z}, @var{c}) +## @deftypefnx {Function File} {} patch (@var{fv}) +## @deftypefnx {Function File} {} patch ('Faces', @var{f}, 'Vertices', @var{v}, @dots{}) +## @deftypefnx {Function File} {} patch (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {} patch (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} patch (@dots{}) +## Create patch object from @var{x} and @var{y} with color @var{c} and +## insert in the current axes object. Return handle to patch object. +## +## For a uniform colored patch, @var{c} can be given as an RGB vector, +## scalar value referring to the current colormap, or string value (for +## example, "r" or "red"). +## +## If passed a structure @var{fv} contain the fields "vertices", "faces" +## and optionally "facevertexcdata", create the patch based on these +## properties. +## +## The optional return value @var{h} is a graphics handle to the created patch +## object. +## @seealso{fill} +## @end deftypefn + +## Author: jwe + +function retval = patch (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("patch", varargin{:}); + + [tmp, failed] = __patch__ (h, varargin{:}); + + if (failed) + print_usage (); + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + +%!demo +%! ## Patches with same number of vertices +%! clf +%! t1 = (1/16:1/8:1)'*2*pi; +%! t2 = ((1/16:1/8:1)' + 1/32)*2*pi; +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); +%! patch([x1,x2],[y1,y2],'r'); + +%!demo +%! ## Unclosed patch +%! clf +%! t1 = (1/16:1/8:1)'*2*pi; +%! t2 = ((1/16:1/16:1)' + 1/32)*2*pi; +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); +%! patch([[x1;NaN(8,1)],x2],[[y1;NaN(8,1)],y2],'r'); + +%!demo +%! ## Specify vertices and faces separately +%! clf +%! t1 = (1/16:1/8:1)'*2*pi; +%! t2 = ((1/16:1/16:1)' + 1/32)*2*pi; +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); +%! vert = [x1, y1; x2, y2]; +%! fac = [1:8,NaN(1,8);9:24]; +%! patch('Faces',fac,'Vertices',vert,'FaceColor','r'); + +%!demo +%! ## Specify vertices and faces separately +%! clf +%! t1 = (1/16:1/8:1)'*2*pi; +%! t2 = ((1/16:1/16:1)' + 1/32)*2*pi; +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); +%! vert = [x1, y1; x2, y2]; +%! fac = [1:8,NaN(1,8);9:24]; +%! patch('Faces',fac,'Vertices',vert,'FaceVertexCData', [0, 1, 0; 0, 0, 1]); + +%!demo +%! ## Property change on multiple patches +%! clf +%! t1 = (1/16:1/8:1)'*2*pi; +%! t2 = ((1/16:1/8:1)' + 1/32)*2*pi; +%! x1 = sin (t1) - 0.8; +%! y1 = cos (t1); +%! x2 = sin (t2) + 0.8; +%! y2 = cos (t2); +%! h = patch([x1,x2],[y1,y2],cat (3,[0,0],[1,0],[0,1])); +%! pause (1); +%! set (h, 'FaceColor', 'r'); + +%!demo +%! clf +%! vertices = [0, 0, 0; +%! 1, 0, 0; +%! 1, 1, 0; +%! 0, 1, 0; +%! 0.5, 0.5, 1]; +%! faces = [1, 2, 5; +%! 2, 3, 5; +%! 3, 4, 5; +%! 4, 1, 5]; +%! patch ('Vertices', vertices, 'Faces', faces, ... +%! 'FaceVertexCData', jet(4), 'FaceColor', 'flat'); +%! view (-37.5, 30); + +%!demo +%! clf +%! vertices = [0, 0, 0; +%! 1, 0, 0; +%! 1, 1, 0; +%! 0, 1, 0; +%! 0.5, 0.5, 1]; +%! faces = [1, 2, 5; +%! 2, 3, 5; +%! 3, 4, 5; +%! 4, 1, 5]; +%! patch ('Vertices', vertices, 'Faces', faces, ... +%! 'FaceVertexCData', jet(5), 'FaceColor', 'interp'); +%! view (-37.5, 30); + +%!demo +%! clf +%! colormap (jet); +%! x = [0 1 1 0]; +%! y = [0 0 1 1]; +%! subplot (2, 1, 1); +%! title ("Blue, Light-Green, and Red Horizontal Bars"); +%! patch (x, y + 0, 1); +%! patch (x, y + 1, 2); +%! patch (x, y + 2, 3); +%! subplot (2, 1, 2); +%! title ("Blue, Light-Green, and Red Vertical Bars"); +%! patch (x + 0, y, 1 * ones (size (x))); +%! patch (x + 1, y, 2 * ones (size (x))); +%! patch (x + 2, y, 3 * ones (size (x))); + +%!demo +%! clf +%! colormap (jet); +%! x = [0 1 1 0]; +%! y = [0 0 1 1]; +%! subplot (2, 1, 1); +%! title ("Blue horizontal bars: Dark to Light"); +%! patch (x, y + 0, 1, "cdatamapping", "direct"); +%! patch (x, y + 1, 9, "cdatamapping", "direct"); +%! patch (x, y + 2, 17, "cdatamapping", "direct"); +%! subplot (2, 1, 2); +%! title ("Blue vertical bars: Dark to Light") +%! patch (x + 0, y, 1 * ones (size (x)), "cdatamapping", "direct"); +%! patch (x + 1, y, 9 * ones (size (x)), "cdatamapping", "direct"); +%! patch (x + 2, y, 17 * ones (size (x)), "cdatamapping", "direct"); + +%!demo +%! clf; +%! colormap (jet); +%! x = [ 0 0; 1 1; 1 0 ]; +%! y = [ 0 0; 0 1; 1 1 ]; +%! p = patch (x, y, "facecolor", "b"); +%! title ("Two blue triangles"); +%! set (p, "cdatamapping", "direct", "facecolor", "flat", "cdata", [1 32]); +%! title ("Direct mapping of colors: Light-Green UL and Blue LR triangles"); + +%!demo +%! clf; +%! colormap (jet); +%! x = [ 0 0; 1 1; 1 0 ]; +%! y = [ 0 0; 0 1; 1 1 ]; +%! p = patch (x, y, [1 32]); +%! title ("Autoscaling of colors: Red UL and Blue LR triangles"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = patch; +%! assert (findobj (hf, "type", "patch"), h); +%! assert (get (h, "xdata"), [0; 1; 0], eps); +%! assert (get (h, "ydata"), [1; 1; 0], eps); +%! assert (isempty (get (h, "zdata"))); +%! assert (isempty (get (h, "cdata"))); +%! assert (get (h, "faces"), [1, 2, 3], eps); +%! assert (get (h, "vertices"), [0 1; 1 1; 0 0], eps); +%! assert (get (h, "type"), "patch"); +%! assert (get (h, "facecolor"), [0 0 0]); +%! assert (get (h, "linestyle"), get (0, "defaultpatchlinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultpatchlinewidth"), eps); +%! assert (get (h, "marker"), get (0, "defaultpatchmarker")); +%! assert (get (h, "markersize"), get (0, "defaultpatchmarkersize")); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! c = 0.9; +%! unwind_protect +%! h = patch ([0 1 0], [0 1 1], c); +%! assert (get (gca, "clim"), [c - 1, c + 1]); +%! h = patch ([0 1 0], [0 1 1], 2 * c); +%! assert (get (gca, "clim"), [c, 2 * c]); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/pbaspect.m b/octave_packages/m/plot/pbaspect.m new file mode 100644 index 0000000..37f5be7 --- /dev/null +++ b/octave_packages/m/plot/pbaspect.m @@ -0,0 +1,113 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pbaspect (@var{plot_box_aspect_ratio}) +## Set the plot box aspect ratio of the current axes. The aspect ratio +## is a normalized 3-element vector representing the rendered lengths of +## the x, y, and z-axes. +## +## @deftypefnx {Function File} {@var{plot_box_aspect_ratio} =} pbaspect ( ) +## Return the plot box aspect ratio of the current axes. +## +## @deftypefnx {Function File} {} pbaspect (@var{mode}) +## Set the plot box aspect ratio mode of the current axes. +## +## @deftypefnx {Function File} {@var{plot_box_aspect_ratio_mode} =} pbaspect ("mode") +## Return the plot box aspect ratio mode of the current axes. +## +## @deftypefnx {Function File} {} pbaspect (@var{hax}, @dots{}) +## Use the axes, with handle @var{hax}, instead of the current axes. +## +## @seealso{axis, daspect, xlim, ylim, zlim} +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-01-26 + +function varargout = pbaspect (varargin) + + hax = gca (); + + if (nargin > 0) + if (isscalar (varargin{1}) && ishandle (varargin{1})) + hax = varargin{1}; + varargin = varargin(2:end); + endif + endif + if (numel (varargin) > 0) + if (numel (varargin) == 1) + if (ischar (varargin{1}) + && any (strcmpi (varargin{1}, {"mode", "manual", "auto"}))) + switch (varargin{1}) + case "mode" + if (nargout < 2) + varargout{1} = get (hax, "plotboxaspectratiomode"); + return + else + error ("pbaspect: only one output is allowed"); + endif + case "manual" + set (hax, "plotboxaspectratiomode", "manual"); + case "auto" + set (hax, "plotboxaspectratiomode", "auto"); + endswitch + elseif (isreal (varargin{1}) && numel (varargin{1}) == 2) + set (hax, "plotboxaspectratio", [varargin{1}, 1]); + elseif (isreal (varargin{1}) && numel (varargin{1}) == 3) + set (hax, "plotboxaspectratio", varargin{1}); + else + error ("pbaspect: invalid input"); + endif + elseif (numel (varargin) > 1) + error ("pbaspect: too many inputs"); + endif + elseif (nargout == 0) + print_usage (); + endif + + if (nargout == 1) + varargout{1} = get (hax, "plotboxaspectratio"); + elseif (nargout > 1) + error ("pbaspect: only one output is allowed"); + endif + +endfunction + +%!demo +%! x = 0:0.01:4; +%! clf +%! plot (x, cos (x), x, sin (x)) +%! pbaspect ([1 1 1]) +%! title ("plot box should be square") + +%!demo +%! x = 0:0.01:4; +%! clf +%! plot (x, cos (x), x, sin (x)) +%! pbaspect ([2 1 1]) +%! title ("plot box aspect ratio should be 2x1") + +%!demo +%! x = 0:0.01:4; +%! clf +%! plot (x, cos (x), x, sin (x)) +%! daspect ([1 1 1]) +%! pbaspect ([2 1 1]) +%! title ("plot box should be 2x1, and axes [0 4 -1 1]") + diff --git a/octave_packages/m/plot/pcolor.m b/octave_packages/m/plot/pcolor.m new file mode 100644 index 0000000..6c2ccf5 --- /dev/null +++ b/octave_packages/m/plot/pcolor.m @@ -0,0 +1,94 @@ +## Copyright (C) 2007-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pcolor (@var{x}, @var{y}, @var{c}) +## @deftypefnx {Function File} {} pcolor (@var{c}) +## Density plot for given matrices @var{x}, and @var{y} from @code{meshgrid} and +## a matrix @var{c} corresponding to the @var{x} and @var{y} coordinates of +## the mesh's vertices. If @var{x} and @var{y} are vectors, then a typical +## vertex +## is (@var{x}(j), @var{y}(i), @var{c}(i,j)). Thus, columns of @var{c} +## correspond to different @var{x} values and rows of @var{c} correspond +## to different @var{y} values. +## +## The @code{colormap} is scaled to the extents of @var{c}. +## Limits may be placed on the color axis by the +## command @code{caxis}, or by setting the @code{clim} property of the +## parent axis. +## +## The face color of each cell of the mesh is determined by interpolating +## the values of @var{c} for the cell's vertices. Contrast this with +## @code{imagesc} which renders one cell for each element of @var{c}. +## +## @code{shading} modifies an attribute determining the manner by which the +## face color of each cell is interpolated from the values of @var{c}, +## and the visibility of the cells' edges. By default the attribute is +## "faceted", which renders a single color for each cell's face with the edge +## visible. +## +## @var{h} is the handle to the surface object. +## +## @seealso{caxis, contour, meshgrid, imagesc, shading} +## @end deftypefn + +## Author: Kai Habel + +function h = pcolor (x, y, c) + + newplot (); + + if (nargin == 1) + c = x; + [nr, nc] = size(c); + z = zeros (nr, nc); + [x, y] = meshgrid (1:nc, 1:nr); + elseif (nargin == 3) + z = zeros (size (c)); + else + print_usage (); + endif + + tmp = surface (x, y, z, c); + + ax = get (tmp, "parent"); + + set (tmp, "facecolor", "flat"); + set (ax, "box", "on"); + + if (! ishold ()) + set (ax, "view", [0, 90]); + endif + + if (nargout > 0) + h = tmp; + endif + +endfunction + +%!demo +%! clf +%! [~,~,Z]=peaks; +%! pcolor(Z); + +%!demo +%! clf +%! [X,Y,Z]=sombrero; +%! [Fx,Fy] = gradient(Z); +%! pcolor(X,Y,Fx+Fy); +%! shading interp; diff --git a/octave_packages/m/plot/peaks.m b/octave_packages/m/plot/peaks.m new file mode 100644 index 0000000..70e15cf --- /dev/null +++ b/octave_packages/m/plot/peaks.m @@ -0,0 +1,86 @@ +## Copyright (C) 2007-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} peaks () +## @deftypefnx {Function File} {} peaks (@var{n}) +## @deftypefnx {Function File} {} peaks (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{z} =} peaks (@dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{y}, @var{z}] =} peaks (@dots{}) +## Generate a function with lots of local maxima and minima. The function +## has the form +## +## @tex +## $f(x,y) = 3 (1 - x) ^ 2 e ^ {\left(-x^2 - (y+1)^2\right)} - 10 \left({x \over 5} - x^3 - y^5)\right) - {1 \over 3} e^{\left(-(x+1)^2 - y^2\right)}$ +## @end tex +## @ifnottex +## @verbatim +## f(x,y) = 3*(1-x)^2*exp(-x^2 - (y+1)^2) ... +## - 10*(x/5 - x^3 - y^5)*exp(-x^2-y^2) ... +## - 1/3*exp(-(x+1)^2 - y^2) +## @end verbatim +## @end ifnottex +## +## Called without a return argument, @code{peaks} plots the surface of the +## above function using @code{mesh}. If @var{n} is a scalar, the @code{peaks} +## returns the values of the above function on a @var{n}-by-@var{n} mesh over +## the range @code{[-3,3]}. The default value for @var{n} is 49. +## +## If @var{n} is a vector, then it represents the @var{x} and @var{y} values +## of the grid on which to calculate the above function. The @var{x} and +## @var{y} values can be specified separately. +## @seealso{surf, mesh, meshgrid} +## @end deftypefn + +## Expression for the peaks function was taken from the following paper: +## http://www.control.hut.fi/Kurssit/AS-74.115/Material/GENALGgoga.pdf + +function [X_out, Y_out, Z_out] = peaks (x, y) + + if (nargin == 0) + x = y = linspace (-3, 3, 49); + elseif (nargin == 1) + if length(x) > 1 + y = x; + else + x = y = linspace (-3, 3, x); + endif + endif + + if (isvector (x) && isvector (y)) + [X, Y] = meshgrid (x, y); + else + X = x; + Y = y; + endif + + Z = 3 * (1 - X) .^ 2 .* exp(- X .^ 2 - (Y + 1) .^ 2) \ + - 10 * (X / 5 - X .^ 3 - Y .^ 5) .* exp(- X .^ 2 - Y .^ 2) \ + - 1 / 3 * exp(- (X + 1) .^ 2 - Y .^ 2); + + if (nargout == 0) + surf (x, y, Z); + elseif (nargout == 1) + X_out = Z; + else + X_out = X; + Y_out = Y; + Z_out = Z; + endif + +endfunction diff --git a/octave_packages/m/plot/pie.m b/octave_packages/m/plot/pie.m new file mode 100644 index 0000000..6196d1b --- /dev/null +++ b/octave_packages/m/plot/pie.m @@ -0,0 +1,87 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pie (@var{x}) +## @deftypefnx {Function File} {} pie (@var{x}, @var{explode}) +## @deftypefnx {Function File} {} pie (@dots{}, @var{labels}) +## @deftypefnx {Function File} {} pie (@var{h}, @dots{}); +## @deftypefnx {Function File} {@var{h} =} pie (@dots{}); +## Produce a 2-D pie chart. +## +## Called with a single vector argument, produces a pie chart of the +## elements in @var{x}, with the size of the slice determined by percentage +## size of the values of @var{x}. +## +## The variable @var{explode} is a vector of the same length as @var{x} that +## if non zero 'explodes' the slice from the pie chart. +## +## If given @var{labels} is a cell array of strings of the same length as +## @var{x}, giving the labels of each of the slices of the pie chart. +## +## The optional return value @var{h} is a list of handles to the patch +## and text objects generating the plot. +## +## @seealso{pie3, bar, stem} +## @end deftypefn + +## Very roughly based on pie.m from octave-forge whose author was +## Daniel Heiserer + +function retval = pie (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("pie", varargin{:}); + + if (nargin < 1) + print_usage (); + else + oldh = gca (); + unwind_protect + axes (h); + newplot (); + tmp = __pie__ ("pie", h, varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!demo +%! clf +%! pie ([3, 2, 1], [0, 0, 1]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); + +%!demo +%! clf +%! pie ([3, 2, 1], [0, 0, 1], {"Cheddar", "Swiss", "Camembert"}); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); +%! axis ([-2,2,-2,2]); + +%!demo +%! clf +%! pie ([0.17, 0.34, 0.41], {"Cheddar", "Swiss", "Camembert"}); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); +%! axis ([-2,2,-2,2]); +%! title ("missing slice"); + diff --git a/octave_packages/m/plot/pie3.m b/octave_packages/m/plot/pie3.m new file mode 100644 index 0000000..a0fbdbe --- /dev/null +++ b/octave_packages/m/plot/pie3.m @@ -0,0 +1,88 @@ +## Copyright (C) 2007-2012 David Bateman +## Copyright (C) 2010 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pie3 (@var{x}) +## @deftypefnx {Function File} {} pie3 (@var{x}, @var{explode}) +## @deftypefnx {Function File} {} pie3 (@dots{}, @var{labels}) +## @deftypefnx {Function File} {} pie3 (@var{h}, @dots{}); +## @deftypefnx {Function File} {@var{h} =} pie3 (@dots{}); +## Draw a 3-D pie chart. +## +## Called with a single vector argument, produces a 3-D pie chart of the +## elements in @var{x}, with the size of the slice determined by percentage +## size of the values of @var{x}. +## +## The variable @var{explode} is a vector of the same length as @var{x} that +## if non zero 'explodes' the slice from the pie chart. +## +## If given @var{labels} is a cell array of strings of the same length as +## @var{x}, giving the labels of each of the slices of the pie chart. +## +## The optional return value @var{h} is a list of graphics handles to the patch, +## surface, and text objects generating the plot. +## +## @seealso{pie, bar, stem} +## @end deftypefn + +## Very roughly based on pie.m from octave-forge whose author was +## Daniel Heiserer + +function retval = pie3 (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("pie", varargin{:}); + + if (nargin < 1) + print_usage (); + else + oldh = gca (); + unwind_protect + axes (h); + newplot (); + tmp = __pie__ ("pie3", h, varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!demo +%! clf +%! pie3 ([5:-1:1], [0, 0, 1, 0, 0]); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); + +%!demo +%! clf +%! pie3 ([3, 2, 1], [0, 0, 1], {"Cheddar", "Swiss", "Camembert"}); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); +%! axis ([-2,2,-2,2]); + +%!demo +%! clf +%! pie3 ([0.17, 0.34, 0.41], {"Cheddar", "Swiss", "Camembert"}); +%! colormap ([1,0,0;0,1,0;0,0,1;1,1,0;1,0,1;0,1,1]); +%! axis ([-2,2,-2,2]); +%! title ("missing slice"); + diff --git a/octave_packages/m/plot/plot.m b/octave_packages/m/plot/plot.m new file mode 100644 index 0000000..d08df00 --- /dev/null +++ b/octave_packages/m/plot/plot.m @@ -0,0 +1,209 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} plot (@var{y}) +## @deftypefnx {Function File} {} plot (@var{x}, @var{y}) +## @deftypefnx {Function File} {} plot (@var{x}, @var{y}, @var{property}, @var{value}, @dots{}) +## @deftypefnx {Function File} {} plot (@var{x}, @var{y}, @var{fmt}) +## @deftypefnx {Function File} {} plot (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} plot (@dots{}) +## Produce two-dimensional plots. +## +## Many different combinations of arguments are possible. The simplest +## form is +## +## @example +## plot (@var{y}) +## @end example +## +## @noindent +## where the argument is taken as the set of @var{y} coordinates and the +## @var{x} coordinates are taken to be the indices of the elements +## starting with 1. +## +## To save a plot, in one of several image formats such as PostScript +## or PNG, use the @code{print} command. +## +## If more than one argument is given, they are interpreted as +## +## @example +## plot (@var{y}, @var{property}, @var{value}, @dots{}) +## @end example +## +## @noindent +## or +## +## @example +## plot (@var{x}, @var{y}, @var{property}, @var{value}, @dots{}) +## @end example +## +## @noindent +## or +## +## @example +## plot (@var{x}, @var{y}, @var{fmt}, @dots{}) +## @end example +## +## @noindent +## and so on. Any number of argument sets may appear. The @var{x} and +## @var{y} values are interpreted as follows: +## +## @itemize @bullet +## @item +## If a single data argument is supplied, it is taken as the set of @var{y} +## coordinates and the @var{x} coordinates are taken to be the indices of +## the elements, starting with 1. +## +## @item +## If the @var{x} is a vector and @var{y} is a matrix, then +## the columns (or rows) of @var{y} are plotted versus @var{x}. +## (using whichever combination matches, with columns tried first.) +## +## @item +## If the @var{x} is a matrix and @var{y} is a vector, +## @var{y} is plotted versus the columns (or rows) of @var{x}. +## (using whichever combination matches, with columns tried first.) +## +## @item +## If both arguments are vectors, the elements of @var{y} are plotted versus +## the elements of @var{x}. +## +## @item +## If both arguments are matrices, the columns of @var{y} are plotted +## versus the columns of @var{x}. In this case, both matrices must have +## the same number of rows and columns and no attempt is made to transpose +## the arguments to make the number of rows match. +## +## If both arguments are scalars, a single point is plotted. +## @end itemize +## +## Multiple property-value pairs may be specified, but they must appear +## in pairs. These arguments are applied to the lines drawn by +## @code{plot}. +## +## If the @var{fmt} argument is supplied, it is interpreted as +## follows. If @var{fmt} is missing, the default gnuplot line style +## is assumed. +## +## @table @samp +## @item - +## Set lines plot style (default). +## +## @item . +## Set dots plot style. +## +## @item @var{n} +## Interpreted as the plot color if @var{n} is an integer in the range 1 to +## 6. +## +## @item @var{nm} +## If @var{nm} is a two digit integer and @var{m} is an integer in the +## range 1 to 6, @var{m} is interpreted as the point style. This is only +## valid in combination with the @code{@@} or @code{-@@} specifiers. +## +## @item @var{c} +## If @var{c} is one of @code{"k"} (black), @code{"r"} (red), @code{"g"} +## (green), @code{"b"} (blue), @code{"m"} (magenta), @code{"c"} (cyan), +## or @code{"w"} (white), it is interpreted as the line plot color. +## +## @item ";title;" +## Here @code{"title"} is the label for the key. +## +## @item + +## @itemx * +## @itemx o +## @itemx x +## @itemx ^ +## Used in combination with the points or linespoints styles, set the point +## style. +## +## @item @@ +## Select the next unused point style. +## @end table +## +## The @var{fmt} argument may also be used to assign key titles. +## To do so, include the desired title between semi-colons after the +## formatting sequence described above, e.g., "+3;Key Title;" +## Note that the last semi-colon is required and will generate an error if +## it is left out. +## +## Here are some plot examples: +## +## @example +## plot (x, y, "@@12", x, y2, x, y3, "4", x, y4, "+") +## @end example +## +## This command will plot @code{y} with points of type 2 (displayed as +## @samp{+}) and color 1 (red), @code{y2} with lines, @code{y3} with lines of +## color 4 (magenta) and @code{y4} with points displayed as @samp{+}. +## +## @example +## plot (b, "*", "markersize", 3) +## @end example +## +## This command will plot the data in the variable @code{b}, +## with points displayed as @samp{*} with a marker size of 3. +## +## @example +## @group +## t = 0:0.1:6.3; +## plot (t, cos(t), "-;cos(t);", t, sin(t), "+3;sin(t);"); +## @end group +## @end example +## +## This will plot the cosine and sine functions and label them accordingly +## in the key. +## +## If the first argument is an axis handle, then plot into these axes, +## rather than the current axis handle returned by @code{gca}. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## +## @seealso{semilogx, semilogy, loglog, polar, mesh, contour, bar, +## stairs, errorbar, xlabel, ylabel, title, print} +## @end deftypefn + +## Author: jwe + +function retval = plot (varargin) + + [h, varargin, nargs] = __plt_get_axis_arg__ ("plot", varargin{:}); + + if (nargs < 1) + print_usage(); + endif + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + tmp = __plt__ ("plot", h, varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%% FIXME: Need demo or test for function + diff --git a/octave_packages/m/plot/plot3.m b/octave_packages/m/plot/plot3.m new file mode 100644 index 0000000..d259118 --- /dev/null +++ b/octave_packages/m/plot/plot3.m @@ -0,0 +1,345 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} plot3 (@var{args}) +## Produce three-dimensional plots. Many different combinations of +## arguments are possible. The simplest form is +## +## @example +## plot3 (@var{x}, @var{y}, @var{z}) +## @end example +## +## @noindent +## in which the arguments are taken to be the vertices of the points to +## be plotted in three dimensions. If all arguments are vectors of the +## same length, then a single continuous line is drawn. If all arguments +## are matrices, then each column of the matrices is treated as a +## separate line. No attempt is made to transpose the arguments to make +## the number of rows match. +## +## If only two arguments are given, as +## +## @example +## plot3 (@var{x}, @var{c}) +## @end example +## +## @noindent +## the real and imaginary parts of the second argument are used +## as the @var{y} and @var{z} coordinates, respectively. +## +## If only one argument is given, as +## +## @example +## plot3 (@var{c}) +## @end example +## +## @noindent +## the real and imaginary parts of the argument are used as the @var{y} +## and @var{z} values, and they are plotted versus their index. +## +## Arguments may also be given in groups of three as +## +## @example +## plot3 (@var{x1}, @var{y1}, @var{z1}, @var{x2}, @var{y2}, @var{z2}, @dots{}) +## @end example +## +## @noindent +## in which each set of three arguments is treated as a separate line or +## set of lines in three dimensions. +## +## To plot multiple one- or two-argument groups, separate each group +## with an empty format string, as +## +## @example +## plot3 (@var{x1}, @var{c1}, "", @var{c2}, "", @dots{}) +## @end example +## +## An example of the use of @code{plot3} is +## +## @example +## @group +## z = [0:0.05:5]; +## plot3 (cos (2*pi*z), sin (2*pi*z), z, ";helix;"); +## plot3 (z, exp (2i*pi*z), ";complex sinusoid;"); +## @end group +## @end example +## @seealso{plot, xlabel, ylabel, zlabel, title, print} +## @end deftypefn + +## Author: Paul Kienzle +## (modified from __plt__.m) + +function retval = plot3 (varargin) + + newplot (); + + x_set = 0; + y_set = 0; + z_set = 0; + property_set = 0; + fmt_set = 0; + properties = {}; + tlgnd = {}; + hlgnd = []; + idx = 0; + + ## Gather arguments, decode format, and plot lines. + arg = 0; + while (arg++ < nargin) + new = varargin{arg}; + new_cell = varargin(arg); + + if (property_set) + properties = [properties, new_cell]; + property_set = 0; + continue; + endif + + if (ischar (new)) + if (! z_set) + if (! y_set) + if (! x_set) + error ("plot3: needs x, [ y, [ z ] ]"); + else + z = imag (x); + y = real (x); + y_set = 1; + z_set = 1; + if (rows(x) > 1) + x = repmat ((1:rows(x))', 1, columns(x)); + else + x = 1:columns(x); + endif + endif + else + z = imag (y); + y = real (y); + z_set = 1; + endif + endif + + if (! fmt_set) + [options, valid] = __pltopt__ ("plot3", new, false); + if (! valid) + properties = [properties, new_cell]; + property_set = 1; + continue; + else + fmt_set = 1; + while (arg < nargin && ischar (varargin{arg+1})) + if (nargin - arg < 2) + error ("plot3: properties must appear followed by a value"); + endif + properties = [properties, varargin(arg+1:arg+2)]; + arg += 2; + endwhile + endif + else + properties = [properties, new_cell]; + property_set = 1; + continue; + endif + + if (isvector (x) && isvector (y)) + if (isvector (z)) + x = x(:); + y = y(:); + z = z(:); + elseif (length (x) == rows (z) && length (y) == columns (z)) + [x, y] = meshgrid (x, y); + else + error ("plot3: [length(x), length(y)] must match size(z)"); + endif + endif + + if (! size_equal (x, y, z)) + error ("plot3: x, y, and z must have the same shape"); + elseif (ndims (x) > 2) + error ("plot3: x, y, and z must not have more than two dimensions"); + endif + + for i = 1 : columns (x) + linestyle = options.linestyle; + marker = options.marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options.color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + tmp(++idx) = line (x(:, i), y(:, i), z(:, i), + "color", color, "linestyle", linestyle, + "marker", marker, properties{:}); + key = options.key; + if (! isempty (key)) + hlgnd = [hlgnd, tmp(idx)]; + tlgnd = {tlgnd{:}, key}; + endif + endfor + + x_set = 0; + y_set = 0; + z_set = 0; + fmt_set = 0; + properties = {}; + elseif (! x_set) + x = new; + x_set = 1; + elseif (! y_set) + y = new; + y_set = 1; + elseif (! z_set) + z = new; + z_set = 1; + else + if (isvector (x) && isvector (y)) + if (isvector (z)) + x = x(:); + y = y(:); + z = z(:); + elseif (length (x) == rows (z) && length (y) == columns (z)) + [x, y] = meshgrid (x, y); + else + error ("plot3: [length(x), length(y)] must match size(z)"); + endif + endif + + if (! size_equal (x, y, z)) + error ("plot3: x, y, and z must have the same shape"); + elseif (ndims (x) > 2) + error ("plot3: x, y, and z must not have more than two dimensions"); + endif + + options = __default_plot_options__ (); + for i = 1 : columns (x) + linestyle = options.linestyle; + marker = options.marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options.color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + tmp(++idx) = line (x(:, i), y(:, i), z(:, i), + "color", color, "linestyle", linestyle, + "marker", marker, properties{:}); + key = options.key; + if (! isempty (key)) + hlgnd = [hlgnd, tmp(idx)]; + tlgnd = {tlgnd{:}, key}; + endif + endfor + + x = new; + y_set = 0; + z_set = 0; + fmt_set = 0; + properties = {}; + endif + + endwhile + + if (property_set) + error ("plot3: properties must appear followed by a value"); + endif + + ## Handle last plot. + + if (x_set) + if (y_set) + if (! z_set) + z = imag (y); + y = real (y); + z_set = 1; + endif + else + z = imag (x); + y = real (x); + y_set = 1; + z_set = 1; + if (rows (x) > 1) + x = repmat ((1:rows (x))', 1, columns(x)); + else + x = 1:columns(x); + endif + endif + + if (isvector (x) && isvector (y)) + if (isvector (z)) + x = x(:); + y = y(:); + z = z(:); + elseif (length (x) == rows (z) && length (y) == columns (z)) + [x, y] = meshgrid (x, y); + else + error ("plot3: [length(x), length(y)] must match size(z)"); + endif + endif + + if (! size_equal (x, y, z)) + error ("plot3: x, y, and z must have the same shape"); + elseif (ndims (x) > 2) + error ("plot3: x, y, and z must not have more than two dimensions"); + endif + + options = __default_plot_options__ (); + + for i = 1 : columns (x) + linestyle = options.linestyle; + marker = options.marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options.color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + tmp(++idx) = line (x(:, i), y(:, i), z(:, i), + "color", color, "linestyle", linestyle, + "marker", marker, properties{:}); + key = options.key; + if (! isempty (key)) + hlgnd = [hlgnd, tmp(idx)]; + tlgnd = {tlgnd{:}, key}; + endif + endfor + endif + + if (!isempty (hlgnd)) + legend (gca(), hlgnd, tlgnd); + endif + + set (gca (), "view", [-37.5, 30]); + + if (nargout > 0 && idx > 0) + retval = tmp; + endif + +endfunction + +%!demo +%! clf +%! z = [0:0.05:5]; +%! plot3 (cos(2*pi*z), sin(2*pi*z), z, ";helix;"); +%! plot3 (z, exp(2i*pi*z), ";complex sinusoid;"); diff --git a/octave_packages/m/plot/plotmatrix.m b/octave_packages/m/plot/plotmatrix.m new file mode 100644 index 0000000..fbf6067 --- /dev/null +++ b/octave_packages/m/plot/plotmatrix.m @@ -0,0 +1,188 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} plotmatrix (@var{x}, @var{y}) +## @deftypefnx {Function File} {} plotmatrix (@var{x}) +## @deftypefnx {Function File} {} plotmatrix (@dots{}, @var{style}) +## @deftypefnx {Function File} {} plotmatrix (@var{h}, @dots{}) +## @deftypefnx {Function File} {[@var{h}, @var{ax}, @var{bigax}, @var{p}, @var{pax}] =} plotmatrix (@dots{}) +## Scatter plot of the columns of one matrix against another. Given the +## arguments @var{x} and @var{y}, that have a matching number of rows, +## @code{plotmatrix} plots a set of axes corresponding to +## +## @example +## plot (@var{x} (:, i), @var{y} (:, j) +## @end example +## +## Given a single argument @var{x}, then this is equivalent to +## +## @example +## plotmatrix (@var{x}, @var{x}) +## @end example +## +## @noindent +## except that the diagonal of the set of axes will be replaced with the +## histogram @code{hist (@var{x} (:, i))}. +## +## The marker to use can be changed with the @var{style} argument, that is a +## string defining a marker in the same manner as the @code{plot} +## command. If a leading axes handle @var{h} is passed to +## @code{plotmatrix}, then this axis will be used for the plot. +## +## The optional return value @var{h} provides handles to the individual +## graphics objects in the scatter plots, whereas @var{ax} returns the +## handles to the scatter plot axis objects. @var{bigax} is a hidden +## axis object that surrounds the other axes, such that the commands +## @code{xlabel}, @code{title}, etc., will be associated with this hidden +## axis. Finally @var{p} returns the graphics objects associated with +## the histogram and @var{pax} the corresponding axes objects. +## +## @example +## plotmatrix (randn (100, 3), "g+") +## @end example +## +## @end deftypefn + +function [h, ax, bigax, p, pax] = plotmatrix (varargin) + + [bigax2, varargin, nargin] = __plt_get_axis_arg__ ("plotmatrix", varargin{:}); + + if (nargin > 3 || nargin < 1) + print_usage (); + else + oldh = gca (); + unwind_protect + axes (bigax2); + newplot (); + [h2, ax2, p2, pax2, need_usage] = __plotmatrix__ (bigax2, varargin{:}); + if (need_usage) + print_usage (); + endif + if (nargout > 0) + h = h2; + ax = ax2; + bigax = bigax2; + p = p2; + pax = pax2; + endif + axes (bigax2); + ctext = text (0, 0, "", "visible", "off", + "handlevisibility", "off", "xliminclude", "off", + "yliminclude", "off", "zliminclude", "off", + "deletefcn", {@plotmatrixdelete, [ax2; pax2]}); + set (bigax2, "visible", "off"); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + endif +endfunction + +%!demo +%! clf +%! plotmatrix (randn (100, 3), 'g+') + +function plotmatrixdelete (h, d, ax) + for i = 1 : numel (ax) + hc = ax(i); + if (ishandle (hc) && strcmp (get (hc, "type"), "axes") + && strcmpi (get (hc, "beingdeleted"), "off")) + parent = get (hc, "parent"); + ## If the parent is invalid or being deleted, then do nothing + if (ishandle (parent) && strcmpi (get (parent, "beingdeleted"), "off")) + delete (hc); + endif + endif + endfor +endfunction + +function [h, ax, p, pax, need_usage] = __plotmatrix__ (bigax, varargin) + need_usage = false; + have_line_spec = false; + have_hist = false; + parent = get (bigax, "parent"); + for i = 1 : nargin - 1 + arg = varargin{i}; + if (ischar (arg) || iscell (arg)) + [linespec, valid] = __pltopt__ ("plotmatrix", varargin{i}, false); + if (valid) + have_line_spec = true; + linespec = varargin(i); + varargin(i) = []; + nargin = nargin - 1; + break; + else + need_usage = true; + returm; + endif + endif + endfor + + if (nargin == 2) + X = varargin{1}; + Y = X; + have_hist = true; + elseif (nargin == 3) + X = varargin{1}; + Y = varargin{2}; + else + need_usage = true; + returm; + endif + + if (rows(X) != rows(Y)) + error ("plotmatrix: dimension mismatch in the arguments"); + endif + + [dummy, m] = size (X); + [dummy, n] = size (Y); + + h = []; + ax = []; + p = []; + pax = []; + + xsize = 0.9 / m; + ysize = 0.9 / n; + xoff = 0.05; + yoff = 0.05; + border = [0.130, 0.110, 0.225, 0.185] .* [xsize, ysize, xsize, ysize]; + border(3:4) = - border(3:4) - border(1:2); + + for i = 1 : n + for j = 1 : m + pos = [xsize * (j - 1) + xoff, ysize * (n - i) + yoff, xsize, ysize]; + tmp = axes ("outerposition", pos, "position", pos + border, + "parent", parent); + if (i == j && have_hist) + pax = [pax ; tmp]; + [nn, xx] = hist (X(:, i)); + tmp = bar (xx, nn, 1.0); + p = [p; tmp]; + else + ax = [ax ; tmp]; + if (have_line_spec) + tmp = plot (X (:, i), Y (:, j), linespec); + else + tmp = plot (X (:, i), Y (:, j), "."); + endif + h = [h ; tmp]; + endif + endfor + endfor +endfunction diff --git a/octave_packages/m/plot/plotyy.m b/octave_packages/m/plot/plotyy.m new file mode 100644 index 0000000..8de6586 --- /dev/null +++ b/octave_packages/m/plot/plotyy.m @@ -0,0 +1,327 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} plotyy (@var{x1}, @var{y1}, @var{x2}, @var{y2}) +## @deftypefnx {Function File} {} plotyy (@dots{}, @var{fun}) +## @deftypefnx {Function File} {} plotyy (@dots{}, @var{fun1}, @var{fun2}) +## @deftypefnx {Function File} {} plotyy (@var{h}, @dots{}) +## @deftypefnx {Function File} {[@var{ax}, @var{h1}, @var{h2}] =} plotyy (@dots{}) +## Plot two sets of data with independent y-axes. The arguments @var{x1} and +## @var{y1} define the arguments for the first plot and @var{x1} and @var{y2} +## for the second. +## +## By default the arguments are evaluated with +## @code{feval (@@plot, @var{x}, @var{y})}. However the type of plot can be +## modified with the @var{fun} argument, in which case the plots are +## generated by @code{feval (@var{fun}, @var{x}, @var{y})}. @var{fun} can be +## a function handle, an inline function or a string of a function name. +## +## The function to use for each of the plots can be independently defined +## with @var{fun1} and @var{fun2}. +## +## If given, @var{h} defines the principal axis in which to plot the @var{x1} +## and @var{y1} data. The return value @var{ax} is a two element vector with +## the axis handles of the two plots. @var{h1} and @var{h2} are handles to +## the objects generated by the plot commands. +## +## @example +## @group +## x = 0:0.1:2*pi; +## y1 = sin (x); +## y2 = exp (x - 1); +## ax = plotyy (x, y1, x - 1, y2, @@plot, @@semilogy); +## xlabel ("X"); +## ylabel (ax(1), "Axis 1"); +## ylabel (ax(2), "Axis 2"); +## @end group +## @end example +## @end deftypefn + +function [Ax, H1, H2] = plotyy (varargin) + + ## Don't use __plt_get_axis_arg__ here as ax is a two vector for plotyy + if (nargin > 1 && length (varargin{1}) == 2 && ishandle(varargin{1}(1)) + && ishandle(varargin{1}(2)) + && all (floor (varargin{1}) != varargin{1})) + obj1 = get (varargin{1}(1)); + obj2 = get (varargin{1}(2)); + if (strcmp (obj1.type, "axes") || strcmp (obj2.type, "axes")) + ax = [obj1, obj2]; + varargin(1) = []; + if (isempty (varargin)) + varargin = {}; + endif + else + error ("plotyy: expecting first argument to be axes handle"); + endif + oldh = gca (); + else + f = get (0, "currentfigure"); + if (isempty (f)) + f = figure (); + endif + ca = get (f, "currentaxes"); + if (isempty (ca)) + ax = []; + elseif (ishandle (ca) && isprop (ca, "__plotyy_axes__")) + ax = get (ca, "__plotyy_axes__"); + else + ax = ca; + endif + if (length (ax) > 2) + for i = 3 : length (ax) + delete (ax (i)); + endfor + ax = ax(1:2); + elseif (length (ax) == 1) + ax(2) = axes (); + elseif (isempty (ax)) + ax(1) = axes (); + ax(2) = axes (); + ca = ax(2); + endif + if (nargin < 2) + varargin = {}; + endif + oldh = ca; + endif + + if (nargin < 4) + print_usage (); + endif + + unwind_protect + [ax, h1, h2] = __plotyy__ (ax, varargin{:}); + unwind_protect_cleanup + ## Only change back to the old axis if we didn't delete it + if (ishandle(oldh) && strcmp (get (oldh, "type"), "axes")) + axes (oldh); + endif + end_unwind_protect + + if (nargout > 0) + Ax = ax; + H1 = h1; + H2 = h2; + endif + +endfunction + +function [ax, h1, h2] = __plotyy__ (ax, x1, y1, x2, y2, varargin) + if (nargin > 5) + fun1 = varargin{1}; + else + fun1 = @plot; + endif + if (nargin > 6) + fun2 = varargin{2}; + else + fun2 = fun1; + endif + + xlim = [min([x1(:); x2(:)]), max([x1(:); x2(:)])]; + + if (ishandle(ax(1)) && strcmp (get (ax(1), "type"), "axes")) + axes (ax(1)); + else + ax(1) = axes (); + endif + newplot (); + h1 = feval (fun1, x1, y1); + + set (ax(1), "ycolor", getcolor (h1(1))); + set (ax(1), "xlim", xlim); + set (ax(1), "color", "none"); + + cf = gcf (); + set (cf, "nextplot", "add"); + + if (ishandle(ax(2)) && strcmp (get (ax(2), "type"), "axes")) + axes (ax(2)); + else + ax(2) = axes (); + endif + newplot (); + + colors = get (ax(1), "colororder"); + set (ax(2), "colororder", [colors(2:end,:); colors(1,:)]); + + if (strcmp (get (ax(1), "autopos_tag"), "subplot")) + set (ax(2), "autopos_tag", "subplot"); + else + set (ax, "activepositionproperty", "position"); + endif + + h2 = feval (fun2, x2, y2); + set (ax(2), "yaxislocation", "right"); + set (ax(2), "ycolor", getcolor (h2(1))); + + + if (strcmp (get(ax(1), "activepositionproperty"), "position")) + set (ax(2), "position", get (ax(1), "position")); + else + set (ax(2), "outerposition", get (ax(1), "outerposition")); + set (ax(2), "looseinset", get (ax(1), "looseinset")); + endif + + set (ax(2), "xlim", xlim); + set (ax(2), "color", "none"); + set (ax(2), "box", "off"); + + ## Add invisible text objects that when destroyed, + ## also remove the other axis + t1 = text (0, 0, "", "parent", ax(1), "tag", "plotyy", + "handlevisibility", "off", "visible", "off", + "xliminclude", "off", "yliminclude", "off"); + t2 = text (0, 0, "", "parent", ax(2), "tag", "plotyy", + "handlevisibility", "off", "visible", "off", + "xliminclude", "off", "yliminclude", "off"); + + set (t1, "deletefcn", {@deleteplotyy, ax(2), t2}); + set (t2, "deletefcn", {@deleteplotyy, ax(1), t1}); + + addlistener (ax(1), "position", {@update_position, ax(2)}); + addlistener (ax(2), "position", {@update_position, ax(1)}); + addlistener (ax(1), "outerposition", {@update_position, ax(2)}); + addlistener (ax(2), "outerposition", {@update_position, ax(1)}); + addlistener (ax(1), "looseinset", {@update_position, ax(2)}); + addlistener (ax(2), "looseinset", {@update_position, ax(1)}); + addlistener (ax(1), "view", {@update_position, ax(2)}); + addlistener (ax(2), "view", {@update_position, ax(1)}); + addlistener (ax(1), "plotboxaspectratio", {@update_position, ax(2)}); + addlistener (ax(2), "plotboxaspectratio", {@update_position, ax(1)}); + addlistener (ax(1), "plotboxaspectratiomode", {@update_position, ax(2)}); + addlistener (ax(2), "plotboxaspectratiomode", {@update_position, ax(1)}); + + ## Store the axes handles for the sister axes. + if (ishandle (ax(1)) && ! isprop (ax(1), "__plotyy_axes__")) + addproperty ("__plotyy_axes__", ax(1), "data", ax); + elseif (ishandle (ax(1))) + set (ax(1), "__plotyy_axes__", ax); + else + error ("plotyy.m: This shouldn't happen. File a bug report.") + endif + if (ishandle (ax(2)) && ! isprop (ax(2), "__plotyy_axes__")) + addproperty ("__plotyy_axes__", ax(2), "data", ax); + elseif (ishandle (ax(2))) + set (ax(2), "__plotyy_axes__", ax); + else + error ("plotyy.m: This shouldn't happen. File a bug report.") + endif +endfunction + +%!demo +%! clf +%! x = 0:0.1:2*pi; +%! y1 = sin (x); +%! y2 = exp (x - 1); +%! ax = plotyy (x, y1, x - 1, y2, @plot, @semilogy); +%! xlabel ("X"); +%! ylabel (ax(1), "Axis 1"); +%! ylabel (ax(2), "Axis 2"); +%! axes (ax(1)) +%! text (0.5, 0.5, "Left Axis", ... +%! "color", [0 0 1], "horizontalalignment", "center") +%! axes (ax(2)) +%! text (4.5, 80, "Right Axis", ... +%! "color", [0 0.5 0], "horizontalalignment", "center") + +%!demo +%! clf +%! x = linspace (-1, 1, 201); +%! subplot (2, 2, 1) +%! plotyy (x, sin(pi*x), x, 10*cos(pi*x)) +%! subplot (2, 2, 2) +%! surf (peaks (25)) +%! subplot (2, 2, 3) +%! contour (peaks (25)) +%! subplot (2, 2, 4) +%! plotyy (x, 10*sin(2*pi*x), x, cos(2*pi*x)) +%! axis square + +%!demo +%! clf +%! x = linspace (-1, 1, 201); +%! subplot (1, 1, 1); +%! hax = plotyy (x, sin(pi*x), x, cos(pi*x)); +%! ylabel ("Blue and on the Left") +%! ylabel (hax(2), "Green and on the Right") +%! xlabel ("xlabel") + +function deleteplotyy (h, d, ax2, t2) + if (ishandle (ax2) && strcmp (get (ax2, "type"), "axes") + && (isempty (gcbf()) || strcmp (get (gcbf(), "beingdeleted"),"off")) + && strcmp (get (ax2, "beingdeleted"), "off")) + set (t2, "deletefcn", []); + delete (ax2); + endif +endfunction + +function update_position (h, d, ax2) + persistent recursion = false; + + ## Don't allow recursion + if (! recursion) + unwind_protect + recursion = true; + view = get (h, "view"); + oldview = get (ax2, "view"); + plotboxaspectratio = get (h, "plotboxaspectratio"); + oldplotboxaspectratio = get (ax2, "plotboxaspectratio"); + plotboxaspectratiomode = get (h, "plotboxaspectratiomode"); + oldplotboxaspectratiomode = get (ax2, "plotboxaspectratiomode"); + + if (strcmp (get(h, "activepositionproperty"), "position")) + position = get (h, "position"); + oldposition = get (ax2, "position"); + if (! (isequal (position, oldposition) && isequal (view, oldview))) + set (ax2, "position", position, "view", view); + endif + else + outerposition = get (h, "outerposition"); + oldouterposition = get (ax2, "outerposition"); + if (! (isequal (outerposition, oldouterposition) && isequal (view, oldview))) + set (ax2, "outerposition", outerposition, "view", view); + endif + endif + + if (! (isequal (plotboxaspectratio, oldplotboxaspectratio) + && isequal (plotboxaspectratiomode, oldplotboxaspectratiomode))) + set (ax2, "plotboxaspectratio", plotboxaspectratio); + set (ax2, "plotboxaspectratiomode", plotboxaspectratiomode); + endif + unwind_protect_cleanup + recursion = false; + end_unwind_protect + endif +endfunction + +function color = getcolor (ax) + obj = get (ax); + if (isfield (obj, "color")) + color = obj.color; + elseif (isfield (obj, "facecolor") && ! ischar (obj.facecolor)) + color = obj.facecolor; + elseif (isfield (obj, "edgecolor") && ! ischar (obj.edgecolor)) + color = obj.edgecolor; + else + color = [0, 0, 0]; + endif +endfunction + diff --git a/octave_packages/m/plot/polar.m b/octave_packages/m/plot/polar.m new file mode 100644 index 0000000..e484a19 --- /dev/null +++ b/octave_packages/m/plot/polar.m @@ -0,0 +1,230 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polar (@var{theta}, @var{rho}) +## @deftypefnx {Function File} {} polar (@var{theta}, @var{rho}, @var{fmt}) +## @deftypefnx {Function File} {} polar (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} polar (@dots{}) +## Create a two-dimensional plot from polar coordinates @var{theta} and +## @var{rho}. +## +## The optional argument @var{fmt} specifies the line format. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## +## @seealso{plot} +## @end deftypefn + +## Author: jwe + +function retval = polar (varargin) + + [h, varargin, nargs] = __plt_get_axis_arg__ ("polar", varargin{:}); + + if (nargs < 1) + print_usage(); + endif + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + if (nargs == 3) + if (! ischar (varargin{3})) + error ("polar: third argument must be a string"); + endif + tmp = __plr2__ (h, varargin{:}); + maxr = max (varargin {2} (:)); + elseif (nargs == 2) + if (ischar (varargin{2})) + tmp = __plr1__ (h, varargin{:}); + if (iscomplex(varargin{1})) + maxr = max (imag(varargin{1})(:)); + else + maxr = max (varargin{1}(:)); + endif + else + fmt = ""; + tmp = __plr2__ (h, varargin{:}, fmt); + maxr = max (varargin {2} (:)); + endif + elseif (nargs == 1) + fmt = ""; + tmp = __plr1__ (h, varargin{:}, fmt); + if (iscomplex(varargin{1})) + maxr = max (imag(varargin{1})(:)); + else + maxr = max (varargin{1}(:)); + endif + else + print_usage (); + endif + + set (h, "xlim", [-maxr, maxr], "ylim", [-maxr, maxr], + "xaxislocation", "zero", "yaxislocation", "zero", + "plotboxaspectratio", [1, 1, 1]); + + if (nargout > 0) + retval = tmp; + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +function retval = __plr1__ (h, theta, fmt) + + if (nargin != 3) + print_usage (); + endif + + [nr, nc] = size (theta); + if (nr == 1) + theta = theta'; + tmp = nr; + nr = nc; + nc = tmp; + endif + theta_i = imag (theta); + if (any (theta_i)) + rho = theta_i; + theta = real (theta); + else + rho = theta; + theta = (1:nr)'; + endif + + retval = __plr2__ (h, theta, rho, fmt); + +endfunction + +function retval = __plr2__ (h, theta, rho, fmt) + + if (nargin != 4) + print_usage (); + endif + + if (any (imag (theta))) + theta = real (theta); + endif + + if (any (imag (rho))) + rho = real (rho); + endif + + if (isscalar (theta)) + if (isscalar (rho)) + x = rho * cos (theta); + y = rho * sin (theta); + retval = __plt__ ("polar", h, x, y, fmt); + else + error ("__plr2__: invalid data for plotting"); + endif + elseif (isvector (theta)) + if (isvector (rho)) + if (length (theta) != length (rho)) + error ("__plr2__: vector lengths must match"); + endif + if (rows (rho) == 1) + rho = rho'; + endif + if (rows (theta) == 1) + theta = theta'; + endif + x = rho .* cos (theta); + y = rho .* sin (theta); + retval = __plt__ ("polar", h, x, y, fmt); + elseif (ismatrix (rho)) + [t_nr, t_nc] = size (theta); + if (t_nr == 1) + theta = theta'; + tmp = t_nr; + t_nr = t_nc; + t_nc = tmp; + endif + [r_nr, r_nc] = size (rho); + if (t_nr != r_nr) + rho = rho'; + tmp = r_nr; + r_nr = r_nc; + r_nc = tmp; + endif + if (t_nr != r_nr) + error ("__plr2__: vector and matrix sizes must match"); + endif + x = diag (cos (theta)) * rho; + y = diag (sin (theta)) * rho; + retval = __plt__ ("polar", h, x, y, fmt); + else + error ("__plr2__: invalid data for plotting"); + endif + elseif (ismatrix (theta)) + if (isvector (rho)) + [r_nr, r_nc] = size (rho); + if (r_nr == 1) + rho = rho'; + tmp = r_nr; + r_nr = r_nc; + r_nc = tmp; + endif + [t_nr, t_nc] = size (theta); + if (r_nr != t_nr) + theta = theta'; + tmp = t_nr; + t_nr = t_nc; + t_nc = tmp; + endif + if (r_nr != t_nr) + error ("__plr2__: vector and matrix sizes must match"); + endif + diag_r = diag (rho); + x = diag_r * cos (theta); + y = diag_r * sin (theta); + retval = __plt__ ("polar", h, x, y, fmt); + elseif (ismatrix (rho)) + if (! size_equal (rho, theta)) + error ("__plr2__: matrix dimensions must match"); + endif + x = rho .* cos (theta); + y = rho .* sin (theta); + retval = __plt__ ("polar", h, x, y, fmt); + else + error ("__plr2__: invalid data for plotting"); + endif + else + error ("__plr2__: invalid data for plotting"); + endif + +endfunction + + +%!demo +%! clf +%! theta = linspace (0, 2*pi, 1000); +%! rho = sin (7*theta); +%! polar (theta, rho); + +%!demo +%! clf +%! theta = linspace (0, 10*pi, 1000); +%! rho = sin (5/4*theta); +%! polar (theta, rho); + diff --git a/octave_packages/m/plot/print.m b/octave_packages/m/plot/print.m new file mode 100644 index 0000000..575e7be --- /dev/null +++ b/octave_packages/m/plot/print.m @@ -0,0 +1,679 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} print () +## @deftypefnx {Function File} {} print (@var{options}) +## @deftypefnx {Function File} {} print (@var{filename}, @var{options}) +## @deftypefnx {Function File} {} print (@var{h}, @var{filename}, @var{options}) +## Print a graph, or save it to a file +## +## @var{filename} defines the file name of the output file. If the +## file name has no suffix, one is inferred from the specified +## device and appended to the file name. If no +## filename is specified, the output is sent to the printer. +## +## @var{h} specifies the figure handle. If no handle is specified +## the handle for the current figure is used. +## +## @var{options}: +## +## @table @code +## @item -f@var{h} +## Specify the handle, @var{h}, of the figure to be printed. The +## default is the current figure. +## +## @item -P@var{printer} +## Set the @var{printer} name to which the graph is sent if no +## @var{filename} is specified. +## +## @item -G@var{ghostscript_command} +## Specify the command for calling Ghostscript. For Unix and Windows, +## the defaults are 'gs' and 'gswin32c', respectively. +## +## @item -color +## @itemx -mono +## Monochrome or color output. +## +## @item -solid +## @itemx -dashed +## Forces all lines to be solid or dashed, respectively. +## +## @item -portrait +## @itemx -landscape +## Specify the orientation of the plot for printed output. For +## non-printed output the aspect ratio of the output corresponds to +## the plot area defined by the "paperposition" property in the +## orientation specified. This options is equivalent to changing +## the figure's "paperorientation" property. +## +## @item -d@var{device} +## Output device, where @var{device} is one of: +## @table @code +## @item ps +## @itemx ps2 +## @itemx psc +## @itemx psc2 +## Postscript (level 1 and 2, mono and color). The FLTK graphics +## toolkit generates Postscript level 3.0. +## +## @item eps +## @itemx eps2 +## @itemx epsc +## @itemx epsc2 +## Encapsulated postscript (level 1 and 2, mono and color). The FLTK +## graphic toolkit generates Postscript level 3.0. +## +## @item tex +## @itemx epslatex +## @itemx epslatexstandalone +## @itemx pstex +## @itemx pslatex +## @itemx pdflatex +## Generate a @LaTeX{} (or @TeX{}) file for labels, and eps/ps/pdf +## for graphics. The file produced by @code{epslatexstandalone} can be +## processed directly by @LaTeX{}. The other formats are intended to +## be included in a @LaTeX{} (or @TeX{}) document. The @code{tex} device +## is the same as the @code{epslatex} device. The @code{pdflatex} device +## is only available for the FLTK graphics toolkit. +## +## @item tikz +## Generate a @LaTeX{} file using PGF/TikZ@. For the FLTK the result is +## PGF. +## +## @item ill +## @itemx aifm +## Adobe Illustrator (Obsolete for Gnuplot versions > 4.2) +## +## @item cdr +## @itemx @nospell{corel} +## CorelDraw +## +## @item dxf +## AutoCAD +## +## @item emf +## @itemx meta +## Microsoft Enhanced Metafile +## +## @item fig +## XFig. For the Gnuplot graphics toolkit, the additional options +## @option{-textspecial} or @option{-textnormal} can be used to control +## whether the special flag should be set for the text in +## the figure (default is @option{-textnormal}). +## +## @item hpgl +## HP plotter language +## +## @item mf +## Metafont +## +## @item png +## Portable network graphics +## +## @item jpg +## @itemx jpeg +## JPEG image +## +## @item gif +## GIF image (only available for the Gnuplot graphics toolkit) +## +## @item pbm +## PBMplus +## +## @item svg +## Scalable vector graphics +## +## @item pdf +## Portable document format +## +## NOTE: The gnuplot binary as shipped by Debian cannot create PDF files, see http://bugs.debian.org/478677 +## +## @end table +## +## If the device is omitted, it is inferred from the file extension, +## or if there is no filename it is sent to the printer as postscript. +## +## @item -d@var{ghostscript_device} +## Additional devices are supported by Ghostscript. +## Some examples are; +## +## @table @code +## @item ljet2p +## HP LaserJet IIP +## +## @item ljet3 +## HP LaserJet III +## +## @item deskjet +## HP DeskJet and DeskJet Plus +## +## @item cdj550 +## HP DeskJet 550C +## +## @item paintjet +## HP PointJet +## +## @item pcx24b +## 24-bit color PCX file format +## +## @item ppm +## Portable Pixel Map file format +## +## @item pdfwrite +## Produces pdf output from eps +## @end table +## +## For a complete list, type `system ("gs -h")' to see what formats +## and devices are available. +## +## When Ghostscript output is sent to a printer the size is determined +## by the figure's "papersize" property. When the output +## is sent to a file the size is determined by the plot box defined by +## the figure's "paperposition" property. +## +## @itemx -append +## Appends the PS, or PDF output to a pre-existing file of the +## same type. +## +## @itemx -r@var{NUM} +## Resolution of bitmaps in pixels per inch. For both metafiles and +## SVG the default is the screen resolution, for other it is 150 dpi. +## To specify screen resolution, use "-r0". +## +## @item -tight +## Forces a tight bounding box for eps-files. +## +## @item -@var{preview} +## Adds a preview to eps-files. Supported formats are; +## +## @table @code +## @item -interchange +## Provides an interchange preview. +## +## @item -metalfile +## Provides a metafile preview. +## +## @item -pict +## Provides pict preview. +## +## @item -tiff +## Provides a tiff preview. +## @end table +## +## @item -S@var{xsize},@var{ysize} +## Plot size in pixels for EMF, GIF, JPEG, PBM, PNG and SVG@. For +## PS, EPS, PDF, and other vector formats the plot size is in points. +## This option is equivalent to changing the size of the plot box +## associated with "paperposition" property. Using the command form of +## the print function, you must quote the @var{xsize},@var{ysize} +## option. For example, by writing @w{@code{"-S640,480"}}. +## +## @item -F@var{fontname} +## @itemx -F@var{fontname}:@var{size} +## @itemx -F:@var{size} +## Associates all text with the @var{fontname} and/or @var{fontsize}. +## @var{fontname} is ignored for some devices; dxf, fig, hpgl, etc. +## @end table +## +## The filename and options can be given in any order. +## +## Example: Print to a file, using the svg device. +## +## @example +## @group +## figure (1); +## clf (); +## surf (peaks); +## print -dsvg figure1.svg +## @end group +## @end example +## +## Example: Print to an HP Deskjet 550C. +## +## @example +## @group +## figure (1); +## clf (); +## surf (peaks); +## print -dcdj550 +## @end group +## @end example +## +## @seealso{figure, orient, saveas} +## @end deftypefn + +function print (varargin) + + opts = __print_parse_opts__ (varargin{:}); + + opts.pstoedit_cmd = @pstoedit; + opts.fig2dev_cmd = @fig2dev; + opts.latex_standalone = @latex_standalone; + opts.lpr_cmd = @lpr; + opts.epstool_cmd = @epstool; + + if (! isfigure (opts.figure)) + error ("print: no figure to print"); + endif + + orig_figure = get (0, "currentfigure"); + figure (opts.figure); + + if (opts.append_to_file) + [~, ~, ext] = fileparts (opts.ghostscript.output); + opts.ghostscript.prepend = strcat (tmpnam (), ext); + copyfile (opts.ghostscript.output, opts.ghostscript.prepend); + endif + + unwind_protect + + ## Modify properties as specified by options + props = []; + + ## graphics toolkit tranlates figure position to eps bbox in points + fpos = get (opts.figure, "position"); + props(1).h = opts.figure; + props(1).name = "position"; + props(1).value = {fpos}; + fpos(3:4) = opts.canvas_size; + set (opts.figure, "position", fpos); + + ## Set figure background to none. This is done both for + ## consistency with Matlab and to elliminate the visible + ## box along the figure's perimeter. + props(2).h = opts.figure; + props(2).name = "color"; + props(2).value{1} = get (props(2).h, props(2).name); + set (props(2).h, props(2).name, "none"); + + if (opts.force_solid != 0) + h = findall (opts.figure, "-property", "linestyle"); + m = numel (props); + for n = 1:numel(h) + props(m+n).h = h(n); + props(m+n).name = "linestyle"; + props(m+n).value = {get(h(n), "linestyle")}; + endfor + if (opts.force_solid > 0) + linestyle = "-"; + else + linestyle = "--"; + endif + set (h, "linestyle", linestyle); + endif + + if (opts.use_color < 0 + && ! strcmp (get (opts.figure, "__graphics_toolkit__"), "gnuplot")) + color_props = {"color", "facecolor", "edgecolor", "colormap"}; + for c = 1:numel(color_props) + h = findall (opts.figure, "-property", color_props{c}); + hnone = findall (opts.figure, color_props{c}, "none"); + h = setdiff (h, hnone); + m = numel (props); + for n = 1:numel(h) + if (ishandle (h(n))) + ## Need to verify objects exist since callbacks may delete objects + ## as the colors for others are modified. + rgb = get (h(n), color_props{c}); + props(end+1).h = h(n); + props(end).name = color_props{c}; + props(end).value = {get(h(n), color_props{c})}; + if (isnumeric (rgb)) + ## convert RGB color to RGB gray scale + xfer = repmat ([0.30, 0.59, 0.11], size (rgb, 1), 1); + ggg = repmat (sum (xfer .* rgb, 2), 1, 3); + set (h(n), color_props{c}, ggg); + endif + endif + endfor + endfor + endif + + if (! isempty (opts.font) || ! isempty (opts.fontsize)) + h = findall (opts.figure, "-property", "fontname"); + m = numel (props); + for n = 1:numel(h) + if (ishandle (h(n))) + if (! isempty (opts.font)) + props(end+1).h = h(n); + props(end).name = "fontname"; + props(end).value = {get(h(n), "fontname")}; + endif + endif + if (ishandle (h(n))) + if (! isempty (opts.fontsize)) + props(end+1).h = h(n); + props(end).name = "fontsize"; + props(end).value = {get(h(n), "fontsize")}; + endif + endif + endfor + if (! isempty (opts.font)) + set (h(ishandle(h)), "fontname", opts.font); + endif + if (! isempty (opts.fontsize)) + if (ischar (opts.fontsize)) + fontsize = str2double (opts.fontsize); + else + fontsize = opts.fontsize; + endif + set (h(ishandle(h)), "fontsize", fontsize); + endif + endif + + ## call the graphcis toolkit print script + switch (get (opts.figure, "__graphics_toolkit__")) + case "gnuplot" + opts = __gnuplot_print__ (opts); + otherwise + opts = __fltk_print__ (opts); + endswitch + + unwind_protect_cleanup + ## restore modified properties + if (isstruct (props)) + for n = 1:numel(props) + if (ishandle (props(n).h)) + set (props(n).h, props(n).name, props(n).value{1}); + endif + endfor + endif + + ## Unlink temporary files + for n = 1:numel(opts.unlink) + [status, output] = unlink (opts.unlink{n}); + if (status != 0) + warning ("print.m: %s, '%s'", output, opts.unlink{n}); + endif + endfor + end_unwind_protect + + if (isfigure (orig_figure)) + figure (orig_figure); + endif + +endfunction + +function cmd = epstool (opts, filein, fileout) + ## As epstool does not work with pipes, a subshell is used to + ## permit piping. Since this solution does not work with the DOS + ## command shell, the -tight and -preview options are disabled if + ## output must be piped. + + ## DOS Shell: + ## gs.exe [...] -sOutputFile= - & epstool -bbox -preview-tiff & del + ## Unix Shell; + ## cat > ; epstool -bbox -preview-tiff ; rm + + dos_shell = (ispc () && ! isunix ()); + + cleanup = ""; + if (nargin < 3) + fileout = opts.name; + elseif (isempty (fileout)) + fileout = "-"; + endif + + if (nargin < 2 || strcmp (filein, "-") || isempty (filein)) + pipein = true; + filein = strcat (tmpnam (), ".eps"); + if (dos_shell) + cleanup = sprintf ("& del %s ", strrep (filein, '/', '\')); + else + cleanup = sprintf ("; rm %s ", filein); + endif + else + pipein = false; + filein = strcat ("'", strtrim (filein), "'"); + endif + if (strcmp (fileout, "-")) + pipeout = true; + fileout = strcat (tmpnam (), ".eps"); + if (dos_shell) + cleanup = horzcat (cleanup, sprintf ("& del %s ", strrep (fileout, '/', '\'))); + else + cleanup = horzcat (cleanup, sprintf ("; rm %s ", fileout)); + endif + else + pipeout = false; + fileout = strcat ("'", strtrim (fileout), "'"); + endif + + if (! isempty (opts.preview) && opts.tight_flag) + warning ("print:previewandtight", + "print.m: eps preview may not be combined with -tight"); + endif + if (! isempty (opts.preview) || opts.tight_flag) + if (! isempty (opts.epstool_binary)) + if (opts.tight_flag) + cmd = "--copy --bbox"; + elseif (! isempty (opts.preview)) + switch opts.preview + case "tiff" + cmd = sprintf ("--add-%s-preview --device tiffg3", opts.preview); + case {"tiff6u", "tiff6p", "metafile"} + cmd = sprintf ("--add-%s-preview --device bmpgray", opts.preview); + case {"tiff4", "interchange"} + cmd = sprintf ("--add-%s-preview", opts.preview); + case "pict" + cmd = sprintf ("--add-%s-preview --mac-single", opts.preview); + otherwise + error ("print:invalidpreview", + "print.m: epstool cannot include preview for format '%s'", + opts.preview); + endswitch + if (! isempty (opts.ghostscript.resolution)) + cmd = sprintf ("%s --dpi %d", cmd, opts.ghostscript.resolution); + endif + else + cmd = ""; + endif + if (! isempty (cmd)) + cmd = sprintf ("%s --quiet %s %s %s ", opts.epstool_binary, + cmd, filein, fileout); + endif + if (pipein) + if (dos_shell) + filein(filein=="'") = "\""; + gs_cmd = __ghostscript__ ("binary", opts.ghostscript.binary, + "device", "epswrite", + "source", "-", + "output", filein); + cmd = sprintf ("%s %s & %s", gs_cmd, filein, cmd); + else + cmd = sprintf ("cat > %s ; %s", filein, cmd); + endif + endif + if (pipeout) + if (dos_shell) + cmd = sprintf ("%s & type %s", cmd, fileout); + else + cmd = sprintf ("%s ; cat %s", cmd, fileout); + endif + endif + if (! isempty (cleanup)) + if (pipeout && dos_shell) + error ("print:epstoolpipe", + "print.m: cannot pipe output of 'epstool' for DOS shell"); + elseif (pipeout) + cmd = sprintf ("( %s %s )", cmd, cleanup); + else + cmd = sprintf ("%s %s", cmd, cleanup); + endif + endif + elseif (isempty (opts.epstool_binary)) + error ("print:noepstool", "print.m: 'epstool' not found in PATH"); + endif + else + if (pipein && pipeout) + if (dos_shell) + cmd = __ghostscript__ ("binary", opts.ghostscript.binary, + "device", "epswrite", + "source", "-", + "output", "-"); + else + cmd = " cat "; + endif + elseif (pipein && ! pipeout) + if (dos_shell) + ## ghostscript expects double, not single, quotes + fileout(fileout=="'") = "\""; + cmd = __ghostscript__ ("binary", opts.ghostscript.binary, + "device", "epswrite", + "source", "-", + "output", fileout); + else + cmd = sprintf (" cat > %s ", fileout); + endif + elseif (! pipein && pipeout) + if (dos_shell) + cmd = sprintf (" type %s ", filein); + else + cmd = sprintf (" cat %s ", filein); + endif + else + if (dos_shell) + cmd = sprintf (" copy %s %s ", filein, fileout); + else + cmd = sprintf (" cp %s %s ", filein, fileout); + endif + endif + endif + if (opts.debug) + fprintf ("epstool command: '%s'\n", cmd); + endif +endfunction + +function cmd = fig2dev (opts, devopt) + if (nargin < 2) + devopt = opts.devopt; + endif + dos_shell = (ispc () && ! isunix ()); + if (! isempty (opts.fig2dev_binary)) + if (dos_shell) + ## FIXME - is this the right thing to do for DOS? + cmd = sprintf ("%s -L %s 2> NUL", opts.fig2dev_binary, devopt); + else + cmd = sprintf ("%s -L %s 2> /dev/null", opts.fig2dev_binary, devopt); + endif + elseif (isempty (opts.fig2dev_binary)) + error ("print:nofig2dev", "print.m: 'fig2dev' not found in PATH"); + endif + if (opts.debug) + fprintf ("fig2dev command: '%s'\n", cmd); + endif +endfunction + +function latex_standalone (opts) + n = find (opts.name == ".", 1, "last"); + if (! isempty (n)) + opts.name = opts.name(1:n-1); + endif + latexfile = strcat (opts.name, ".tex"); + switch opts.devopt + case {"pdflatexstandalone"} + packages = "\\usepackage{graphicx,color}"; + graphicsfile = strcat (opts.name, "-inc.pdf"); + case {"pslatexstandalone"} + packages = "\\usepackage{epsfig,color}"; + graphicsfile = strcat (opts.name, "-inc.ps"); + otherwise + packages = "\\usepackage{epsfig,color}"; + graphicsfile = strcat (opts.name, "-inc.eps"); + endswitch + papersize = sprintf ("\\usepackage[papersize={%.2fbp,%.2fbp},text={%.2fbp,%.2fbp}]{geometry}", + opts.canvas_size, opts.canvas_size); + prepend = {"\\documentclass{minimal}"; + packages; + papersize; + "\\begin{document}"; + "\\centering"}; + postpend = {"\\end{document}"}; + fid = fopen (latexfile, "r"); + if (fid >= 0) + latex = fscanf (fid, "%c", Inf); + status = fclose (fid); + if (status != 0) + error ("print:errorclosingfile", + "print.m: error closing file '%s'", latexfile); + endif + ## TODO - should this be fixed in GL2PS? + latex = strrep (latex, "\\includegraphics{}", + sprintf ("\\includegraphics{%s}", graphicsfile)); + else + error ("print:erroropeningfile", + "print.m: error opening file '%s'", latexfile); + endif + fid = fopen (latexfile, "w"); + if (fid >= 0) + fprintf (fid, "%s\n", prepend{:}); + fprintf (fid, "%s", latex); + fprintf (fid, "%s\n", postpend{:}); + status = fclose (fid); + if (status != 0) + error ("print:errorclosingfile", + "print.m: error closing file '%s'", latexfile); + endif + else + error ("print:erroropeningfile", + "print.m: error opening file '%s'", latexfile); + endif +endfunction + +function cmd = lpr (opts) + if (nargin < 2) + devopt = opts.devopt; + endif + if (! isempty (opts.lpr_binary)) + cmd = opts.lpr_binary; + if (! isempty (opts.lpr_options)) + cmd = sprintf ("%s %s", cmd, opts.lpr_options); + endif + if (! isempty (opts.printer)) + cmd = sprintf ("%s -P %s", cmd, opts.printer); + endif + elseif (isempty (opts.lpr_binary)) + error ("print:nolpr", "print.m: 'lpr' not found in PATH"); + endif + if (opts.debug) + fprintf ("lpr command: '%s'\n", cmd); + endif +endfunction + +function cmd = pstoedit (opts, devopt) + if (nargin < 2) + devopt = opts.devopt; + endif + dos_shell = (ispc () && ! isunix ()); + if (! isempty (opts.pstoedit_binary)) + if (dos_shell) + cmd = sprintf ("%s -f %s 2> NUL", opts.pstoedit_binary, devopt); + else + ## FIXME - is this the right thing to do for DOS? + cmd = sprintf ("%s -f %s 2> /dev/null", opts.pstoedit_binary, devopt); + endif + elseif (isempty (opts.pstoedit_binary)) + error ("print:nopstoedit", "print.m: 'pstoedit' not found in PATH"); + endif + if (opts.debug) + fprintf ("pstoedit command: '%s'\n", cmd); + endif +endfunction + + diff --git a/octave_packages/m/plot/private/__actual_axis_position__.m b/octave_packages/m/plot/private/__actual_axis_position__.m new file mode 100644 index 0000000..1f01f9b --- /dev/null +++ b/octave_packages/m/plot/private/__actual_axis_position__.m @@ -0,0 +1,86 @@ +## Copyright (C) 2009-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __actual_axis_position__ (@var{h}) +## @deftypefnx {Function File} {} __actual_axis_position__ (@var{axis_struct}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott + +function pos = __actual_axis_position__ (h) + + if (ishandle (h)) + axis_obj = get (h); + elseif (isstruct (h)) + axis_obj = h; + h = axis_obj.__my_handle__; + endif + + ## Get figure size in pixels + orig_fig_units = get (axis_obj.parent, "units"); + orig_fig_position = get (axis_obj.parent, "position"); + unwind_protect + set (axis_obj.parent, "units", "pixels"); + fig_position = get (axis_obj.parent, "position"); + unwind_protect_cleanup + set (axis_obj.parent, "units", orig_fig_units); + set (axis_obj.parent, "position", orig_fig_position); + end_unwind_protect + ## Get axes size in pixels + if (strcmp (get (axis_obj.parent, "__graphics_toolkit__"), "gnuplot") + && strcmp (axis_obj.activepositionproperty, "outerposition")) + pos_in_pixels = axis_obj.outerposition .* fig_position([3, 4, 3, 4]); + else + pos_in_pixels = axis_obj.position .* fig_position([3, 4, 3, 4]); + endif + + nd = __calc_dimensions__ (h); + + if (strcmp (axis_obj.plotboxaspectratiomode, "manual") + || strcmp (axis_obj.dataaspectratiomode, "manual")) + ## When using {rltb}margin, Gnuplot does not handle the specified + ## aspect ratio properly, so handle it here. + if (nd == 2 || all (mod (axis_obj.view, 90) == 0)) + aspect_ratio_2d = axis_obj.plotboxaspectratio(1:2); + else + ## FIXME -- this works for "axis square", but has not been + ## thoroughly tested for other aspect ratios. + aspect_ratio_2d = [max(axis_obj.plotboxaspectratio(1:2)), ... + axis_obj.plotboxaspectratio(3)/sqrt(2)]; + endif + orig_aspect_ratio_2d = pos_in_pixels(3:4); + rel_aspect_ratio_2d = aspect_ratio_2d ./ orig_aspect_ratio_2d; + rel_aspect_ratio_2d = rel_aspect_ratio_2d ./ max (rel_aspect_ratio_2d); + if (rel_aspect_ratio_2d(1) < rel_aspect_ratio_2d(2)); + dx = (1.0 - rel_aspect_ratio_2d(1)) * pos_in_pixels(3); + pos_in_pixels = pos_in_pixels + dx*[0.5, 0.0, -1.0, 0.0]; + elseif (rel_aspect_ratio_2d(1) > rel_aspect_ratio_2d(2)) + dy = (1.0 - rel_aspect_ratio_2d(2)) * pos_in_pixels(4); + pos_in_pixels = pos_in_pixels + dy*[0.0, 0.5, 0.0, -1.0]; + endif + pos = pos_in_pixels ./ fig_position([3, 4, 3, 4]); + elseif (strcmp (get (axis_obj.parent, "__graphics_toolkit__"), "gnuplot") + && strcmp (axis_obj.activepositionproperty, "outerposition")) + pos = axis_obj.outerposition; + else + pos = axis_obj.position; + endif +endfunction + diff --git a/octave_packages/m/plot/private/__add_datasource__.m b/octave_packages/m/plot/private/__add_datasource__.m new file mode 100644 index 0000000..886acd2 --- /dev/null +++ b/octave_packages/m/plot/private/__add_datasource__.m @@ -0,0 +1,55 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{newargs} =} __add_datasource__ (@var{fcn}, @var{h}, @var{data}, @var{varargin}) +## Undocumented internal function. +## @end deftypefn + +function newargs = __add_datasource__ (fcn, h, data, varargin) + + if (nargin < 3) + error ("__add_datasource__: a minimum of 3 inputs are required"); + endif + + if (ischar (data)) + data = {data}; + endif + + for i = 1 : numel (data) + addproperty (strcat (data{i}, "datasource"), h, "string", ""); + endfor + + i = 0; + newargs = {}; + while (i < numel (varargin)) + arg = varargin{++i}; + if (i != numel(varargin) && ischar (arg) + && length (arg) > 9 && strcmpi (arg(end-9:end), "datasource")) + arg = tolower (arg); + val = varargin{++i}; + if (ischar (val)) + set (h, arg, val); + else + error ("%s: expecting data source to be a string", fcn); + endif + else + newargs{end + 1} = arg; + endif + endwhile +endfunction diff --git a/octave_packages/m/plot/private/__add_default_menu__.m b/octave_packages/m/plot/private/__add_default_menu__.m new file mode 100644 index 0000000..a0111c8 --- /dev/null +++ b/octave_packages/m/plot/private/__add_default_menu__.m @@ -0,0 +1,109 @@ +## Copyright (C) 2010-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __add_default_menu__ (@var{fig}) +## Add default menu to figure. All uimenu handles have +## set their property "handlevisibility" to "off". +## @end deftypefn + +## Author: Kai Habel + +function __add_default_menu__ (fig) + + if (isfigure (fig)) + obj = findall (fig, "label", "&File", "tag", "__default_menu__"); + if (length (obj) == 0) + __f = uimenu (fig, "label", "&File", "handlevisibility", "off", "tag", "__default_menu__"); + sa = uimenu (__f, "label", "Save &As", "handlevisibility", "off", + "callback", @save_cb); + sv = uimenu (__f, "label", "&Save", "handlevisibility", "off", + "callback", @save_cb); + cl = uimenu (__f, "label", "&Close", "handlevisibility", "off", + "callback", "close(gcf)"); + + __e = uimenu (fig, "label", "&Edit", "handlevisibility", "off"); + gr = uimenu (__e, "label", "&Grid", "handlevisibility", "off", + "callback", @grid_cb); + as = uimenu (__e, "label", "Auto&scale", "handlevisibility", "off", + "callback", @autoscale_cb); + gm = uimenu (__e, "label", "GUI &Mode", "handlevisibility", "off"); + gm2 = uimenu (gm, "label", "Pan+Zoom", "handlevisibility", "off", + "callback", @guimode_cb); + gm3 = uimenu (gm, "label", "Rotate+Zoom", "handlevisibility", "off", + "callback", @guimode_cb); + gmn = uimenu (gm, "label", "None", "handlevisibility", "off", + "callback", @guimode_cb); + __h = uimenu (fig, "label", "&Help", "handlevisibility", "off"); + ab = uimenu (__h, "label", "A&bout", "handlevisibility", "off", "enable", "off"); + endif + else + error ("expecting figure handle", "handlevisibility", "off"); + endif + +endfunction + +function grid_cb (h, e) + grid; + drawnow; # should not be required +endfunction + +function save_cb (h, e) + lbl = get (gcbo, "label"); + if (strcmp (lbl, "&Save")) + fname = get (gcbo, "userdata"); + if (isempty (fname)) + __save_as__ (gcbo); + else + saveas (gcbo, fname); + endif + elseif (strcmp (lbl, "Save &As")) + __save_as__ (gcbo); + endif +endfunction + +function __save_as__ (caller) + + [filename, filedir] = uiputfile ({"*.pdf;*.ps;*.gif;*.png;*.jpg","Supported Graphic Formats"}, + "Save Figure", + pwd); + if (filename != 0) + fname = strcat (filedir, filesep, filename); + obj = findall ("label", "&Save"); + if (length (obj) > 0) + set (obj(1), "userdata", fname); + endif + saveas (caller, fname); + endif +endfunction + +function autoscale_cb (h, e) + axis ("auto"); + drawnow; #should not be required +endfunction + +function guimode_cb (h, e) + lbl = get(h, "label"); + if (strncmp(lbl, "Pan+Zoom", 8)) + gui_mode("2D"); + elseif (strncmp(lbl, "Rotate+Zoom", 11)) + gui_mode("3D"); + elseif (strncmp(lbl, "None", 4)) + gui_mode("None"); + endif +endfunction diff --git a/octave_packages/m/plot/private/__axes_limits__.m b/octave_packages/m/plot/private/__axes_limits__.m new file mode 100644 index 0000000..674139d --- /dev/null +++ b/octave_packages/m/plot/private/__axes_limits__.m @@ -0,0 +1,56 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __axes_limits__ (@var{fcn}, @dots{}) +## Undocumented internal function. +## @end deftypefn + +function retval = __axes_limits__ (fcn, varargin) + + retval = []; + + fcnmode = sprintf ("%smode", fcn); + + [h, varargin, nargin] = __plt_get_axis_arg__ (fcn, varargin{:}); + + if (nargin == 0) + retval = get (h, fcn); + else + arg = varargin{1}; + + if (ischar (arg)) + if (strcmpi (arg, "mode")) + retval = get (h, fcnmode); + elseif (strcmpi (arg, "auto") || strcmpi (arg, "manual")) + set (h, fcnmode, arg); + endif + else + if (!isnumeric (arg) && any (size(arg(:)) != [2, 1])) + error ("%s: argument must be a 2 element vector", fcn); + else + if (arg(1) >= arg(2)) + error ("%s: axis limits must be increasing", fcn); + else + set (h, fcn, arg(:)); + endif + endif + endif + endif + +endfunction diff --git a/octave_packages/m/plot/private/__axis_label__.m b/octave_packages/m/plot/private/__axis_label__.m new file mode 100644 index 0000000..12d15ec --- /dev/null +++ b/octave_packages/m/plot/private/__axis_label__.m @@ -0,0 +1,42 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __axis_label__ (@var{caller}, @var{h}, @var{txt}, @dots{}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = __axis_label__ (ah, caller, txt, varargin) + + h = get (ah, caller); + + set (h, "fontangle", get (ah, "fontangle"), + "fontname", get (ah, "fontname"), + "fontsize", get (ah, "fontsize"), + "fontunits", get (ah, "fontunits"), + "fontweight", get (ah, "fontweight"), + "string", txt, + varargin{:}); + + if (nargout > 0) + retval = h; + endif + +endfunction diff --git a/octave_packages/m/plot/private/__bar__.m b/octave_packages/m/plot/private/__bar__.m new file mode 100644 index 0000000..79ad025 --- /dev/null +++ b/octave_packages/m/plot/private/__bar__.m @@ -0,0 +1,427 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __bar__ (@var{vertical}, @var{func}, @dots{}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function varargout = __bar__ (vertical, func, varargin) + + [h, varargin] = __plt_get_axis_arg__ ((nargout > 1), func, varargin{:}); + + ## Slightly smaller than 0.8 to avoid clipping issue in gnuplot 4.0 + width = 0.8 - 10 * eps; + group = true; + bv = 0; + + if (nargin < 3) + print_usage (); + endif + + if (nargin > 3 && isnumeric (varargin{2})) + x = varargin{1}; + if (isvector (x)) + x = x(:); + endif + y = varargin{2}; + if (isvector (y)) + y = y(:); + endif + if (size (x, 1) != size (y, 1)) + y = varargin{1}; + if (isvector (y)) + y = y(:); + endif + x = [1:size(y,1)]'; + idx = 2; + else + if (! isvector (x)) + error ("%s: x must be a vector", func); + endif + idx = 3; + endif + else + y = varargin{1}; + if (isvector (y)) + y = y(:); + endif + x = [1:size(y,1)]'; + idx = 2; + endif + + newargs = {}; + have_line_spec = false; + while (idx <= nargin - 2) + if (ischar (varargin{idx}) && strcmpi (varargin{idx}, "grouped")) + group = true; + idx++; + elseif (ischar (varargin{idx}) && strcmpi (varargin{idx}, "stacked")) + group = false; + idx++; + else + if ((ischar (varargin{idx}) || iscell (varargin{idx})) + && ! have_line_spec) + [linespec, valid] = __pltopt__ (func, varargin{idx}, false); + if (valid) + have_line_spec = true; + newargs = [{"facecolor", linespec.color}, newargs] + idx++; + continue; + endif + endif + if (isscalar(varargin{idx})) + width = varargin{idx++}; + elseif (idx == nargin - 2) + newargs = [newargs,varargin(idx++)]; + elseif (ischar (varargin{idx}) + && strcmpi (varargin{idx}, "basevalue") + && isscalar (varargin{idx+1})) + bv = varargin{idx+1}; + idx += 2; + else + newargs = [newargs,varargin(idx:idx+1)]; + idx += 2; + endif + endif + endwhile + + xlen = size (x, 1); + ylen = size (y, 1); + + if (xlen != ylen) + error ("%s: length of x and y must be equal", func); + endif + if (any (x(2:end) < x(1:end-1))) + error ("%s: x vector values must be in ascending order", func); + endif + + ycols = size (y, 2); + if (numel (x) > 1) + cutoff = min (diff (double(x))) / 2; + else + cutoff = 1; + endif + if (group) + delta_p = delta_m = repmat (cutoff * width / ycols, size (x)); + else + delta_p = delta_m = repmat (cutoff * width, size (x)); + endif + x1 = (x - delta_m)(:)'; + x2 = (x + delta_p)(:)'; + xb = repmat ([x1; x1; x2; x2](:), 1, ycols); + + if (group) + offset = ((delta_p + delta_m) * [-(ycols - 1) / 2 : (ycols - 1) / 2]); + xb(1:4:4*ylen,:) += offset; + xb(2:4:4*ylen,:) += offset; + xb(3:4:4*ylen,:) += offset; + xb(4:4:4*ylen,:) += offset; + y0 = zeros (size (y)) + bv; + y1 = y; + else + y1 = cumsum(y,2); + y0 = [zeros(ylen,1)+bv, y1(:,1:end-1)]; + endif + + yb = zeros (4*ylen, ycols); + yb(1:4:4*ylen,:) = y0; + yb(2:4:4*ylen,:) = y1; + yb(3:4:4*ylen,:) = y1; + yb(4:4:4*ylen,:) = y0; + + xb = reshape (xb, [4, numel(xb) / 4 / ycols, ycols]); + yb = reshape (yb, [4, numel(yb) / 4 / ycols, ycols]); + + if (nargout < 2) + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + tmp = bars (h, vertical, x, y, xb, yb, width, group, + have_line_spec, bv, newargs{:}); + if (nargout == 1) + varargout{1} = tmp; + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + else + if (vertical) + varargout{1} = xb; + varargout{2} = yb; + else + varargout{1} = yb; + varargout{2} = xb; + endif + endif + +endfunction + +function tmp = bars (ax, vertical, x, y, xb, yb, width, group, have_color_spec, base_value, varargin) + + ycols = columns (y); + clim = get (ax, "clim"); + tmp = []; + + for i = 1:ycols + hg = hggroup (); + tmp = [tmp; hg]; + args = __add_datasource__ ("bar", hg, {"x", "y"}, varargin{:}); + + if (vertical) + if (! have_color_spec) + if (ycols == 1) + lev = clim(1); + else + lev = (i - 1) * (clim(2) - clim(1)) / (ycols - 1) - clim(1); + endif + h = patch(xb(:,:,i), yb(:,:,i), "FaceColor", "flat", + "cdata", lev, "parent", hg); + else + h = patch(xb(:,:,i), yb(:,:,i), "parent", hg); + endif + else + if (! have_color_spec) + if (ycols == 1) + lev = clim(1); + else + lev = (i - 1) * (clim(2) - clim(1)) / (ycols - 1) - clim(1); + endif + h = patch(yb(:,:,i), xb(:,:,i), "FaceColor", "flat", + "cdata", lev, "parent", hg); + else + h = patch(yb(:,:,i), xb(:,:,i), "parent", hg); + endif + endif + + if (i == 1) + x_axis_range = get (ax, "xlim"); + h_baseline = line (x_axis_range, [0, 0], "color", [0, 0, 0]); + set (h_baseline, "handlevisibility", "off"); + set (h_baseline, "xliminclude", "off"); + addlistener (ax, "xlim", @update_xlim); + addlistener (h_baseline, "ydata", @update_baseline); + addlistener (h_baseline, "visible", @update_baseline); + endif + + ## Setup the hggroup and listeners + addproperty ("showbaseline", hg, "radio", "{on}|off"); + addproperty ("basevalue", hg, "data", base_value); + addproperty ("baseline", hg, "data", h_baseline); + + addlistener (hg, "showbaseline", @show_baseline); + addlistener (hg, "basevalue", @move_baseline); + + addproperty ("barwidth", hg, "data", width); + if (group) + addproperty ("barlayout", hg, "radio", "stacked|{grouped}", "grouped"); + else + addproperty ("barlayout", hg, "radio", "{stacked}|grouped", "stacked"); + endif + if (vertical) + addproperty ("horizontal", hg, "radio", "on|{off}", "off"); + else + addproperty ("horizontal", hg, "radio", "{on}|off", "on"); + endif + + addlistener (hg, "barwidth", @update_group); + addlistener (hg, "barlayout", @update_group); + addlistener (hg, "horizontal", @update_group); + + addproperty ("edgecolor", hg, "patchedgecolor", get (h, "edgecolor")); + addproperty ("linewidth", hg, "patchlinewidth", get (h, "linewidth")); + addproperty ("linestyle", hg, "patchlinestyle", get (h, "linestyle")); + addproperty ("facecolor", hg, "patchfacecolor", get (h, "facecolor")); + + addlistener (hg, "edgecolor", @update_props); + addlistener (hg, "linewidth", @update_props); + addlistener (hg, "linestyle", @update_props); + addlistener (hg, "facecolor", @update_props); + + if (isvector (x)) + addproperty ("xdata", hg, "data", x); + else + addproperty ("xdata", hg, "data", x(:, i)); + endif + addproperty ("ydata", hg, "data", y(:, i)); + + addlistener (hg, "xdata", @update_data); + addlistener (hg, "ydata", @update_data); + + addproperty ("bargroup", hg, "data"); + set (tmp, "bargroup", tmp); + if (! isempty (args)) + set (hg, args{:}); + endif + if (i == 1) + set (h_baseline, "parent", get (hg, "parent")); + endif + endfor + + update_xlim (ax, []); +endfunction + +function update_xlim (h, d) + kids = get (h, "children"); + xlim = get (h, "xlim"); + + for i = 1 : length (kids) + obj = get (kids (i)); + if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline")) + if (any (get (obj.baseline, "xdata") != xlim)) + set (obj.baseline, "xdata", xlim); + endif + endif + endfor +endfunction + +function update_baseline (h, d) + visible = get (h, "visible"); + ydata = get (h, "ydata")(1); + + kids = get (get (h, "parent"), "children"); + for i = 1 : length (kids) + obj = get (kids (i)); + if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline") + && obj.baseline == h) + ## Only alter if changed to avoid recursion of the listener functions + if (! strcmpi (get (kids(i), "showbaseline"), visible)) + set (kids (i), "showbaseline", visible); + endif + if (! strcmpi (get (kids(i), "basevalue"), visible)) + set (kids (i), "basevalue", ydata); + endif + endif + endfor +endfunction + +function show_baseline (h, d) + persistent recursion = false; + + ## Don't allow recursion + if (! recursion) + unwind_protect + recursion = true; + hlist = get (h, "bargroup"); + showbaseline = get (h, "showbaseline"); + for hh = hlist(:)' + if (hh != h) + set (hh, "showbaseline", showbaseline); + endif + endfor + set (get (h, "baseline"), "visible", showbaseline); + unwind_protect_cleanup + recursion = false; + end_unwind_protect + endif +endfunction + +function move_baseline (h, d) + b0 = get (h, "basevalue"); + bl = get (h, "baseline"); + + if (get (bl, "ydata") != [b0, b0]) + set (bl, "ydata", [b0, b0]); + endif + + if (strcmpi (get (h, "barlayout"), "grouped")) + update_data (h, d); + endif +endfunction + +function update_props (h, d) + kids = get (h, "children"); + set (kids, "edgecolor", get (h, "edgecolor"), + "linewidth", get (h, "linewidth"), + "linestyle", get (h, "linestyle"), + "facecolor", get (h, "facecolor")); +endfunction + +function update_data (h, d) + persistent recursion = false; + + ## Don't allow recursion + if (! recursion) + unwind_protect + recursion = true; + hlist = get (h, "bargroup"); + x = get (h, "xdata"); + if (!isvector (x)) + x = x(:); + endif + y = []; + for hh = hlist(:)' + ytmp = get (hh, "ydata"); + y = [y ytmp(:)]; + endfor + + [xb, yb] = bar (x, y, get (h, "barwidth"), get (h, "barlayout"), + "basevalue", get (h, "basevalue")); + ny = columns (y); + vert = strcmpi (get (h, "horizontal"), "off"); + + for i = 1:ny + hp = get (hlist(i), "children"); + if (vert) + set (hp, "xdata", xb(:,:,i), "ydata", yb(:,:,i)); + else + set (hp, "xdata", yb(:,:,i), "ydata", xb(:,:,i)); + endif + endfor + unwind_protect_cleanup + recursion = false; + end_unwind_protect + endif +endfunction + +function update_group (h, d) + persistent recursion = false; + + ## Don't allow recursion + if (! recursion) + unwind_protect + recursion = true; + hlist = get (h, "bargroup"); + barwidth = get(h, "barwidth"); + barlayout = get (h, "barlayout"); + horizontal = get (h, "horizontal"); + + ## To prevent recursion, only change if modified + for hh = hlist(:)' + if (hh != h) + if (get (hh, "barwidth") != barwidth) + set (hh, "barwidth", barwidth); + endif + if (! strcmpi (get (hh, "barlayout"), barlayout)) + set (hh, "barlayout", barlayout); + endif + if (! strcmpi (get (hh, "horizontal"), horizontal)) + set (hh, "horizontal", horizontal); + endif + endif + endfor + update_data (h, d); + unwind_protect_cleanup + recursion = false; + end_unwind_protect + endif +endfunction diff --git a/octave_packages/m/plot/private/__clabel__.m b/octave_packages/m/plot/private/__clabel__.m new file mode 100644 index 0000000..378a7b7 --- /dev/null +++ b/octave_packages/m/plot/private/__clabel__.m @@ -0,0 +1,115 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} __clabel__ (@var{c}, @var{v}, @var{hparent}, @var{label_spacing}, @var{z}, @var{varargin}) +## Undocumented internal function. +## @end deftypefn + +function h = __clabel__ (c, v, hparent, label_spacing, z, varargin) + ## FIXME + ## Assume that the plot size is 4 by 3 inches. + lims = axis (); + xspacing = 72 * 4 / abs(lims(1) - lims(2)); + yspacing = 72 * 3 / abs(lims(3) - lims(4)); + + if (isscalar (hparent) && ishandle(hparent) + && strcmp (get (hparent, "type"), "hggroup")) + x = get (hparent, "xdata"); + xmin = min (x(:)); + xmax = max (x(:)); + y = get (hparent, "ydata"); + ymin = min (y(:)); + ymax = max (y(:)); + else + i1 = 1; + while (i1 < length (c)) + clev = c(1,i1); + clen = c(2,i1); + p = c(:, i1+1:i1+clen); + + xmin = min (c(1,:)); + xmax = max (c(1,:)); + ymin = min (c(2,:)); + ymax = max (c(2,:)); + + i1 += clen+1; + endwhile + endif + + ## Decode contourc output format and place labels. + i1 = 1; + h = []; + while (i1 < length (c)) + clev = c(1,i1); + clen = c(2,i1); + + if (!isempty (v) && ! any (find (clev == v))) + i1 += clen+1; + continue; + endif + + p = c(:, i1+1:i1+clen) .* repmat ([xspacing; yspacing], 1, clen); + d = sqrt (sumsq (diff (p, 1, 2))); + cumd = cumsum (d); + td = sum(d); + ntag = ceil (td / label_spacing); + + if (all (c(:,i1+1) == c(:,i1+clen))) + Spacing = td / ntag; + pos = Spacing / 2 + [0:ntag-1] * Spacing; + else + pos = zeros(1, ntag); + pos(1) = (td - label_spacing * (ntag - 1)) ./ 2; + pos(2:ntag) = pos(1) + [1:ntag-1] * label_spacing; + endif + + j1 = 2; + tlabel = sprintf ("%g", clev); + for i = 1 : ntag + tagpos = pos(i); + + while (j1 < clen && cumd(j1) < tagpos) + j1++; + endwhile + tpos = sum(c(:,i1+j1-1:i1+j1), 2) ./ 2; + + if (tpos(1) != xmin && tpos(1) != xmax + && tpos(2) != ymin && tpos(2) != ymax) + trot = 180 / pi * atan2 (diff (c(2,i1+j1-1:i1+j1)), + diff (c(1,i1+j1-1:i1+j1))); + + if (ischar (z)) + ht = text (tpos(1), tpos(2), clev, tlabel, "rotation", trot, + "parent", hparent, "horizontalalignment", "center", + "userdata", clev, varargin{:}); + elseif (!isempty (z)) + ht = text (tpos(1), tpos(2), z, tlabel, "rotation", trot, + "parent", hparent, "horizontalalignment", "center", + "userdata", clev, varargin{:}); + else + ht = text (tpos(1), tpos(2), tlabel, "rotation", trot, + "parent", hparent, "horizontalalignment", "center", + "userdata", clev, varargin{:}); + endif + h = [h; ht]; + endif + endfor + i1 += clen+1; + endwhile +endfunction \ No newline at end of file diff --git a/octave_packages/m/plot/private/__color_str_rgb__.m b/octave_packages/m/plot/private/__color_str_rgb__.m new file mode 100644 index 0000000..56a9aa6 --- /dev/null +++ b/octave_packages/m/plot/private/__color_str_rgb__.m @@ -0,0 +1,50 @@ +## Copyright (C) 2010-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{rgb} =} __color_str_rgb__ (@var{str}) +## Undocumented internal function. +## @end deftypefn + +function rgb = __color_str_rgb__ (str) + + if (ischar (str)) + if (strncmpi (str, "black", 5)) + rgb = [0, 0, 0]; + elseif (strncmpi (str, "red", 3)) + rgb = [1, 0, 0]; + elseif (strncmpi (str, "green", 5)) + rgb = [0, 1, 0]; + elseif (strncmpi (str, "blue", 4)) + rgb = [0, 0, 1]; + + elseif (strncmpi (str, "yellow", 6)) + rgb = [1, 1, 0]; + elseif (strncmpi (str, "magenta", 7)) + rgb = [1, 0, 1]; + elseif (strncmpi (str, "cyan", 4)) + rgb = [0, 1, 1]; + elseif (strncmpi (str, "white", 5)) + rgb = [1, 1, 1]; + else + rgb = [0, 0, 0]; + endif + else + error ("__color_str_rgb__: expecting a string argument"); + endif +endfunction diff --git a/octave_packages/m/plot/private/__contour__.m b/octave_packages/m/plot/private/__contour__.m new file mode 100644 index 0000000..f187e80 --- /dev/null +++ b/octave_packages/m/plot/private/__contour__.m @@ -0,0 +1,550 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{c}, @var{hg}] =} __contour__ (@dots{}) +## Undocumented internal function. +## @end deftypefn + +function [c, hg] = __contour__ (varargin) + ax = varargin{1}; + zlevel = varargin{2}; + filled = "off"; + + linespec.linestyle = "-"; + linespec.color = "auto"; + edgecolor = "flat"; + for i = 3 : nargin + arg = varargin {i}; + if ((ischar (arg) || iscell (arg))) + [linespec, valid] = __pltopt__ ("__contour__", arg, false); + if (isempty (linespec.color)) + linespec.color = "auto"; + endif + if (isempty (linespec.linestyle)) + linespec.linestyle = "-"; + endif + if (valid) + have_line_spec = true; + varargin(i) = []; + break; + endif + endif + endfor + + opts = {}; + i = 3; + while (i < length (varargin)) + if (ischar (varargin {i})) + if (strcmpi (varargin{i}, "fill")) + filled = varargin {i + 1}; + varargin(i:i+1) = []; + elseif (strcmpi (varargin{i}, "linecolor")) + linespec.color = varargin {i + 1}; + edgecolor = linespec.color; + if (ischar (edgecolor) && strcmpi (edgecolor, "auto")) + edgecolor = "flat"; + endif + varargin(i:i+1) = []; + elseif (strcmpi (varargin{i}, "edgecolor")) + linespec.color = varargin {i + 1}; + edgecolor = linespec.color; + if (ischar (edgecolor) && strcmpi (edgecolor, "flat")) + linespec.color = "auto"; + endif + varargin(i:i+1) = []; + else + opts{end+1} = varargin{i}; + varargin(i) = []; + opts{end+1} = varargin{i}; + varargin(i) = []; + endif + else + i++; + endif + endwhile + + if (length(varargin) < 5) + z1 = varargin{3}; + x1 = 1 : columns(z1); + y1 = 1 : rows(z1); + else + x1 = varargin{3}; + y1 = varargin{4}; + z1 = varargin{5}; + endif + if (!ismatrix (z1) || isvector (z1) || isscalar (z1)) + error ("__contour__: z argument must be a matrix"); + endif + if (length (varargin) == 4 || length (varargin) == 6) + vn = varargin {end}; + vnauto = false; + else + vnauto = true; + vn = 10; + endif + + if (isscalar (vn)) + lvl = linspace (min (z1(!isinf(z1))), max (z1(!isinf(z1))), + vn + 2)(1:end-1); + else + lvl = vn; + endif + + if (strcmpi (filled, "on")) + if (isvector (x1) || isvector (y1)) + [x1, y1] = meshgrid (x1, y1); + endif + [nr, nc] = size (z1); + x0 = prepad(x1, nc+1, 2 * x1(1, 1) - x1(1, 2), 2); + x0 = postpad(x0, nc+2, 2 * x1(1, nc) - x1(1, nc - 1), 2); + x0 = [x0(1, :); x0; x0(1, :)]; + y0 = prepad(y1, nr+1, 2 * y1(1, 1) - y1(2, 1), 1); + y0 = postpad(y0, nr+2, 2 * y1(nr, 1) - y1(nr - 1, 1)); + y0 = [y0(:, 1), y0, y0(:, 1)]; + z0 = -Inf(nr+2, nc+2); + z0(2:nr+1, 2:nc+1) = z1; + [c, lev] = contourc (x0, y0, z0, lvl); + else + [c, lev] = contourc (x1, y1, z1, lvl); + endif + + hg = hggroup (); + opts = __add_datasource__ ("__countour__", hg, {"x", "y", "z"}, opts{:}); + + addproperty ("xdata", hg, "data", x1); + addproperty ("ydata", hg, "data", y1); + addproperty ("zdata", hg, "data", z1); + addproperty ("contourmatrix", hg, "data", c); + + addlistener (hg, "xdata", @update_data); + addlistener (hg, "ydata", @update_data); + addlistener (hg, "zdata", @update_data); + addlistener (hg, "contourmatrix", @update_data); + + addproperty ("fill", hg, "radio", "on|{off}", filled); + + ## The properties zlevel and zlevelmode don't exist in matlab, but + ## allow the use of contourgroups with the contour3, meshc and surfc + ## functions. + if (isnumeric (zlevel)) + addproperty ("zlevelmode", hg, "radio", "{none}|auto|manual", "manual"); + addproperty ("zlevel", hg, "data", zlevel); + else + addproperty ("zlevelmode", hg, "radio", "{none}|auto|manual", zlevel); + if (ischar (zlevel) && strcmpi (zlevel, "manual")) + z = varargin{3}; + z = 2 * (min (z(:)) - max (z(:))); + addproperty ("zlevel", hg, "data", z); + else + addproperty ("zlevel", hg, "data", 0.); + endif + endif + + lvlstep = sum (abs (diff (lvl))) / (length (lvl) - 1); + + addproperty ("levellist", hg, "data", lev); + addproperty ("levelstep", hg, "double", lvlstep); + if (vnauto) + addproperty ("levellistmode", hg, "radio", "{auto}|manual", "auto"); + addproperty ("levelstepmode", hg, "radio", "{auto}|manual", "auto"); + elseif (isscalar (vn)) + addproperty ("levellistmode", hg, "radio", "{auto}|manual", "auto"); + addproperty ("levelstepmode", hg, "radio", "{auto}|manual", "manual"); + else + addproperty ("levellistmode", hg, "radio", "{auto}|manual", "manual"); + addproperty ("levelstepmode", hg, "radio", "{auto}|manual", "auto"); + endif + + addproperty ("labelspacing", hg, "double", 144); + addproperty ("textlist", hg, "data", lev); + addproperty ("textlistmode", hg, "radio", "{auto}|manual", "auto"); + addproperty ("textstep", hg, "double", lvlstep); + addproperty ("textstepmode", hg, "radio", "{auto}|manual", "auto"); + addproperty ("showtext", hg, "radio", "on|{off}", "off"); + + addproperty ("linecolor", hg, "color", linespec.color, "{auto}|none"); + addproperty ("linestyle", hg, "linelinestyle", linespec.linestyle); + addproperty ("linewidth", hg, "linelinewidth", 0.5); + + ## FIXME It would be good to hide this property which is just an undocumented + ## alias for linecolor + addproperty ("edgecolor", hg, "color", edgecolor, "{flat}|none"); + + addlistener (hg, "fill", @update_data); + + addlistener (hg, "zlevelmode", @update_zlevel); + addlistener (hg, "zlevel", @update_zlevel); + + addlistener (hg, "levellist", @update_data); + addlistener (hg, "levelstep", @update_data); + addlistener (hg, "levellistmode", @update_data); + addlistener (hg, "levelstepmode", @update_data); + + addlistener (hg, "labelspacing", @update_text); + addlistener (hg, "textlist", @update_text); + addlistener (hg, "textlistmode", @update_text); + addlistener (hg, "textstep", @update_text); + addlistener (hg, "textstepmode", @update_text); + addlistener (hg, "showtext", @update_text); + + addlistener (hg, "linecolor", @update_line); + addlistener (hg, "linestyle", @update_line); + addlistener (hg, "linewidth", @update_line); + + addlistener (hg, "edgecolor", @update_edgecolor); + + add_patch_children (hg); + + axis("tight"); + + if (!isempty (opts)) + set (hg, opts{:}); + endif +endfunction + +function add_patch_children (hg) + c = get (hg, "contourmatrix"); + lev = get (hg, "levellist"); + fill = get (hg, "fill"); + zlev = get (hg, "zlevel"); + zmode = get (hg, "zlevelmode"); + lc = get (hg, "linecolor"); + lw = get (hg, "linewidth"); + ls = get (hg, "linestyle"); + filled = get (hg, "fill"); + ca = gca (); + + if (strcmpi (lc, "auto")) + lc = "flat"; + endif + + if (strcmpi (filled, "on")) + + lvl_eps = get_lvl_eps (lev); + + ## Decode contourc output format. + i1 = 1; + ncont = 0; + while (i1 < columns (c)) + ncont++; + cont_lev(ncont) = c(1, i1); + cont_len(ncont) = c(2, i1); + cont_idx(ncont) = i1+1; + ii = i1+1:i1+cont_len(ncont); + cont_area(ncont) = polyarea (c(1, ii), c(2, ii)); + i1 += c(2, i1) + 1; + endwhile + + ## Handle for each level the case where we have (a) hole(s) in a patch. + ## Those are to be filled with the color of level below or with the + ## background colour. + for k = 1:numel (lev) + lvl_idx = find (abs (cont_lev - lev(k)) < lvl_eps); + len = numel (lvl_idx); + if (len > 1) + ## mark = logical(zeros(size(lvl_idx))); + mark = false (size (lvl_idx)); + a = 1; + while (a < len) + ## take 1st patch + b = a + 1; + pa_idx = lvl_idx(a); + ## get pointer to contour start, and contour length + curr_ct_idx = cont_idx(pa_idx); + curr_ct_len = cont_len(pa_idx); + ## get contour + curr_ct = c(:, curr_ct_idx:curr_ct_idx+curr_ct_len-1); + b_vec = (a+1):len; + next_ct_pt_vec = c(:, cont_idx(lvl_idx(b_vec))); + in = inpolygon (next_ct_pt_vec(1,:), next_ct_pt_vec(2,:), + curr_ct(1, :), curr_ct(2, :)); + mark(b_vec(in)) = !mark(b_vec(in)); + a++; + endwhile + if (numel (mark) > 0) + ## All marked contours describe a hole in a larger contour of + ## the same level and must be filled with colour of level below. + ma_idx = lvl_idx(mark); + if (k > 1) + ## Find color of level below. + tmp = find(abs(cont_lev - lev(k - 1)) < lvl_eps); + lvl_bel_idx = tmp(1); + ## Set color of patches found. + cont_lev(ma_idx) = cont_lev(lvl_bel_idx); + else + ## Set lowest level contour to NaN. + cont_lev(ma_idx) = NaN; + endif + endif + endif + endfor + + ## The algorithm can create patches with the size of the plotting + ## area, we would like to draw only the patch with the highest level. + del_idx = []; + max_idx = find (cont_area == max (cont_area)); + if (numel (max_idx) > 1) + ## delete double entries + del_idx = max_idx(1:end-1); + cont_area(del_idx) = cont_lev(del_idx) = []; + cont_len(del_idx) = cont_idx(del_idx) = []; + endif + + ## Now we have everything together and can start plotting the patches + ## beginning with largest area. + [tmp, svec] = sort (cont_area); + len = ncont - numel (del_idx); + h = []; + for n = len:(-1):1 + idx = svec(n); + ctmp = c(:, cont_idx(idx):cont_idx(idx) + cont_len(idx) - 1); + if (all (ctmp(:,1) == ctmp(:,end))) + ctmp(:, end) = []; + else + ## Special case unclosed contours + endif + if (isnan(cont_lev(idx))) + fc = get (ca, "color"); + if (strcmp (fc, "none")) + fc = get (ancestor (ca, "figure"), "color"); + endif + else + fc = "flat"; + endif + h = [h; __go_patch__(ca, "xdata", ctmp(1, :)(:), "ydata", ctmp(2, :)(:), + "vertices", ctmp.', "faces", 1:(cont_len(idx)-1), + "facevertexcdata", cont_lev(idx), + "facecolor", fc, "cdata", cont_lev(idx), + "edgecolor", lc, "linestyle", ls, + "linewidth", lw, "parent", hg)]; + endfor + + if (min (lev) == max (lev)) + set (ca, "clim", [min(lev)-1, max(lev)+1], "layer", "top"); + else + set (ca, "clim", [min(lev), max(lev)], "layer", "top"); + endif + else + ## Decode contourc output format. + i1 = 1; + h = []; + while (i1 < length (c)) + clev = c(1,i1); + clen = c(2,i1); + + if (all (c(:,i1+1) == c(:,i1+clen))) + p = c(:, i1+1:i1+clen-1).'; + else + p = [c(:, i1+1:i1+clen), NaN(2, 1)].'; + endif + + switch (zmode) + case "none" + h = [h; __go_patch__(ca, "xdata", p(:,1), "ydata", p(:,2), + "zdata", [], "facecolor", "none", + "vertices", p, "faces", 1:rows(p), + "facevertexcdata", clev, + "edgecolor", lc, "linestyle", ls, + "linewidth", lw, + "cdata", clev, "parent", hg)]; + case "auto" + h = [h; __go_patch__(ca, "xdata", p(:,1), "ydata", p(:,2), + "zdata", clev * ones(rows(p),1), + "vertices", [p, clev * ones(rows(p),1)], + "faces", 1:rows(p), + "facevertexcdata", clev, + "facecolor", "none", "edgecolor", lc, + "linestyle", ls, "linewidth", lw, + "cdata", clev, "parent", hg)]; + otherwise + h = [h; __go_patch__(ca, "xdata", p(:,1), "ydata", p(:,2), + "zdata", zlev * ones (rows(p), 1), + "vertices", [p, zlev * ones(rows(p),1)], + "faces", 1:rows(p), + "facevertexcdata", clev, + "facecolor", "none", "edgecolor", lc, + "linestyle", ls, "linewidth", lw, + "cdata", clev, "parent", hg)]; + endswitch + i1 += clen + 1; + endwhile + endif + +endfunction + +function update_zlevel (h, d) + z = get (h, "zlevel"); + zmode = get (h, "zlevelmode"); + kids = get (h, "children"); + + switch (zmode) + case "none" + set (kids, "zdata", []); + case "auto" + for i = 1 : length (kids) + set (kids(i), "zdata", get (kids (i), "cdata") .* + ones (size (get (kids (i), "xdata")))); + endfor + otherwise + for i = 1 : length (kids) + set (kids(i), "zdata", z .* ones (size (get (kids (i), "xdata")))); + endfor + endswitch +endfunction + +function update_edgecolor (h, d) + ec = get (h, "edgecolor"); + lc = get (h, "linecolor"); + if (ischar (ec) && strcmpi (ec, "flat")) + if (! strcmpi (lc, "auto")) + set (h, "linecolor", "auto"); + endif + elseif (! isequal (ec, lc)) + set (h, "linecolor", ec); + endif +endfunction + +function update_line (h, d) + lc = get (h, "linecolor"); + ec = get (h, "edgecolor"); + if (strcmpi (lc, "auto")) + lc = "flat"; + endif + if (! isequal (ec, lc)) + set (h, "edgecolor", lc); + endif + set (findobj (h, "type", "patch"), "edgecolor", lc, + "linewidth", get (h, "linewidth"), "linestyle", get (h, "linestyle")); +endfunction + +function update_data (h, d) + persistent recursive = false; + + if (!recursive) + recursive = true; + + delete (get (h, "children")); + + if (strcmpi (get (h, "levellistmode"), "manual")) + lvl = get (h, "levellist"); + elseif (strcmpi (get (h, "levelstepmode"), "manual")) + z = get (h, "zdata"); + lvl = ceil ((max(z(:)) - min (z(:)) ./ get (h, "levelstep"))); + else + lvl = 10; + endif + + if (strcmpi (get (h, "fill"), "on")) + X = get (h, "xdata"); + Y = get (h, "ydata"); + Z = get (h, "zdata"); + if (isvector (X) || isvector (Y)) + [X, Y] = meshgrid (X, Y); + endif + [nr, nc] = size (Z); + X0 = prepad(X, nc+1, 2 * X(1, 1) - X(1, 2), 2); + X0 = postpad(X0, nc+2, 2 * X(1, nc) - X(1, nc - 1), 2); + X0 = [X0(1, :); X0; X0(1, :)]; + Y0 = prepad(Y, nr+1, 2 * Y(1, 1) - Y(2, 1), 1); + Y0 = postpad(Y0, nr+2, 2 * Y(nr, 1) - Y(nr - 1, 1)); + Y0 = [Y0(:, 1), Y0, Y0(:, 1)]; + Z0 = -Inf(nr+2, nc+2); + Z0(2:nr+1, 2:nc+1) = Z; + [c, lev] = contourc (X0, Y0, Z0, lvl); + else + [c, lev] = contourc (get (h, "xdata"), get (h, "ydata"), + get (h, "zdata"), lvl); + endif + set (h, "contourmatrix", c); + + if (strcmpi (get (h, "levellistmode"), "manual")) + ## Do nothing + elseif (strcmpi (get (h, "levelstepmode"), "manual")) + set (h, "levellist", lev); + else + set (h, "levellist", lev); + z = get (h, "zdata"); + lvlstep = (max(z(:)) - min(z(:))) / 10; + set (h, "levelstep", lvlstep); + endif + + add_patch_children (h); + update_text (h, d); + endif + + recursive = false; +endfunction + +function update_text (h, d) + persistent recursive = false; + + if (!recursive) + recursive = true; + + delete (findobj (h, "type", "text")); + + if (strcmpi (get (h, "textlistmode"), "manual")) + lvl = get (h, "textlist"); + elseif (strcmpi (get (h, "textstepmode"), "manual")) + lev = get (h, "levellist"); + + lvl_eps = get_lvl_eps (lev); + + stp = get (h, "textstep"); + t = [0, floor(cumsum(diff (lev)) / (abs(stp) - lvl_eps))]; + lvl = lev([true, t(1:end-1) != t(2:end)]); + set (h, "textlist", lvl); + else + lvl = get (h, "levellist"); + set (h, "textlist", lvl, "textstep", get (h, "levelstep")); + endif + + if (strcmpi (get (h, "showtext"), "on")) + switch (get (h, "zlevelmode")) + case "manual" + __clabel__ (get (h, "contourmatrix"), lvl, h, + get (h, "labelspacing"), get (h, "zlevel")); + case "auto" + __clabel__ (get (h, "contourmatrix"), lvl, h, + get (h, "labelspacing"), "auto"); + otherwise + __clabel__ (get (h, "contourmatrix"), lvl, h, + get (h, "labelspacing"), []); + endswitch + endif + + recursive = false; + endif +endfunction + +function lvl_eps = get_lvl_eps (lev) + ## FIXME -- is this the right thing to do for this tolerance? Should + ## it be an absolute or relative tolerance, or switch from one to the + ## other depending on the value of lev? + if (isscalar (lev)) + lvl_eps = abs (lev) * sqrt (eps) + sqrt (eps); + else + tmp = min (abs (diff (lev))); + if (tmp < 10*eps) + lvl_eps = sqrt (eps); + else + lvl_eps = tmp / 1000.0; + endif + endif +endfunction diff --git a/octave_packages/m/plot/private/__default_plot_options__.m b/octave_packages/m/plot/private/__default_plot_options__.m new file mode 100644 index 0000000..ecdec70 --- /dev/null +++ b/octave_packages/m/plot/private/__default_plot_options__.m @@ -0,0 +1,34 @@ +## Copyright (C) 2007-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{options} =} __default_plot_options__ () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function options = __default_plot_options__ () + + options.key = ""; + options.color = []; + options.linestyle = []; + options.marker = []; + options.errorstyle = []; + +endfunction diff --git a/octave_packages/m/plot/private/__errcomm__.m b/octave_packages/m/plot/private/__errcomm__.m new file mode 100644 index 0000000..26296b9 --- /dev/null +++ b/octave_packages/m/plot/private/__errcomm__.m @@ -0,0 +1,78 @@ +## Copyright (C) 2001-2012 Teemu Ikonen +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __errcomm__ (@var{caller}, @var{p}, @dots{}) +## Undocumented internal function. +## @end deftypefn + +## Created: 20.02.2001 +## Author: Teemu Ikonen +## Keywords: errorbar, plotting + +function retval = __errcomm__ (caller, p, varargin) + + if (nargin < 4) + print_usage (); + endif + + nargs = length (varargin); + retval = []; + k = 1; + data = cell(6,1); + while (k <= nargs) + a = varargin{k++}; + if (isvector (a)) + a = a(:); + elseif (ismatrix (a)) + ; + else + usage ("%s (...)", caller); + endif + sz = size (a); + ndata = 1; + data{ndata} = a; + while (k <= nargs) + a = varargin{k++}; + if (ischar (a) || iscellstr (a)) + retval = [retval; __errplot__(a, p, data{1:ndata})]; + break; + elseif (isvector (a)) + a = a(:); + elseif (ismatrix (a)) + ; + else + error ("wrong argument types"); + endif + if (size (a) != sz) + error ("argument sizes do not match"); + endif + data{++ndata} = a; + if (ndata > 6) + error ("too many arguments to a plot"); + endif + endwhile + endwhile + + if (! (ischar (a) || iscellstr (a))) + retval = [retval; __errplot__("~", p, data{1:ndata})]; + endif + + drawnow (); + +endfunction diff --git a/octave_packages/m/plot/private/__errplot__.m b/octave_packages/m/plot/private/__errplot__.m new file mode 100644 index 0000000..41bf71e --- /dev/null +++ b/octave_packages/m/plot/private/__errplot__.m @@ -0,0 +1,336 @@ +## Copyright (C) 2000-2012 Teemu Ikonen +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} __errplot__ (@var{fstr}, @var{p}, @dots{}) +## Undocumented internal function. +## @end deftypefn + +## Created: 18.7.2000 +## Author: Teemu Ikonen +## Keywords: errorbar, plotting + +function h = __errplot__ (fstr, p, varargin) + + if (nargin < 4 || nargin > 8) # at least two data arguments needed + print_usage (); + endif + + [fmt, valid] = __pltopt__ ("__errplot__", fstr); + + [len, nplots] = size (varargin{1}); + h = []; + + for i = 1:nplots + ## Set the plot type based on linestyle. + + if (strcmp (fmt.errorstyle, "~")) + ifmt = "yerr"; + elseif (strcmp (fmt.errorstyle, ">")) + ifmt = "xerr"; + elseif (strcmp (fmt.errorstyle, "~>")) + ifmt = "xyerr"; + elseif (strcmp (fmt.errorstyle, "#")) + ifmt = "box"; + elseif (strcmp (fmt.errorstyle, "#~")) + ifmt = "boxy"; + elseif (strcmp (fmt.errorstyle, "#~>")) + ifmt = "boxxy"; + else + ifmt = "yerr"; + endif + + hg = hggroup ("parent", p); + h = [h; hg]; + args = __add_datasource__ ("__errplot__", hg, + {"x", "y", "l", "u", "xl", "xu"}); + + if (isempty (fmt.color)) + fmt.color = __next_line_color__ (); + endif + if (isempty (fmt.marker) && isempty (fmt.linestyle)) + [fmt.linestyle, fmt.marker] = __next_line_style__ (); + endif + hl = [(__line__ (hg, "linestyle", fmt.linestyle, "marker", fmt.marker, + "color", fmt.color)), + (__line__ (hg, "linestyle", "-", "marker", "none", + "color", fmt.color))]; + + switch (numel(varargin)) + case 2 + ydata = varargin{1}(:,i); + xdata = 1:numel (ydata); + if (strcmp (ifmt, "xerr") || strcmp (ifmt, "box")) + xldata = varargin{2}(:,i); + xudata = ldata; + ldata = []; + udata = []; + elseif (strcmp (ifmt, "yerr") || strcmp (ifmt, "boxy")) + ldata = varargin{2}(:,i); + udata = ldata; + xldata = []; + xudata = []; + else + error ("errorbar: 2 column errorplot is only valid for xerr or yerr"); + endif + case 3 + if (strcmp (ifmt, "boxxy") || strcmp (ifmt, "xyerr")) + ydata = varargin{1}(:,i); + xdata = 1:numel (ydata); + xldata = varargin{2}(:,i); + xudata = xldata; + ldata = varargin{3}(:,i); + udata = ldata; + elseif (strcmp (ifmt, "xerr") || strcmp (ifmt, "box")) + xdata = varargin{1}(:,i); + ydata = varargin{2}(:,i); + xldata = varargin{3}(:,i); + xudata = xldata; + ldata = []; + udata = []; + else # yerr or boxy + xdata = varargin{1}(:,i); + ydata = varargin{2}(:,i); + ldata = varargin{3}(:,i); + udata = ldata; + xldata = []; + xudata = []; + endif + case 4 + if (strcmp (ifmt, "boxxy") || strcmp (ifmt, "xyerr")) + xdata = varargin{1}(:,i); + ydata = varargin{2}(:,i); + xldata = varargin{3}(:,i); + xudata = xldata; + ldata = varargin{4}(:,i); + udata = ldata; + elseif (strcmp (ifmt, "xerr") || strcmp (ifmt, "box")) + xdata = varargin{1}(:,i); + ydata = varargin{2}(:,i); + xldata = varargin{3}(:,i); + xudata = varargin{4}(:,i); + ldata = []; + udata = []; + else # yerr or boxy + xdata = varargin{1}(:,i); + ydata = varargin{2}(:,i); + ldata = varargin{3}(:,i); + udata = varargin{4}(:,i); + xldata = []; + xudata = []; + endif + case 6 # boxxy, xyerr + if (strcmp (ifmt, "boxxy") || strcmp (ifmt, "xyerr")) + xdata = varargin{1}(:,i); + ydata = varargin{2}(:,i); + xldata = varargin{3}(:,i); + xudata = varargin{4}(:,i); + ldata = varargin{5}(:,i); + udata = varargin{6}(:,i); + else + error ("errorbar: error plot with 6 columns only valid for boxxy and xyerr"); + endif + otherwise + error ("errorbar: error plot requires 2, 3, 4, or 6 arguments"); + endswitch + + addproperty ("xdata", hg, "data", xdata(:)); + addproperty ("ydata", hg, "data", ydata(:)); + addproperty ("ldata", hg, "data", ldata(:)); + addproperty ("udata", hg, "data", udata(:)); + addproperty ("xldata", hg, "data", xldata(:)); + addproperty ("xudata", hg, "data", xudata(:)); + addproperty ("format", hg, "string", ifmt); + + addproperty ("color", hg, "linecolor", get (hl(1), "color")); + addproperty ("linewidth", hg, "linelinewidth", get (hl(1), "linewidth")); + addproperty ("linestyle", hg, "linelinestyle", get (hl(1), "linestyle")); + addproperty ("marker", hg, "linemarker", get (hl(1), "marker")); + addproperty ("markerfacecolor", hg, "linemarkerfacecolor", + get (hl(1), "markerfacecolor")); + addproperty ("markeredgecolor", hg, "linemarkerfacecolor", + get (hl(1), "markeredgecolor")); + addproperty ("markersize", hg, "linemarkersize", + get (hl(1), "markersize")); + + fcn = {@update_props, hl}; + addlistener (hg, "color", fcn); + addlistener (hg, "linewidth", fcn); + addlistener (hg, "linestyle", fcn); + addlistener (hg, "marker", fcn); + addlistener (hg, "markerfacecolor", fcn); + addlistener (hg, "markersize", fcn); + + fcn = {@update_data, hl}; + addlistener (hg, "xdata", fcn); + addlistener (hg, "ydata", fcn); + addlistener (hg, "ldata", fcn); + addlistener (hg, "udata", fcn); + addlistener (hg, "xldata", fcn); + addlistener (hg, "xudata", fcn); + addlistener (hg, "format", fcn); + + hax = ancestor (hg, "axes"); + addlistener (hax, "xscale", fcn); + addlistener (hax, "yscale", fcn); + + update_data (hg, [], hl); + + endfor + + ## Process legend key + if (! isempty (fmt.key)) + hlegend = []; + fkids = get (gcf(), "children"); + for i = 1 : numel (fkids) + if (ishandle (fkids(i)) && strcmp (get (fkids(i), "type"), "axes") + && (strcmp (get (fkids(i), "tag"), "legend"))) + udata = get (fkids(i), "userdata"); + if (! isempty (intersect (udata.handle, gca ()))) + hlegend = fkids (i); + break; + endif + endif + endfor + + if (isempty (hlegend)) + hlgnd = []; + tlgnd = {}; + else + [hlgnd, tlgnd] = __getlegenddata__ (hlegend); + endif + + hlgnd(end+1) = hg; + tlgnd(end+1) = fmt.key; + + legend (gca(), hlgnd, tlgnd); + end + +endfunction + +function [xdata, ydata] = errorbar_data (xdata, ydata, ldata, udata, + xldata, xudata, ifmt, + xscale, yscale) + if (strcmp (xscale, "linear")) + dx = 0.01 * (max (xdata(:)) - min (xdata(:))); + xlo = xdata - dx; + xhi = xdata + dx; + else + n = xdata > 0; + rx = exp(0.01 * (max (log(xdata(n))) - min (log(xdata(n))))); + xlo = xdata/rx; + xhi = xdata*rx; + endif + if (strcmp (yscale, "linear")) + dy = 0.01 * (max (ydata(:)) - min (ydata(:))); + ylo = ydata - dy; + yhi = ydata + dy; + else + n = ydata > 0; + ry = exp(0.01 * (max (log(ydata(n))) - min (log(ydata(n))))); + ylo = ydata/ry; + yhi = ydata*ry; + endif + nans = NaN + xdata(:); + if (strcmp (ifmt, "yerr")) + xdata = [xdata, xdata, nans, ... + xlo, xhi, nans, ... + xlo, xhi, nans]; + ydata = [ydata-ldata, ydata+udata, nans, ... + ydata+udata, ydata+udata, nans, ... + ydata-ldata, ydata-ldata, nans]; + elseif (strcmp (ifmt, "xerr")) + xdata = [xdata-xldata, xdata+xudata, nans, ... + xdata+xudata, xdata+xudata, nans, ... + xdata-xldata, xdata-xldata, nans]; + ydata = [ydata, ydata, nans, ... + ylo, yhi, nans, ... + ylo, yhi, nans]; + elseif (strcmp (ifmt, "boxy")) + dx = 0.01 * (max (xdata(:)) - min (xdata(:))); + xdata = [xlo, xhi, xhi, xlo, xlo, nans]; + ydata = [ydata-ldata, ydata-ldata, ydata+udata, ydata+udata, ... + ydata-ldata, nans]; + elseif (strcmp (ifmt, "box")) + dy = 0.01 * (max (ydata(:)) - min (ydata(:))); + xdata = [xdata-xldata, xdata+xudata, xdata+xudata, xdata-xldata, ... + xdata-xldata, nans]; + ydata = [ylo, ylo, yhi, yhi, ylo, nans]; + elseif (strcmp (ifmt, "boxxy")) + xdata = [xdata-xldata, xdata+xudata, xdata+xudata, xdata-xldata, ... + xdata-xldata, nans]; + ydata = [ydata-ldata, ydata-ldata, ydata+udata, ydata+udata, ... + ydata-ldata, nans]; + elseif (strcmp (ifmt, "xyerr")) + [x1, y1] = errorbar_data (xdata, ydata, ldata, udata, + xldata, xudata, "xerr", xscale, yscale); + [x2, y2] = errorbar_data (xdata, ydata, ldata, udata, + xldata, xudata, "yerr", xscale, yscale); + xdata = [x1; x2]; + ydata = [y1; y2]; + return + else + error ("errorbar: valid error bar types are xerr, yerr, boxxy, and xyerr"); + endif + + xdata = xdata.'(:); + ydata = ydata.'(:); + +endfunction + +function update_props (hg, dummy, hl) + set (hl, "color", get (hg, "color"), + "linewidth", get (hg, "linewidth"));, + set (hl(1), "linestyle", get (hg, "linestyle"), + "marker", get (hg, "marker"), + "markersize", get (hg, "markersize"), + "markerfacecolor", get (hg, "markerfacecolor"), + "markeredgecolor", get (hg, "markeredgecolor")); +endfunction + +function update_data (hg, dummy, hl) + + if (strcmp (get (hg, "type"), "axes")) + hax = hg; + hg = ancestor (hl(1), "hggroup"); + else + hax = ancestor (hg, "axes"); + endif + xscale = get (hax, "xscale"); + yscale = get (hax, "yscale"); + + xdata = get (hg, "xdata"); + ydata = get (hg, "ydata"); + ldata = get (hg, "ldata"); + udata = get (hg, "udata"); + xldata = get (hg, "xldata"); + xudata = get (hg, "xudata"); + ifmt = get (hg, "format"); + + set (hl(1), "xdata", xdata); + set (hl(1), "ydata", ydata); + + [errorbar_xdata, errorbar_ydata] = ... + errorbar_data (xdata, ydata, ldata, udata, xldata, xudata, ... + ifmt, xscale, yscale); + + set (hl(2), "xdata", errorbar_xdata); + set (hl(2), "ydata", errorbar_ydata); + +endfunction + diff --git a/octave_packages/m/plot/private/__ezplot__.m b/octave_packages/m/plot/private/__ezplot__.m new file mode 100644 index 0000000..3d1642f --- /dev/null +++ b/octave_packages/m/plot/private/__ezplot__.m @@ -0,0 +1,445 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{h}, @var{needusage}] =} __ezplot__ (@var{pfunc}, @var{varargin}) +## Undocumented internal function. +## @end deftypefn + +function [h, needusage] = __ezplot__ (pfunc, varargin) + + func = cstrcat ("ez", pfunc); + if (strncmp (pfunc, "contour", 7)) + iscontour = true; + else + iscontour = false; + endif + if (strcmp (pfunc, "plot")) + isplot = true; + isplot3 = false; + ispolar = false; + nargs = 1; + elseif (strcmp (pfunc, "plot3")) + isplot = false; + isplot3 = true; + ispolar = false; + nargs = 1; + elseif (strcmp (pfunc, "polar")) + isplot = false; + isplot3 = false; + ispolar = true; + nargs = 1; + else + isplot = false; + isplot3 = false; + ispolar = false; + nargs = 2; + endif + + [ax, varargin, nargin] = __plt_get_axis_arg__ (func, varargin{:}); + + needusage = false; + if (nargin < 1) + needusage = true; + return; + endif + + parametric = false; + fun = varargin {1}; + if (ischar (fun)) + if (exist (fun, "file") || exist (fun, "builtin")) + fun = vectorize (inline (cstrcat (fun, "(t)"))); + else + fun = vectorize (inline (fun)); + endif + if (isplot && length (argnames (fun)) == 2) + nargs = 2; + elseif (length (argnames (fun)) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + fstr = formula (fun); + if (isplot) + xarg = argnames(fun){1}; + if (nargs == 2) + yarg = argnames(fun){2}; + else + yarg = ""; + endif + elseif (isplot3) + xarg = "x"; + yarg = "y"; + elseif (ispolar) + xarg = ""; + yarg = ""; + else + xarg = argnames(fun){1}; + yarg = argnames(fun){2}; + endif + elseif (strcmp (typeinfo (fun), "inline function")) + if (isplot && length (argnames (fun)) == 2) + nargs = 2; + elseif (length (argnames (fun)) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + fun = vectorize (fun); + fstr = formula (fun); + if (isplot) + xarg = argnames(fun){1}; + if (nargs == 2) + yarg = argnames(fun){2}; + else + yarg = ""; + endif + elseif (isplot3) + xarg = "x"; + yarg = "y"; + elseif (isplot || ispolar) + xarg = ""; + yarg = ""; + else + xarg = argnames(fun)(1); + yarg = argnames(fun)(2); + endif + elseif (isa (fun, "function_handle")) + fstr = func2str (fun); + if (length (findstr (fstr, ")")) != 0) + args = regexp (substr (fstr, 3, findstr (fstr, ")")(1) - 3), + '(\w+)', 'tokens'); + fstr = substr (fstr, findstr (fstr, ")")(1) + 1); + else + args = {{"x"}}; + endif + if (isplot && length (args) == 2) + nargs = 2; + elseif (length (args) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + if (isplot) + xarg = args{1}{1}; + if (nargs == 2) + yarg = args{2}{1}; + else + yarg = ""; + endif + elseif (isplot3) + xarg = "x"; + yarg = "y"; + elseif (ispolar) + xarg = ""; + yarg = ""; + else + xarg = args{1}{1}; + yarg = args{2}{1}; + endif + else + error ("%s: expecting string, inline function or function handle", func); + endif + + if (nargin > 2 || (nargin == 2 && isplot)) + funx = fun; + fstrx = fstr; + funy = varargin {2}; + if (ischar (funy) && ! strcmp (funy, "circ") && ! strcmp (funy, "animate")) + parametric = true; + if (exist (funy, "file") || exist (funy, "builtin")) + funy = vectorize (inline (cstrcat (funy, "(t)"))); + else + funy = vectorize (inline (funy)); + endif + if (length (argnames (funy)) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + fstry = formula (funy); + elseif (strcmp (typeinfo (funy), "inline function")) + parametric = true; + if (length (argnames (funy)) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + funy = vectorize (funy); + fstry = formula (funy); + elseif (isa (funy, "function_handle")) + parametric = true; + fstry = func2str (funy); + if (length (findstr (fstry, ")")) != 0) + args = regexp (substr (fstry, 3, findstr (fstry, ")")(1) - 3), + '(\w+)', 'tokens'); + fstry = substr (fstry, findstr (fstry, ")")(1) + 1); + else + args = {{"y"}}; + endif + if (length (args) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + endif + + if (parametric && isplot) + xarg = "x"; + yarg = "y"; + if (nargs == 2) + error ("%s: can not define a parametric function in this manner"); + endif + endif + + if (!isplot && parametric) + funz = varargin {3}; + if (ischar (funz) && ! strcmp (funz, "circ") + && ! strcmp (funz, "animate")) + if (exist (funz, "file") || exist (funz, "builtin")) + funz = vectorize (inline (cstrcat (funz, "(t)"))); + else + funz = vectorize (inline (funz)); + endif + if (length (argnames (funz)) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + fstrz = formula (funz); + elseif (strcmp (typeinfo (funz), "inline function")) + if (length (argnames (funz)) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + funz = vectorize (funz); + fstrz = formula (funz); + elseif (isa (funz, "function_handle")) + fstrz = func2str (funz); + args = regexp (substr (fstrz, 3, findstr (fstrz, ")")(1) - 3), + '(\w+)', 'tokens'); + if (length (args) != nargs) + error ("%s: excepting a function of %d arguments", func, nargs); + endif + fstrz = substr (fstrz, findstr (fstrz, ")")(1) + 1); + else + error ("%s: parametric plots expect 3 functions", func); + endif + endif + endif + + if (isplot && nargs != 2) + n = 500; + else + n = 60; + endif + domain = []; + circ = false; + animate = false; + if (parametric) + if (isplot) + iarg = 3; + else + iarg = 4; + endif + else + iarg = 2; + endif + while (iarg <= nargin) + arg = varargin{iarg++}; + if (ischar (arg) && strcmp (arg, "circ")) + circ = true; + elseif (ischar (arg) && strcmp (arg, "animate")) + animate = true; + elseif (isscalar (arg)) + n = arg; + elseif (numel (arg) == 2) + domain = [arg(:).' arg(:).']; + elseif (numel (arg) == 4) + domain = arg(:).'; + else + error ("%s: expecting scalar, 2 or 4 element vector", func); + endif + endwhile + + if (isempty (domain)) + if (isplot3 || ispolar) + domain = [0, 2*pi, 0, 2*pi]; + else + domain = [-2*pi, 2*pi, -2*pi, 2*pi]; + endif + endif + + if (circ) + if (iscontour || isplot3 || isplot) + needusage = true; + return; + endif + if (parametric) + error ("%s: can not have both circular domain and parametric function", + func); + endif + cent = [domain(1) + domain(2), domain(3) + domain(4)] / 2; + funx = @(r,t) r .* cos (t) + cent (1); + funy = @(r,t) r .* sin (t) + cent (2); + domain = [0, sqrt((domain(2) - cent(1))^2 + (domain(4) - cent(2))^2), ... + -pi, pi]; + funz = fun; + parametric = true; + endif + + if (animate) + if (!isplot3) + error ("%s: animated graphs only valid with plot3", func); + endif + error ("%s: animated graphs not implemented", func); + endif + + if (isplot3 || ispolar || (isplot && nargs == 1)) + X = linspace (domain (1), domain (2), n); + elseif (isplot && numel (domain) == 2) + x = linspace (domain (1), domain (2), n); + [X, Y] = meshgrid (x, x); + else + x = linspace (domain (1), domain (2), n); + y = linspace (domain (3), domain (4), n); + [X, Y] = meshgrid (x, y); + endif + + if (parametric) + if (isplot) + XX = feval (funx, X); + Z = feval (funy, X); + X = XX; + elseif (isplot3) + Z = feval (funz, X); + XX = feval (funx, X); + YY = feval (funy, X); + X = XX; + Y = YY; + else + Z = feval (funz, X, Y); + XX = feval (funx, X, Y); + YY = feval (funy, X, Y); + X = XX; + Y = YY; + + ## Eliminate the singularities + X = __eliminate_sing__ (X); + Y = __eliminate_sing__ (Y); + Z = __eliminate_sing__ (Z); + endif + + fstrx = regexprep (regexprep (regexprep (fstrx,'\s*\.?\^\s*','^'), + '\./', '/'), '\.?\*', ''); + fstry = regexprep (regexprep (regexprep (fstry,'\s*\.?\^\s*','^'), + '\./', '/'), '\.?\*', ''); + if (isplot) + fstr = cstrcat ("x = ",fstrx,", y = ",fstry); + else + fstrz = regexprep (regexprep (regexprep (fstrz,'\s*\.?\^\s*','^'), + '\./', '/'), '\.?\*', ''); + fstr = cstrcat ("x = ",fstrx,",y = ",fstry,", z = ",fstrz); + endif + else + if (isplot3) + needusage = true; + return; + endif + + fstr = regexprep (regexprep (regexprep (fstr,'\s*\.?\^\s*','^'), '\./', '/'), + '\.?\*', ''); + if (isplot && nargs == 2) + if (strcmp (typeinfo (fun), "inline function") + && !isempty (strfind (formula (fun) , "="))) + fun = inline (cstrcat (strrep (formula (fun), "=", "- ("), ")")); + else + fstr = cstrcat (fstr, " = 0"); + endif + + Z = feval (fun, X, Y); + + ## Matlab returns line objects for this case and so can't call + ## contour directly as it returns patch objects to allow colormaps + ## to work with contours. Therefore recreate the lines from the + ## output for contourc, and store in cell arrays. + [c, lev] = contourc (X, Y, Z, [0, 0]); + + i1 = 1; + XX = {}; + YY = {}; + while (i1 < length (c)) + clev = c(1,i1); + clen = c(2,i1); + XX = [XX, {c(1, i1+1:i1+clen)}]; + YY = [YY, {c(2, i1+1:i1+clen)}]; + i1 += clen+1; + endwhile + else + if (ispolar) + Z = feval (fun, X); + elseif (isplot) + Z = real (feval (fun, X)); + + ## Eliminate the singularities. This seems to be what matlab + ## does, but can't be sure. + XX = sort (Z (isfinite (Z))); + if (length (X) > 4) + d = XX(fix (7 * length (XX) / 8)) - XX(fix (length (XX) / 8)); + yrange = [max(XX(1) - d/8, XX(fix (length (XX) / 8)) - d), ... + min(XX(end) + d/8, XX(fix (7 * length (XX) / 8)) + d)]; + else + yrange = [XX(1), XX(end)]; + endif + + idx = 2 : length(Z); + idx = find (((Z(idx) > yrange(2) / 2) & (Z(idx-1) < yrange(1) / 2)) | + ((Z(idx) < yrange(1) / 2) & (Z(idx-1) > yrange (2) / 2))); + if (any(idx)) + Z(idx) = NaN; + endif + else + Z = feval (fun, X, Y); + + ## Eliminate the singularities + Z = __eliminate_sing__ (Z); + endif + endif + endif + + oldax = gca (); + unwind_protect + axes (ax); + if (iscontour) + [clev, h] = feval (pfunc, X, Y, Z); + elseif (isplot && nargs == 2) + h = []; + hold_state = get (ax, "nextplot"); + for i = 1 : length (XX) + h = [h; plot(XX{i}, YY{i})]; + if (i == 1) + set (ax, "nextplot", "add"); + endif + endfor + set (ax, "nextplot", hold_state); + elseif (ispolar || isplot) + h = feval (pfunc, X, Z); + if (isplot && !parametric) + axis ([X(1), X(end), yrange]); + endif + else + h = feval (pfunc, X, Y, Z); + endif + xlabel (xarg); + ylabel (yarg); + title (fstr); + unwind_protect_cleanup + axes (oldax); + end_unwind_protect + +endfunction + +function x = __eliminate_sing__ (x) + x (isinf (x)) = NaN; + x (abs (del2 (x)) > 0.2 * (max(x(:)) - min(x(:)))) = NaN; +endfunction diff --git a/octave_packages/m/plot/private/__file_filter__.m b/octave_packages/m/plot/private/__file_filter__.m new file mode 100644 index 0000000..711b837 --- /dev/null +++ b/octave_packages/m/plot/private/__file_filter__.m @@ -0,0 +1,93 @@ +## Copyright (C) 2010-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __file_filter__ (@var{file_filter}) +## Undocumented internal function. +## @end deftypefn + +## Author: Kai Habel + +function [retval, defname, defdir] = __file_filter__ (file_filter, name) + + revtal = {}; + defname = ""; + defdir = ""; + + if (iscell (file_filter)) + [r, c] = size (file_filter); + if (c != 1 && c != 2) + error ("%s: invalid filter specification", name); + endif + if (c == 1) + retval = cell (r, 2); + for i = 1:r + retval{i, 1} = file_filter{i}; + retval{i, 2} = __default_filtername__ (file_filter{i}); + endfor + else + retval = file_filter; + for i = 1:r + if (isempty (retval{i, 2})) + retval{i, 2} = __default_filtername__ (retval{i, 1}); + endif + endfor + endif + elseif (ischar (file_filter)) + [defdir, fname, fext] = fileparts (file_filter); + if (! strcmp (fname, "*")) + defname = strcat (fname, fext); + endif + if (length (fext) > 0) + fext = strcat ("*", fext); + retval = {fext, __default_filtername__(fext)}; + endif + endif + + retval(end+1,:) = {"*", __default_filtername__("*")}; + +endfunction + +function name = __default_filtername__ (filterext) + + name = ""; + + switch (filterext) + case "*" + name = "All Files"; + case "*.m" + name = "Octave Source Files"; + case "*.c" + name = "C Source Files"; + case {"*.cc" "*.c++" "*.cpp"} + name = "C++ Source Files"; + case "*.oct" + name = "Octave Compiled Files"; + endswitch + + if (isempty (name)) + extlist = strsplit(filterext, ";"); + extlist = strrep (extlist, "*.", ""); + extlist = toupper (extlist); + extlist(end+1, :) = repmat ({","}, 1, length (extlist)); + extlist = strcat (extlist{:}); + extlist = extlist(1:end-1); + name = strcat (extlist, "-Files"); + endif + +endfunction diff --git a/octave_packages/m/plot/private/__fltk_file_filter__.m b/octave_packages/m/plot/private/__fltk_file_filter__.m new file mode 100644 index 0000000..586853b --- /dev/null +++ b/octave_packages/m/plot/private/__fltk_file_filter__.m @@ -0,0 +1,64 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{filterspec} =} __fltk_file_filter__ (@var{filter}) +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function retval = __fltk_file_filter__ (file_filter) + + retval = ""; + [r, c] = size (file_filter); + if ((c == 0) || (c > 2)) + error ("expecting 1 or to 2 columns for file filter cell"); + endif + fltk_str = ""; + for idx = 1 : r + + curr_ext = file_filter{idx, 1}; + curr_ext = strsplit (curr_ext, ";"); + + if (length (curr_ext) > 1) + curr_ext = regexprep (curr_ext, '\*\.', ','); + curr_ext = strcat (curr_ext{:})(2 : end); + curr_ext = strcat ("*.{", curr_ext, "}"); + else + curr_ext = curr_ext{:}; + endif + + curr_desc = strcat (curr_ext(3:end), "-Files"); + + if (c == 2) + curr_desc = file_filter{idx, 2}; + curr_desc = regexprep (curr_desc, '\(', '<'); + curr_desc = regexprep (curr_desc, '\)', '>'); + endif + + if (length (fltk_str) > 0) + fltk_str = strcat (fltk_str, "\t", curr_desc, " (", curr_ext, ")"); + else + fltk_str = strcat (curr_desc, " (", curr_ext, ")"); + endif + + endfor + retval = fltk_str; + +endfunction diff --git a/octave_packages/m/plot/private/__fltk_ginput__.m b/octave_packages/m/plot/private/__fltk_ginput__.m new file mode 100644 index 0000000..42047af --- /dev/null +++ b/octave_packages/m/plot/private/__fltk_ginput__.m @@ -0,0 +1,105 @@ +## Copyright (C) 2010-2012 Shai Ayal +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{y}, @var{buttons}] =} __fltk_ginput__ (@var{f}, @var{n}) +## Undocumented internal function. +## @end deftypefn + +## This is ginput.m implementation for fltk. + +## FIXME -- Key presses cannot toggle menu items nor hotkey functionality +## (grid, autoscale) during ginput! + +function [x, y, button] = __fltk_ginput__ (f, n = -1) + + if (isempty (get (f, "currentaxes"))) + error ("ginput: must have at least one axes"); + endif + + x = y = button = []; + ginput_aggregator (0, 0, 0, 0); + + unwind_protect + + orig_windowbuttondownfcn = get (f, "windowbuttondownfcn"); + set (f, "windowbuttondownfcn", @ginput_windowbuttondownfcn); + + orig_ginput_keypressfcn = get (f, "keypressfcn"); + set (f, "keypressfcn", @ginput_keypressfcn); + + while (true) + __fltk_redraw__ (); + + ## Release CPU. + sleep (0.01); + + [x, y, n0, button] = ginput_aggregator (-1, 0, 0, 0); + if (n0 == n || n0 < 0) + break; + endif + endwhile + + unwind_protect_cleanup + set (f, "windowbuttondownfcn", orig_windowbuttondownfcn); + set (f, "keypressfcn", orig_ginput_keypressfcn); + end_unwind_protect + +endfunction + +function [x, y, n, button] = ginput_aggregator (mode, xn, yn, btn) + persistent x y n button; + + if (mode == 0) + ## Initialize. + x = []; + y = []; + button = []; + n = 0; + elseif (mode == 1) + ## Accept mouse button or key press. + x = [x; xn]; + y = [y; yn]; + button = [button; btn]; + n += 1; + elseif (mode == 2) + ## The end due to Enter. + n = -1; + endif +endfunction + +function ginput_windowbuttondownfcn (src, data) + point = get (get (src,"currentaxes"), "currentpoint"); + ## FIXME -- How to get the actual mouse button pressed (1,2,3) into + ## "button"? + button = 1; + ginput_aggregator (1, point(1,1), point(2,1), button); +endfunction + +function ginput_keypressfcn (src, evt) + point = get (get (src, "currentaxes"), "currentpoint"); + ## FIXME -- use evt.Key or evt.Character? + key = evt.Key; + if (key == 10) + ## Enter key. + ginput_aggregator (2, point(1,1), point(2,1), key); + else + ginput_aggregator (1, point(1,1), point(2,1), key); + endif +endfunction + diff --git a/octave_packages/m/plot/private/__fltk_print__.m b/octave_packages/m/plot/private/__fltk_print__.m new file mode 100644 index 0000000..7c564e6 --- /dev/null +++ b/octave_packages/m/plot/private/__fltk_print__.m @@ -0,0 +1,163 @@ +## Copyright (C) 2010-2012 Shai Ayal +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __fltk_print__ (@var{@dots{}}) +## Undocumented internal function. +## @end deftypefn + +function opts = __fltk_print__ (opts) + + dos_shell = (ispc () && ! isunix ()); + + figure (opts.figure); + drawnow ("expose"); + __fltk_redraw__ (); + + if (! isempty (opts.fig2dev_binary)) + ## fig2dev is prefered for conversion to emf + fig2dev_devices = {"pstex", "mf", "emf"}; + else + fig2dev_devices = {"pstex", "mf"}; + endif + + gl2ps_device = {}; + pipeline = {}; + switch (lower (opts.devopt)) + case {"eps", "eps2", "epsc", "epsc2"} + ## format GL2PS_EPS + gl2ps_device = {"eps"}; + ## FIXME - use epstool to tighten bbox and provide preview. + pipeline = {opts.epstool_cmd(opts, "-", opts.name)}; + case {"epslatex", "pslatex", "pdflatex", "epslatexstandalone", ... + "pslatexstandalone", "pdflatexstandalone"} + ## format GL2PS_TEX + n = find (opts.devopt == "l", 1); + suffix = opts.devopt(1:n-1); + dot = find (opts.name == ".", 1, "last"); + if ((! isempty (dot)) + && any (strcmpi (opts.name(dot:end), ... + {strcat(".", suffix), ".tex", "."}))) + name = opts.name(1:dot-1); + if (dot < numel (opts.name) + && any (strcmpi (opts.name(dot+1:end), {"eps", "ps", "pdf"}))) + ## If user provides eps/ps/pdf suffix, use it. + suffix = opts.name(dot+1:end); + endif + else + error ("print:invalid-suffix", + "invalid suffix `%s' for device `%s'.", + opts.name(dot:end), lower (opts.devopt)); + endif + gl2ps_device = {sprintf("%snotxt", lower (suffix))}; + gl2ps_device{2} = "tex"; + if (dos_shell) + ## FIXME - this will only work on MinGW with the MSYS shell + pipeline = {sprintf("cat > %s-inc.%s", name, suffix)}; + pipeline{2} = sprintf ("cat > %s.tex", name); + else + pipeline = {sprintf("cat > %s-inc.%s", name, suffix)}; + pipeline{2} = sprintf ("cat > %s.tex", name); + endif + case "tikz" + ## format GL2PS_PGF + gl2ps_device = {"pgf"}; + pipeline = {sprintf("cat > %s", opts.name)}; + case "svg" + ## format GL2PS_SVG + gl2ps_device = {"svg"}; + pipeline = {sprintf("cat > %s", opts.name)}; + case fig2dev_devices + cmd_pstoedit = opts.pstoedit_cmd (opts, "fig"); + cmd_fig2dev = opts.fig2dev_cmd (opts, opts.devopt); + if (strcmp (opts.devopt, "pstex")) + [~, ~, ext] = fileparts (opts.name); + if (any (strcmpi (ext, {".ps", ".tex", "."}))) + opts.name = opts.name(1:end-numel(ext)); + endif + opts.name = strcat (opts.name, ".ps"); + cmd = sprintf ("%s | %s > %s", cmd_pstoedit, cmd_fig2dev, opts.name); + gl2ps_device = {"eps"}; + pipeline = {cmd}; + cmd_fig2dev = opts.fig2dev_cmd (opts, "pstex_t"); + gl2ps_device{2} = "eps"; + pipeline{2} = sprintf ("%s | %s > %s", cmd_pstoedit, + cmd_fig2dev, strrep(opts.name, ".ps", ".tex")); + else + cmd = sprintf ("%s | %s > %s", cmd_pstoedit, cmd_fig2dev, opts.name); + gl2ps_device = {"eps"}; + pipeline = {cmd}; + endif + case "aifm" + cmd = opts.pstoedit_cmd (opts, "ps2ai"); + gl2ps_device = {"eps"}; + pipeline = {sprintf("%s > %s", cmd, opts.name)}; + case {"dxf", "emf", "fig", "hpgl"} + cmd = opts.pstoedit_cmd (opts); + gl2ps_device = {"eps"}; + pipeline = {sprintf("%s > %s", cmd, opts.name)}; + case {"corel", "gif"} + error ("print:unsupporteddevice", + "print.m: %s output is not available for the FLTK graphics toolkit", + upper (opts.devopt)); + case opts.ghostscript.device + opts.ghostscript.source = "-"; + opts.ghostscript.output = opts.name; + if (opts.send_to_printer) + opts.unlink(strcmp (opts.unlink, opts.ghostscript.output)) = []; + opts.ghostscript.output = "-"; + endif + [cmd_gs, cmd_cleanup] = __ghostscript__ (opts.ghostscript); + if (opts.send_to_printer || isempty (opts.name)) + cmd_lpr = opts.lpr_cmd (opts); + cmd = sprintf("%s | %s", cmd_gs, cmd_lpr); + else + cmd = sprintf("%s", cmd_gs); + endif + if (! isempty (cmd_cleanup)) + gl2ps_device = {"eps"}; + if (dos_shell) + pipeline = {sprintf("%s & %s", cmd, cmd_cleanup)}; + else + pipeline = {sprintf("%s ; %s", cmd, cmd_cleanup)}; + endif + else + gl2ps_device = {"eps"}; + pipeline = {cmd}; + endif + otherwise + error (sprintf ("print:no%soutput", opts.devopt), + "print.m: %s output is not available for GL2PS output", + upper (opts.devopt)); + endswitch + + opts.pipeline = pipeline; + + for n = 1:numel(pipeline) + if (opts.debug) + fprintf ("fltk-pipeline: '%s'\n", pipeline{n}); + endif + drawnow (gl2ps_device{n}, strcat('|',pipeline{n})); + endfor + + if (! isempty (strfind (opts.devopt, "standalone"))) + opts.latex_standalone (opts); + endif + +endfunction + diff --git a/octave_packages/m/plot/private/__getlegenddata__.m b/octave_packages/m/plot/private/__getlegenddata__.m new file mode 100644 index 0000000..9eb4a5b --- /dev/null +++ b/octave_packages/m/plot/private/__getlegenddata__.m @@ -0,0 +1,58 @@ +## Copyright (C) 2010-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{hplots}, @var{strings}]} = __getlegenddata__ (@var{h}) +## Undocumented internal function. +## @end deftypefn + +function [hplots, text_strings] = __getlegenddata__ (hlegend) + hplots = []; + text_strings = {}; + ca = getfield (get (hlegend, "userdata"), "handle"); + kids = []; + for i = 1:numel (ca) + kids = [kids; get(ca(i), "children")]; + endfor + + for i = numel (kids):-1:1 + typ = get (kids(i), "type"); + if (strcmp (typ, "line") || strcmp (typ, "surface") + || strcmp (typ, "patch") || strcmp (typ, "hggroup")) + + if (strcmp (typ, "hggroup")) + hgkids = get (kids(i), "children"); + for j = 1 : length (hgkids) + hgobj = get (hgkids (j)); + if (isfield (hgobj, "displayname") && ! isempty (hgobj.displayname)) + hplots = [hplots, hgkids(j)]; + text_strings = {text_strings{:}, hgobj.displayname}; + break; + endif + endfor + else + if (! isempty (get (kids (i), "displayname"))) + hplots = [hplots, kids(i)]; + text_strings = {text_strings{:}, get(kids (i), "displayname")}; + endif + endif + + endif + endfor + +endfunction diff --git a/octave_packages/m/plot/private/__ghostscript__.m b/octave_packages/m/plot/private/__ghostscript__.m new file mode 100644 index 0000000..662951a --- /dev/null +++ b/octave_packages/m/plot/private/__ghostscript__.m @@ -0,0 +1,167 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __ghostscript__ (@var{@dots{}}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-07-26 + +function [gs_cmd, cleanup_cmd] = __ghostscript__ (varargin); + + opts.binary = ""; + opts.source = "-"; + opts.output = "-"; + opts.device = ""; + opts.epscrop = false; + opts.antialiasing = false; + opts.resolution = 150; + opts.papersize = ""; + opts.pageoffset = [0 0]; + opts.debug = false; + opts.level = []; + opts.prepend = ""; + + offsetfile = ""; + offset_ps = {}; + cleanup_cmd = ""; + + args = varargin; + n = find (cellfun ("isclass", args, "struct")); + if (! isempty (n)) + f = fieldnames (args{n}); + for m = 1:numel(f) + opts.(f{m}) = args{n}.(f{m}); + endfor + args(n) = []; + endif + for n = 1:2:numel(args) + opts.(args{n}) = args{n+1}; + endfor + + if (isempty (opts.papersize)) + format_for_printer = false; + else + format_for_printer = true; + endif + + gs_opts = sprintf ("-dQUIET -dNOPAUSE -dBATCH -dSAFER -sDEVICE=%s", opts.device); + + if (! isempty (opts.level) && ismember (opts.level, [1, 2, 3])) + gs_opts = sprintf ("%s -dLanguageLevel=%d", gs_opts, round (opts.level)); + endif + + if (opts.antialiasing && isempty (strfind (opts.device, "write"))) + ## Apply anti-aliasing to all bitmap formats/devices + gs_opts = sprintf ("%s -dTextAlphaBits=4 -dGraphicsAlphaBits=4", gs_opts); + gs_opts = sprintf ("%s -r%dx%d", gs_opts, [1, 1] * opts.resolution); + elseif (any (strcmp (opts.device, {"pswrite", "ps2write", "pdfwrite"}))) + gs_opts = sprintf ("%s -dEmbedAllFonts=true", gs_opts); + if (strcmp (opts.device, "pdfwrite")) + ## Optimize for loading + gs_opts = sprintf ("%s -dOptimize=true", gs_opts); + endif + endif + + if (opts.epscrop) + ## papersize is specified by the eps bbox + gs_opts = sprintf ("%s -dEPSCrop", gs_opts); + endif + if (format_for_printer) + if (ischar (opts.papersize)) + gs_opts = sprintf ("%s -sPAPERSIZE=%s", gs_opts, opts.papersize); + elseif (isnumeric (opts.papersize) && numel (opts.papersize) == 2) + gs_opts = sprintf ("%s -dDEVICEWIDTHPOINTS=%d -dDEVICEHEIGHTPOINTS=%d", + gs_opts, opts.papersize); + if (opts.papersize(1) > opts.papersize(2)) + ## Lanscape mode: This option will result in automatic rotation of the + ## document page if the requested page size matches one + ## of the default page sizes + gs_opts = sprintf ("%s -dNORANGEPAGESIZE", gs_opts); + endif + else + error ("print:badpapersize", "__ghostscript__.m: invalid 'papersize'"); + endif + gs_opts = sprintf ("%s -dFIXEDMEDIA", gs_opts); + ## "pageoffset" is relative to the coordinates, not the BBox LLHC. + str = sprintf ("%s [%d %d] %s", "<< /Margins [0 0] /.HWMargins [0 0 0 0] /PageOffset", + opts.pageoffset, ">> setpagedevice"); + offset_ps = {"%!PS-Adobe-3.0", str, "%%EOF"}; + if (isfield (opts, "offsetfile")) + offsetfile = opts.offsetfile; + cleanup_cmd = ""; + else + offsetfile = strcat (tmpnam (), ".ps"); + cleanup_cmd = sprintf ("rm %s", offsetfile); + endif + unwind_protect + fid = fopen (offsetfile, "w"); + if (fid == -1) + error ("print:fopenfailed", "__ghostscript__.m: fopen() failed"); + endif + fprintf (fid, "%s\n", offset_ps{:}); + unwind_protect_cleanup + status = fclose (fid); + if (status == -1) + error ("print:fclosefailed", "__ghostscript__.m: fclose() failed"); + endif + end_unwind_protect + if (opts.debug) + fprintf ("---- begin %s ----\n", offsetfile); + fprintf ("%s\n", offset_ps{:}); + fprintf ("----- end %s -----\n", offsetfile); + endif + endif + + if (isempty (opts.binary)) + error ("print:no_ghostscript", "__ghostscript__.m: ghostscript is required."); + elseif (isempty (opts.output)) + cmd = sprintf ("%s %s", opts.binary, gs_opts); + else + cmd = sprintf ("%s %s -sOutputFile=%s", opts.binary, gs_opts, opts.output); + endif + if (! isempty (opts.prepend) + && any (strcmpi (opts.device, {"pswrite", "ps2write", "pdfwrite"}))) + ## FIXME - Fonts get may be mangled when appending ps/ps2. + ## See "How to concatenate several PS files" at the link, + ## http://en.wikibooks.org/wiki/PostScript_FAQ + cmd = sprintf ("%s %s", cmd, opts.prepend); + if (isempty (cleanup_cmd)) + cleanup_cmd = sprintf ("rm %s", opts.prepend); + else + cleanup_cmd = sprintf ("%s ; rm %s", cleanup_cmd, opts.prepend); + endif + endif + if (! isempty (offsetfile) && format_for_printer) + cmd = sprintf ("%s %s", cmd, offsetfile); + endif + if (! isempty (opts.source)) + cmd = sprintf ("%s %s", cmd, opts.source); + endif + + if (opts.debug) + fprintf ("Ghostscript command: '%s'\n", cmd); + endif + + gs_cmd = cmd; + +endfunction + + diff --git a/octave_packages/m/plot/private/__gnuplot_get_var__.m b/octave_packages/m/plot/private/__gnuplot_get_var__.m new file mode 100644 index 0000000..5310960 --- /dev/null +++ b/octave_packages/m/plot/private/__gnuplot_get_var__.m @@ -0,0 +1,161 @@ +## Copyright (C) 2009-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{value} =} __gnuplot_get_var__ (@var{h}, @var{name}, @var{fmt}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2009-02-07 + +function gp_var_value = __gnuplot_get_var__ (h, gp_var_name, fmt) + + if (nargin == 0) + h = gcf (); + endif + if (nargin < 2) + print_usage (); + endif + if (nargin < 3) + fmt = ''; + endif + + if (numel (h) == 1 && isfigure (h)) + if (isempty (get (gcf, "__plot_stream__"))) + ostream = __gnuplot_open_stream__ (2, h); + else + ostream = get (h, "__plot_stream__"); + endif + else + ostream = h; + endif + if (numel (ostream) < 1) + error ("__gnuplot_get_var__: stream to gnuplot not open"); + elseif (ispc ()) + if (numel (ostream) == 1) + error ("__gnuplot_get_var__: Need mkfifo that is not implemented under Windows"); + endif + use_mkfifo = false; + istream = ostream(2); + ostream = ostream(1); + else + use_mkfifo = true; + ostream = ostream(1); + endif + + if (use_mkfifo) + gpin_name = tmpnam (); + + ## Mode: 6*8*8 == 0600 + [err, msg] = mkfifo (gpin_name, 6*8*8); + + if (err != 0) + error ("__gnuplot_get_var__: Can not make fifo (%s)", msg); + endif + endif + + gp_var_name = strtrim (gp_var_name); + n = min (strfind (gp_var_name, " "), strfind (gp_var_name, ",")) - 1; + if (isempty (n)) + n = numel (gp_var_name); + endif + + unwind_protect + + ## Notes: Variables may be undefined if user closes gnuplot by "q" + ## or Alt-F4. Further, this abrupt close also requires the leading + ## "\n" on the next line. + if (use_mkfifo) + fprintf (ostream, "\nset print \"%s\";\n", gpin_name); + fflush (ostream); + [gpin, err] = fopen (gpin_name, "r"); + if (err != 0) + ## Try a second time, and then give an error. + [gpin, err] = fopen (gpin_name, "r"); + endif + if (err != 0) + error ("__gnuplot_get_var__: can not open fifo"); + endif + gp_cmd = sprintf ("\nif (exists(\"%s\")) print %s; else print NaN\n", + gp_var_name(1:n), gp_var_name); + fputs (ostream, gp_cmd); + + ## Close output file, to force it to be flushed + fputs (ostream, "set print;\n"); + fflush (ostream); + + ## Now read from fifo. + reading = true; + str = {}; + while (reading) + str{end+1} = fgets (gpin); + if (isnumeric (str{end}) && (str{end} == -1)) + reading = false; + str = str(1:(end-1)); + endif + endwhile + str = strcat (str{:}); + fclose (gpin); + else + ## Direct gnuplot to print to + fprintf (ostream, "set print \"-\";\n"); + fflush (ostream); + gp_cmd = sprintf ("\nif (exists(\"%s\")) print \"OCTAVE: \", %s; else print NaN\n", + gp_var_name(1:n), gp_var_name); + fputs (ostream, gp_cmd); + fflush (ostream); + ## Direct gnuplot to print to + fputs (ostream, "set print;\n"); + fflush (ostream); + + str = {}; + while (isempty (str)) + str = char (fread (istream)'); + if (isempty (str)) + sleep (0.05); + else + str = regexp (str, 'OCTAVE:.*', "match"); + str = str{end}(8:end); + endif + fclear (istream); + endwhile + endif + + ## Strip out EOLs and the continuation character "|" + str(str=="\n") = ""; + str(str=="\r") = ""; + n_continue = strfind (str, " \\ "); + if (! isempty (n_continue)) + str(n_continue+1) = ""; + endif + + if (isempty (fmt)) + gp_var_value = strtrim (str); + else + gp_var_value = sscanf (str, fmt); + endif + + unwind_protect_cleanup + if (use_mkfifo) + unlink (gpin_name); + endif + end_unwind_protect + +endfunction + diff --git a/octave_packages/m/plot/private/__gnuplot_ginput__.m b/octave_packages/m/plot/private/__gnuplot_ginput__.m new file mode 100644 index 0000000..46ec94a --- /dev/null +++ b/octave_packages/m/plot/private/__gnuplot_ginput__.m @@ -0,0 +1,154 @@ +## Copyright (C) 2004-2012 Petr Mikulik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{y}, @var{buttons}] =} __gnuplot_ginput__ (@var{f}, @var{n}) +## Undocumented internal function. +## @end deftypefn + +## This is ginput.m implementation for gnuplot and X11. +## It requires gnuplot 4.1 and later. + +## This file initially bore the copyright statement +## Petr Mikulik +## History: June 2006; August 2005; June 2004; April 2004 +## License: public domain + +function [x, y, button] = __gnuplot_ginput__ (f, n) + + ostream = get (f, "__plot_stream__"); + if (numel (ostream) < 1) + error ("ginput: stream to gnuplot not open"); + elseif (ispc ()) + if (numel (ostream) == 1) + error ("ginput: Need mkfifo that is not implemented under Windows"); + endif + use_mkfifo = false; + istream = ostream(2); + ostream = ostream(1); + else + use_mkfifo = true; + ostream = ostream(1); + endif + + if (compare_versions (__gnuplot_version__ (), "4.0", "<=")) + error ("ginput: version %s of gnuplot not supported", gnuplot_version ()); + endif + + if (nargin == 1) + x = zeros (100, 1); + y = zeros (100, 1); + button = zeros (100, 1); + else + x = zeros (n, 1); + y = zeros (n, 1); + button = zeros (n, 1); + endif + + if (use_mkfifo) + gpin_name = tmpnam (); + + ##Mode: 6*8*8 == 0600 + [err, msg] = mkfifo (gpin_name, 6*8*8); + + if (err != 0) + error ("ginput: Can not open fifo (%s)", msg); + endif + endif + + unwind_protect + + k = 0; + while (true) + k++; + + ## Notes: MOUSE_* can be undefined if user closes gnuplot by "q" + ## or Alt-F4. Further, this abrupt close also requires the leading + ## "\n" on the next line. + if (use_mkfifo) + fprintf (ostream, "set print \"%s\";\n", gpin_name); + fflush (ostream); + [gpin, err] = fopen (gpin_name, "r"); + if (err != 0) + error ("ginput: Can not open fifo (%s)", msg); + endif + fputs (ostream, "pause mouse any;\n\n"); + fputs (ostream, "\nif (exists(\"MOUSE_KEY\") && exists(\"MOUSE_X\")) print MOUSE_X, MOUSE_Y, MOUSE_KEY; else print \"0 0 -1\"\n"); + + ## Close output file, to force it to be flushed + fputs (ostream, "set print;\n"); + fflush (ostream); + + ## Now read from fifo. + [x(k), y(k), button(k), count] = fscanf (gpin, "%f %f %d", "C"); + fclose (gpin); + else + fprintf (ostream, "set print \"-\";\n"); + fflush (ostream); + fputs (ostream, "pause mouse any;\n\n"); + fputs (ostream, "\nif (exists(\"MOUSE_KEY\") && exists(\"MOUSE_X\")) print \"OCTAVE: \", MOUSE_X, MOUSE_Y, MOUSE_KEY; else print \"0 0 -1\"\n"); + + ## Close output file, to force it to be flushed + fputs (ostream, "set print;\n"); + fflush (ostream); + + str = {}; + while (isempty (str)) + str = char (fread (istream)'); + if (isempty (str)) + sleep (0.05); + else + str = regexp (str, 'OCTAVE:\s+[-+.\d]+\s+[-+.\d]+\s+\d*', 'match'); + endif + fclear (istream); + endwhile + [x(k), y(k), button(k), count] = sscanf (str{end}(8:end), "%f %f %d", "C"); + endif + + if ([x(k), y(k), button(k)] == [0, 0, -1]) + ## Mousing not active (no plot yet). + break; + endif + + if (nargin > 1) + ## Input argument n was given => stop when k == n. + if (k == n) + break; + endif + else + ## Input argument n not given => stop when hitting a return key. + ## if (button(k) == 0x0D || button(k) == 0x0A) + ## ## hit Return or Enter + if (button(k) == 0x0D) + ## hit Return + x(k:end) = []; + y(k:end) = []; + button(k:end) = []; + break; + endif + endif + endwhile + + unwind_protect_cleanup + if (use_mkfifo) + unlink (gpin_name); + endif + end_unwind_protect + +endfunction + diff --git a/octave_packages/m/plot/private/__gnuplot_has_feature__.m b/octave_packages/m/plot/private/__gnuplot_has_feature__.m new file mode 100644 index 0000000..6649bc2 --- /dev/null +++ b/octave_packages/m/plot/private/__gnuplot_has_feature__.m @@ -0,0 +1,61 @@ +## Copyright (C) 2009-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{has_feature} =} __gnuplot_has_feature__ (@var{feature}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2009-01-27 + +function res = __gnuplot_has_feature__ (feature) + persistent features has_features + features = {"x11_figure_position", + "wxt_figure_size", + "transparent_patches", + "transparent_surface", + "epslatex_implies_eps_filesuffix", + "epslatexstandalone_terminal", + "screen_coordinates_for_{lrtb}margin", + "variable_GPVAL_TERMINALS", + "key_has_font_properties"}; + + if (isempty (has_features)) + try + gnuplot_version = __gnuplot_version__ (); + catch + ## Don't throw an error if gnuplot isn't installed + gnuplot_version = "0.0.0"; + end_try_catch + versions = {"4.2.5", "4.4", "4.4", "4.4", "4.2", "4.2", "4.4", "4.4", "4.4"}; + operators = {">=", ">=", ">=", ">=", ">=", ">=", ">=", ">=", ">="}; + have_features = logical (zeros (size (features))); + for n = 1 : numel (have_features) + has_features(n) = compare_versions (gnuplot_version, versions{n}, operators{n}); + endfor + endif + + n = find (strcmpi (feature, features)); + if (isempty (n)) + res = NaN; + else + res = has_features(n); + endif +endfunction + diff --git a/octave_packages/m/plot/private/__gnuplot_has_terminal__.m b/octave_packages/m/plot/private/__gnuplot_has_terminal__.m new file mode 100644 index 0000000..79d4621 --- /dev/null +++ b/octave_packages/m/plot/private/__gnuplot_has_terminal__.m @@ -0,0 +1,64 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{has_terminal} =} __gnuplot_has_terminal__ (@var{terminal}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-09-13 + +function gnuplot_supports_term = __gnuplot_has_terminal__ (term, plot_stream) + term = deblank (term); + n = find (term == " ", 1); + if (! isempty (n)) + term = term(1:n-1); + endif + if (__gnuplot_has_feature__ ("variable_GPVAL_TERMINALS")) + if (nargin < 2) + plot_stream = __gnuplot_open_stream__ (2); + endif + available_terminals = __gnuplot_get_var__ (plot_stream, "GPVAL_TERMINALS"); + available_terminals = regexp (available_terminals, '\w+', "match"); + if (nargin < 2 && ! isempty (plot_stream)) + pclose (plot_stream(1)); + if (numel (plot_stream) > 1) + pclose (plot_stream(2)); + endif + if (numel (plot_stream) > 2) + waitpid (plot_stream(3)); + endif + endif + else + ## Gnuplot 4.0 terminals. No new terminals were added until 4.4 which + ## allows the list of terminals to be obtained from GPVAL_TERMINALS. + available_terminals = {"aifm", "aqua", "canvas", "cgm", "corel", ... + "dumb", "dxf", "eepic", "emf", "epslatex", ... + "epson_180dpi", "fig", "gif", "gnugraph", ... + "gpic", "hp2623A", "hp2648", "hp500c", ... + "hpgl", "hpljii", "hppj", "imagen", "jpeg", ... + "latex", "mf", "mif", "mp", "pbm", "pdf", ... + "pm", "png", "postscript", "pslatex", ... + "pstex", "pstricks", "qms", "regis", "rgip", ... + "svg", "texdraw", "tgif", "tkcanvas", ... + "tpic", "windows", "x11", "xlib", "xterm"}; + endif + gnuplot_supports_term = any (strcmpi (available_terminals, term)); +endfunction + diff --git a/octave_packages/m/plot/private/__gnuplot_open_stream__.m b/octave_packages/m/plot/private/__gnuplot_open_stream__.m new file mode 100644 index 0000000..65bb7b5 --- /dev/null +++ b/octave_packages/m/plot/private/__gnuplot_open_stream__.m @@ -0,0 +1,45 @@ +## Copyright (C) 2009-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{stream} =} __gnuplot_open_stream__ (@var{npipes}, @var{h}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2009-04-11 + +function plot_stream = __gnuplot_open_stream__ (npipes, h) + [prog, args] = gnuplot_binary (); + if (npipes > 1) + [plot_stream(1), plot_stream(2), pid] = popen2 (prog, args{:}); + if (pid < 0) + error ("__gnuplot_open_stream__: failed to open connection to gnuplot"); + else + plot_stream(3) = pid; + endif + else + plot_stream = popen (sprintf ("%s ", prog, args{:}), "w"); + if (plot_stream < 0) + error ("__gnuplot_open_stream__: failed to open connection to gnuplot"); + endif + endif + if (nargin > 1) + set (h, "__plot_stream__", plot_stream); + endif +endfunction diff --git a/octave_packages/m/plot/private/__gnuplot_print__.m b/octave_packages/m/plot/private/__gnuplot_print__.m new file mode 100644 index 0000000..801bc39 --- /dev/null +++ b/octave_packages/m/plot/private/__gnuplot_print__.m @@ -0,0 +1,306 @@ +## Copyright (C) 1999-2012 Daniel Heiserer +## Copyright (C) 2001 Laurent Mazet +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __gnuplot_print__ (@var{@dots{}}) +## Undocumented internal function. +## @end deftypefn + +## Author: Daniel Heiserer +## Adapted-By: jwe + +function opts = __gnuplot_print__ (opts) + + dos_shell = (ispc () && ! isunix ()); + + if (isempty (opts.fontsize)) + ## If no fontsize, determine the nominal axes fontsize. + defaultfontsize = get (0, "defaultaxesfontsize"); + axesfontsize = get (findobj (opts.figure, "type", "axes"), "fontsize"); + if (iscell (axesfontsize)) + axesfontsize = round (median (cell2mat (axesfontsize))); + endif + if (isempty (axesfontsize)) + opts.fontsize = defaultfontsize; + else + opts.fontsize = axesfontsize; + endif + endif + ## The axes-label and tick-label spacing is determined by + ## the font spec given in "set terminal ..." + gp_opts = font_spec (opts); + + pipeline = ""; + + switch (lower (opts.devopt)) + case {"eps", "eps2", "epsc", "epsc2"} + if (any (strcmp (opts.devopt, {"eps", "epsc"}))) + gp_opts = sprintf ("%s level1", gp_opts); + endif + if (opts.tight_flag || ! isempty (opts.preview)) + tmp_file = strcat (tmpnam (), ".eps"); + eps_drawnow (opts, tmp_file, gp_opts); + if (dos_shell) + cleanup = sprintf (" & del %s", strrep (tmp_file, '/', '\')); + else + cleanup = sprintf (" ; rm %s", tmp_file); + endif + pipeline = {sprintf("%s %s", + opts.epstool_cmd (opts, tmp_file, opts.name), + cleanup)}; + else + eps_drawnow (opts, opts.name, gp_opts); + endif + case {"epslatex", "pslatex", "pstex", "epslatexstandalone"} + dot = find (opts.name == ".", 1, "last"); + n = find (opts.devopt == "l", 1); + suffix = opts.devopt(1:n-1); + if (! isempty (dot)) + if (any (strcmpi (opts.name(dot:end), {strcat(".", suffix), ".tex", "."}))) + name = opts.name(1:dot-1); + else + error ("print:invalid-suffix", + "invalid suffix `%s' for device `%s'.", + opts.name(dot:end), lower (opts.devopt)); + endif + endif + if (strfind (opts.devopt, "standalone")) + term = sprintf ("%s ", + strrep (opts.devopt, "standalone", " standalone")); + else + term = sprintf ("%s ", opts.devopt); + endif + if (__gnuplot_has_feature__ ("epslatex_implies_eps_filesuffix")) + suffix = "tex"; + else + %% Gnuplot 4.0 wants a ".eps" suffix. + suffix = "eps"; + endif + local_drawnow (sprintf ("%s %s", term, gp_opts), + strcat (name, ".", suffix), opts); + case "tikz" + if (__gnuplot_has_terminal__ ("tikz")) + local_drawnow (sprintf ("lua tikz %s", gp_opts), opts.name, opts); + else + error (sprintf ("print:no%soutput", opts.devopt), + "print.m: '%s' output is not available for gnuplot-%s", + upper (opts.devopt), __gnuplot_version__ ()); + endif + case "svg" + local_drawnow (sprintf ("svg dynamic %s", gp_opts), opts.name, opts); + case {"aifm", "corel", "eepic", "emf", "fig"} + local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); + case {"pdfcairo", "pngcairo"} + if (__gnuplot_has_terminal__ (opts.devopt)) + local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); + else + error (sprintf ("print:no%soutput", opts.devopt), + "print.m: '%s' output is not available for gnuplot-%s", + upper (opts.devopt), __gnuplot_version__ ()); + endif + case {"canvas", "dxf", "hpgl", "mf", "gif", "pstricks", "texdraw"} + local_drawnow (sprintf ("%s %s", opts.devopt, gp_opts), opts.name, opts); + case opts.ghostscript.device + gp_opts = font_spec (opts, "devopt", "eps"); + opts.ghostscript.output = opts.name; + opts.ghostscript.source = strcat (tmpnam (), ".eps"); + eps_drawnow (opts, opts.ghostscript.source, gp_opts); + [cmd_gs, cmd_cleanup] = __ghostscript__ (opts.ghostscript); + if (opts.send_to_printer || isempty (opts.name)) + cmd_lpr = opts.lpr_cmd (opts); + cmd = sprintf ("%s | %s", cmd_gs, cmd_lpr); + else + cmd = sprintf ("%s", cmd_gs); + endif + if (dos_shell) + cmd = sprintf ("%s & del %s", cmd, strrep (opts.ghostscript.source, '/', '\')); + else + cmd = sprintf ("%s ; rm %s", cmd, opts.ghostscript.source); + endif + if (! isempty (cmd_cleanup)) + if (dos_shell) + pipeline = {sprintf("%s & %s", cmd, cmd_cleanup)}; + else + pipeline = {sprintf("%s ; %s", cmd, cmd_cleanup)}; + endif + else + pipeline = {cmd}; + endif + otherwise + error (sprintf ("print:no%soutput", opts.devopt), + "print.m: %s output is not available for the Gnuplot graphics toolkit", + upper (opts.devopt)); + endswitch + + + opts.pipeline = pipeline; + + for n = 1:numel(pipeline) + if (opts.debug) + fprintf ("gnuplot-pipeline: '%s'\n", pipeline{n}); + endif + [status, output] = system (pipeline{n}); + if (status) + fprintf ("%s\n%s\n%s\n", + "---------- output begin ----------", + output, + "----------- output end -----------"); + error ("gnuplot:failedpipe", "print: failed to print"); + endif + endfor + +endfunction + +function eps_drawnow (opts, epsfile, gp_opts) + [h, fontsize] = get_figure_text_objs (opts); + unwind_protect + for n = 1:numel(h) + set (h(n), "fontsize", 2 * fontsize{n}); + endfor + local_drawnow (sprintf ("postscript eps %s", gp_opts), epsfile, opts); + unwind_protect_cleanup + for n = 1:numel(h) + set (h(n), "fontsize", fontsize{n}); + endfor + end_unwind_protect +endfunction + +function local_drawnow (term, file, opts) + if (opts.use_color < 0) + mono = true; + else + mono = false; + endif + figure (opts.figure); + if (isempty (opts.debug_file) || ! opts.debug) + drawnow (term, file, mono); + else + drawnow (term, file, mono, opts.debug_file); + endif +endfunction + +function f = font_spec (opts, varargin) + for n = 1:2:numel(varargin) + opts.(varargin{n}) = varargin{n+1}; + endfor + f = ""; + switch (opts.devopt) + case "cgm" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case {"eps", "eps2", "epsc", "epsc2"} + ## Gnuplot renders fonts as half their specification, which + ## results in a tight spacing for the axes-labels and tick-labels. + ## Compensate for the half scale. This will produce the proper + ## spacing for the requested fontsize. + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s,%d""", opts.font, 2 * opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", 2 * opts.fontsize); + endif + case "svg" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + fontsize = round (opts.fontsize * 0.75); + f = sprintf ("fname ""%s"" fsize %d", opts.font, fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("fname ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + fontsize = round (opts.fontsize * 0.75); + f = sprintf ("%s fsize %d", f, fontsize); + endif + case "pdf" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("fsize %d", f, opts.fontsize); + endif + case {"pdfcairo", "pngcairo"} + if (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + endif + case {"epslatex", "epslatexstandalone"} + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s,%d""", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case "pslatex" + if (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case {"gif", "jpeg", "png"} + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font ""%s ,%d""", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font ""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("font ""%d""", opts.fontsize); + endif + case "emf" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("""%s"" %d", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("""%s""", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case "canvas" + if (! isempty (opts.fontsize)) + f = sprintf ("fsize %d", opts.fontsize); + endif + case {"aifm", "corel"} + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("%s %d", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("%s", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("%d", opts.fontsize); + endif + case "fig" + if (! isempty (opts.font) && ! isempty (opts.fontsize)) + f = sprintf ("font %s fontsize %d", opts.font, opts.fontsize); + elseif (! isempty (opts.font)) + f = sprintf ("font %s", opts.font); + elseif (! isempty (opts.fontsize)) + f = sprintf ("fontsize %d", opts.fontsize); + endif + endswitch +endfunction + +function [h, fontsize] = get_figure_text_objs (opts) + h = findall (opts.figure, "-property", "fontsize"); + fontsize = get (h, "fontsize"); + switch (numel (fontsize)) + case 0 + fontsize = {}; + case 1 + fontsize = {fontsize}; + endswitch +endfunction diff --git a/octave_packages/m/plot/private/__gnuplot_version__.m b/octave_packages/m/plot/private/__gnuplot_version__.m new file mode 100644 index 0000000..9a9b9e6 --- /dev/null +++ b/octave_packages/m/plot/private/__gnuplot_version__.m @@ -0,0 +1,51 @@ +## Copyright (C) 2006-2012 Daniel Sebald +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{version} =} __gnuplot_version__ () +## Undocumented internal function. +## @end deftypefn + +## Return the version of gnuplot we are using. Note that we do not +## attempt to handle the case of the user switching to different +## versions of gnuplot during the same session. + +function version = __gnuplot_version__ () + + persistent __version__ = ""; + + if (isempty (__version__)) + [status, output] = system (sprintf ("\"%s\" --version", gnuplot_binary ())); + if (status != 0) + ## This message ends in a newline so that the traceback messages + ## are skipped and people might actually see the message, read it, + ## comprehend it, actually take the advice it gives, and stop + ## asking us why plotting fails when gnuplot is not found. + error ("you must have gnuplot installed to display graphics; if you have gnuplot installed in a non-standard location, see the 'gnuplot_binary' function\n"); + endif + output = strrep (output, "gnuplot", ""); + output = strrep (output, "patchlevel", "."); + output = strrep (output, "\n", ""); + output = strrep (output, "\r", ""); + __version__ = strrep (output, " ", ""); + endif + + version = __version__; + +endfunction + diff --git a/octave_packages/m/plot/private/__go_draw_axes__.m b/octave_packages/m/plot/private/__go_draw_axes__.m new file mode 100644 index 0000000..f2ac95b --- /dev/null +++ b/octave_packages/m/plot/private/__go_draw_axes__.m @@ -0,0 +1,2650 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __go_draw_axes__ (@var{h}, @var{plot_stream}, @var{enhanced}, @var{mono}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function __go_draw_axes__ (h, plot_stream, enhanced, mono, + bg_is_set, fg_is_set, hlgnd) + + if (nargin >= 4 && nargin <= 7) + + showhiddenhandles = get (0, "showhiddenhandles"); + unwind_protect + set (0, "showhiddenhandles", "on"); + axis_obj = __get__ (h); + unwind_protect_cleanup + set (0, "showhiddenhandles", showhiddenhandles); + end_unwind_protect + + parent_figure_obj = get (axis_obj.parent); + gnuplot_term = __gnuplot_get_var__ (axis_obj.parent, "GPVAL_TERM"); + + ## Set to false for plotyy axes. + ymirror = true; + if (isfield (axis_obj, "__plotyy_axes__")) + if (all (ishandle (axis_obj.__plotyy_axes__))) + ymirror = false; + else + h = axis_obj.__plotyy_axes__; + h = h(ishandle (h)); + h = h(isprop (h, "__ploty_axes__")); + rmappdata (h, "__plotyy_axes__") + endif + endif + + nd = __calc_dimensions__ (h); + + if (strcmp (axis_obj.dataaspectratiomode, "manual") + && strcmp (axis_obj.xlimmode, "manual") + && strcmp (axis_obj.ylimmode, "manual")) + ## All can't be "manual" + axis_obj.plotboxaspectratiomode = "auto"; + endif + + if (strcmp (axis_obj.dataaspectratiomode, "manual") + && strcmp (axis_obj.xlimmode, "manual") + && strcmp (axis_obj.ylimmode, "manual") + && (nd == 2 || all (mod (axis_obj.view, 90) == 0))) + ## FIXME - adjust plotboxaspectratio to respect other + fpos = get (axis_obj.parent, "position"); + apos = axis_obj.position; + endif + + pos = __actual_axis_position__ (h); + + if (strcmpi (axis_obj.dataaspectratiomode, "manual")) + dr = axis_obj.dataaspectratio; + if (nd == 2 || all (mod (axis_obj.view, 90) == 0)) + dr = dr(1) / dr(2); + else + ## FIXME - need to properly implement 3D + dr = mean (dr(1:2)) / dr(3); + endif + else + dr = 1; + endif + + if (strcmp (axis_obj.activepositionproperty, "position")) + if (__gnuplot_has_feature__ ("screen_coordinates_for_{lrtb}margin")) + if (nd == 2 || all (mod (axis_obj.view, 90) == 0)) + x = [1, 1]; + else + ## 3D plots need to be sized down to fit in the window. + x = 1.0 ./ sqrt([2, 2.5]); + endif + fprintf (plot_stream, "set tmargin screen %.15g;\n", + pos(2)+pos(4)/2+x(2)*pos(4)/2); + fprintf (plot_stream, "set bmargin screen %.15g;\n", + pos(2)+pos(4)/2-x(2)*pos(4)/2); + fprintf (plot_stream, "set lmargin screen %.15g;\n", + pos(1)+pos(3)/2-x(1)*pos(3)/2); + fprintf (plot_stream, "set rmargin screen %.15g;\n", + pos(1)+pos(3)/2+x(1)*pos(3)/2); + sz_str = ""; + else + fprintf (plot_stream, "set tmargin 0;\n"); + fprintf (plot_stream, "set bmargin 0;\n"); + fprintf (plot_stream, "set lmargin 0;\n"); + fprintf (plot_stream, "set rmargin 0;\n"); + + if (nd == 3 && all (axis_obj.view == [0, 90])) + ## FIXME -- Kludge to allow colorbar to be added to a pcolor() plot + pos(3:4) = pos(3:4) * 1.4; + pos(1:2) = pos(1:2) - pos(3:4) * 0.125; + endif + + fprintf (plot_stream, "set origin %.15g, %.15g;\n", pos(1), pos(2)); + + if (strcmpi (axis_obj.dataaspectratiomode, "manual")) + sz_str = sprintf ("set size ratio %.15g", -dr); + else + sz_str = "set size noratio"; + endif + sz_str = sprintf ("%s %.15g, %.15g;\n", sz_str, pos(3), pos(4)); + endif + else ## activepositionproperty == outerposition + fprintf (plot_stream, "unset tmargin;\n"); + fprintf (plot_stream, "unset bmargin;\n"); + fprintf (plot_stream, "unset lmargin;\n"); + fprintf (plot_stream, "unset rmargin;\n"); + fprintf (plot_stream, "set origin %g, %g;\n", pos(1:2)); + sz_str = ""; + if (strcmpi (axis_obj.dataaspectratiomode, "manual")) + sz_str = sprintf ("ratio %g", -dr); + else + sz_str = "noratio"; + endif + sz_str = sprintf ("set size %s %g, %g;\n", sz_str, pos(3:4)); + endif + if (! isempty (sz_str)) + fputs (plot_stream, sz_str); + endif + + ## Reset all labels, axis-labels, tick-labels, and title + ## FIXME - We should have an function to initialize the axis. + ## Presently, this is dispersed in this function. + fputs (plot_stream, "unset label;\n"); + fputs (plot_stream, "unset xtics;\n"); + fputs (plot_stream, "unset ytics;\n"); + fputs (plot_stream, "unset ztics;\n"); + fputs (plot_stream, "unset x2tics;\n"); + fputs (plot_stream, "unset x2tics;\n"); + + if (! isempty (axis_obj.title)) + t = get (axis_obj.title); + if (isempty (t.string)) + fputs (plot_stream, "unset title;\n"); + else + [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + fprintf (plot_stream, "set title \"%s\" %s %s;\n", + undo_string_escapes (tt), fontspec, + __do_enhanced_option__ (enhanced, t)); + endif + endif + + if (! isempty (axis_obj.xlabel)) + t = get (axis_obj.xlabel); + angle = t.rotation; + colorspec = get_text_colorspec (axis_obj.xcolor, mono); + if (isempty (t.string)) + fprintf (plot_stream, "unset xlabel;\n"); + fprintf (plot_stream, "unset x2label;\n"); + else + [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "set x2label \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + else + fprintf (plot_stream, "set xlabel \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + endif + fprintf (plot_stream, " rotate by %f;\n", angle); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "unset xlabel;\n"); + else + fprintf (plot_stream, "unset x2label;\n"); + endif + endif + endif + + if (! isempty (axis_obj.ylabel)) + t = get (axis_obj.ylabel); + angle = t.rotation; + colorspec = get_text_colorspec (axis_obj.ycolor, mono); + if (isempty (t.string)) + fprintf (plot_stream, "unset ylabel;\n"); + fprintf (plot_stream, "unset y2label;\n"); + else + [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + if (strcmpi (axis_obj.yaxislocation, "right")) + fprintf (plot_stream, "set y2label \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + else + fprintf (plot_stream, "set ylabel \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + endif + fprintf (plot_stream, " rotate by %f;\n", angle); + if (strcmpi (axis_obj.yaxislocation, "right")) + fprintf (plot_stream, "unset ylabel;\n"); + else + fprintf (plot_stream, "unset y2label;\n"); + endif + endif + endif + + if (! isempty (axis_obj.zlabel)) + t = get (axis_obj.zlabel); + angle = t.rotation; + colorspec = get_text_colorspec (axis_obj.zcolor, mono); + if (isempty (t.string)) + fputs (plot_stream, "unset zlabel;\n"); + else + [tt, f, s] = __maybe_munge_text__ (enhanced, t, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + fprintf (plot_stream, "set zlabel \"%s\" %s %s %s", + undo_string_escapes (tt), colorspec, fontspec, + __do_enhanced_option__ (enhanced, t)); + fprintf (plot_stream, " rotate by %f;\n", angle); + endif + endif + + if (strcmpi (axis_obj.xaxislocation, "top")) + xaxisloc = "x2"; + xaxisloc_using = "x2"; + else + xaxisloc = "x"; + xaxisloc_using = "x1"; + if (strcmpi (axis_obj.xaxislocation, "zero")) + fputs (plot_stream, "set xzeroaxis;\n"); + endif + endif + if (strcmpi (axis_obj.yaxislocation, "right")) + yaxisloc = "y2"; + yaxisloc_using = "y2"; + else + yaxisloc = "y"; + yaxisloc_using = "y1"; + if (strcmpi (axis_obj.yaxislocation, "zero")) + fputs (plot_stream, "set yzeroaxis;\n"); + endif + endif + + have_grid = false; + + if (strcmpi (axis_obj.xgrid, "on")) + have_grid = true; + fprintf (plot_stream, "set grid %stics;\n", xaxisloc); + else + fprintf (plot_stream, "set grid no%stics;\n", xaxisloc); + endif + + if (strcmpi (axis_obj.ygrid, "on")) + have_grid = true; + fprintf (plot_stream, "set grid %stics;\n", yaxisloc); + else + fprintf (plot_stream, "set grid no%stics;\n", yaxisloc); + endif + + if (strcmpi (axis_obj.zgrid, "on")) + have_grid = true; + fputs (plot_stream, "set grid ztics;\n"); + else + fputs (plot_stream, "set grid noztics;\n"); + endif + + if (strcmpi (axis_obj.xminorgrid, "on")) + have_grid = true; + if (strcmp (axis_obj.xscale, "log")) + m = 10; + else + m = 5; + endif + fprintf (plot_stream, "set m%stics %d;\n", xaxisloc, m); + fprintf (plot_stream, "set grid m%stics;\n", xaxisloc); + else + fprintf (plot_stream, "set grid nom%stics;\n", xaxisloc); + endif + + if (strcmpi (axis_obj.yminorgrid, "on")) + have_grid = true; + if (strcmp (axis_obj.yscale, "log")) + m = 10; + else + m = 5; + endif + fprintf (plot_stream, "set m%stics %d;\n", yaxisloc, m); + fprintf (plot_stream, "set grid m%stics;\n", yaxisloc); + else + fprintf (plot_stream, "set grid nom%stics;\n", yaxisloc); + endif + + if (strcmpi (axis_obj.zminorgrid, "on")) + have_grid = true; + if (strcmp (axis_obj.zscale, "log")) + m = 10; + else + m = 5; + endif + fprintf (plot_stream, "set mztics %d;\n", m); + fputs (plot_stream, "set grid mztics;\n"); + else + fputs (plot_stream, "set grid nomztics;\n"); + endif + + ## The grid front/back/layerdefault option also controls the + ## appearance of tics, so it is used even if the grid is absent. + if (strcmpi (axis_obj.layer, "top")) + fputs (plot_stream, "set grid front;\n"); + fputs (plot_stream, "set border front;\n"); + else + fputs (plot_stream, "set grid layerdefault;\n"); + ## FIXME -- the gnuplot help says that "layerdefault" should work + ## for set border too, but it fails for me with gnuplot 4.2.5. So + ## use "back" instead. + fputs (plot_stream, "set border back;\n"); + endif + + fprintf (plot_stream, "set grid linewidth %f, linewidth %f;\n", + axis_obj.linewidth, axis_obj.linewidth); + + if (! have_grid) + fputs (plot_stream, "unset grid;\n"); + endif + + xlogscale = strcmpi (axis_obj.xscale, "log"); + ylogscale = strcmpi (axis_obj.yscale, "log"); + zlogscale = strcmpi (axis_obj.zscale, "log"); + + ## Detect logscale and negative lims + if (xlogscale && all (axis_obj.xlim < 0)) + axis_obj.xsgn = -1; + if (strcmp (axis_obj.xdir, "reverse")) + axis_obj.xdir = "normal"; + elseif (strcmp (axis_obj.xdir, "normal")) + axis_obj.xdir = "reverse"; + endif + axis_obj.xtick = -flip (axis_obj.xtick); + axis_obj.xticklabel = flip (axis_obj.xticklabel); + axis_obj.xlim = -flip (axis_obj.xlim); + else + axis_obj.xsgn = 1; + endif + if (ylogscale && all (axis_obj.ylim < 0)) + axis_obj.ysgn = -1; + if (strcmp (axis_obj.ydir, "reverse")) + axis_obj.ydir = "normal"; + elseif (strcmp (axis_obj.ydir, "normal")) + axis_obj.ydir = "reverse"; + endif + axis_obj.ytick = -flip (axis_obj.ytick); + axis_obj.yticklabel = flip (axis_obj.yticklabel); + axis_obj.ylim = -flip (axis_obj.ylim); + else + axis_obj.ysgn = 1; + endif + if (zlogscale && all (axis_obj.zlim < 0)) + axis_obj.zsgn = -1; + if (strcmp (axis_obj.zdir, "reverse")) + axis_obj.zdir = "normal"; + elseif (strcmp (axis_obj.zdir, "normal")) + axis_obj.zdir = "reverse"; + endif + axis_obj.ztick = -flip (axis_obj.ztick); + axis_obj.zticklabel = flip (axis_obj.zticklabel); + axis_obj.zlim = -flip (axis_obj.zlim); + else + axis_obj.zsgn = 1; + endif + + xlim = axis_obj.xlim; + ylim = axis_obj.ylim; + zlim = axis_obj.zlim; + clim = axis_obj.clim; + + do_tics (axis_obj, plot_stream, ymirror, mono, gnuplot_term); + + fputs (plot_stream, "unset logscale;\n"); + if (xlogscale) + fprintf (plot_stream, "set logscale %s;\n", xaxisloc); + endif + if (ylogscale) + fprintf (plot_stream, "set logscale %s;\n", yaxisloc); + endif + if (zlogscale) + fputs (plot_stream, "set logscale z;\n"); + endif + + xautoscale = strcmpi (axis_obj.xlimmode, "auto"); + yautoscale = strcmpi (axis_obj.ylimmode, "auto"); + zautoscale = strcmpi (axis_obj.zlimmode, "auto"); + cautoscale = strcmpi (axis_obj.climmode, "auto"); + cdatadirect = false; + truecolor = false; + + fputs (plot_stream, "set clip two;\n"); + + kids = axis_obj.children; + ## Remove the axis labels and title from the children, and + ## preserved the original order. + [jnk, k] = setdiff (kids, [axis_obj.xlabel; axis_obj.ylabel; ... + axis_obj.zlabel; axis_obj.title]); + kids = kids (sort (k)); + + if (nd == 3) + fputs (plot_stream, "set parametric;\n"); + fputs (plot_stream, "set style data lines;\n"); + fputs (plot_stream, "set surface;\n"); + fputs (plot_stream, "unset contour;\n"); + endif + + data_idx = 0; + data = cell (); + is_image_data = []; + hidden_removal = NaN; + view_map = false; + + if (! cautoscale && clim(1) == clim(2)) + clim(2)++; + endif + addedcmap = []; + + ximg_data = {}; + ximg_data_idx = 0; + + while (! isempty (kids)) + + obj = get (kids(end)); + + if (isfield (obj, "units")) + units = obj.units; + unwind_protect + set (kids(end), "units", "data"); + obj = get (kids(end)); + unwind_protect_cleanup + set (kids(end), "units", units); + end_unwind_protect + endif + kids = kids(1:(end-1)); + + if (strcmpi (obj.visible, "off")) + continue; + endif + + if (xlogscale && isfield (obj, "xdata")) + obj.xdata = axis_obj.xsgn * obj.xdata; + obj.xdata(obj.xdata<=0) = NaN; + endif + if (ylogscale && isfield (obj, "ydata")) + obj.ydata = axis_obj.ysgn * obj.ydata; + obj.ydata(obj.ydata<=0) = NaN; + endif + if (zlogscale && isfield (obj, "zdata")) + obj.zdata = axis_obj.zsgn * obj.zdata; + obj.zdata(obj.zdata<=0) = NaN; + endif + + ## Check for facecolor interpolation for surfaces. + doing_interp_color = ... + isfield (obj, "facecolor") && strncmp (obj.facecolor, "interp", 6); + + switch (obj.type) + case "image" + img_data = obj.cdata; + img_xdata = obj.xdata; + img_ydata = obj.ydata; + + if (ndims (img_data) == 3) + truecolor = true; + elseif (strcmpi (obj.cdatamapping, "direct")) + cdatadirect = true; + endif + data_idx++; + is_image_data(data_idx) = true; + parametric(data_idx) = false; + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = false; + + if (img_xdata(2) < img_xdata(1)) + img_xdata = img_xdata(2:-1:1); + img_data = img_data(:,end:-1:1,:); + elseif (img_xdata(1) == img_xdata(2)) + img_xdata = img_xdata(1) + [0, size(img_data,2)-1]; + endif + if (img_ydata(2) < img_ydata(1)) + img_ydata = img_ydata(2:-1:1); + img_data = img_data(end:-1:1,:,:); + elseif (img_ydata(1) == img_ydata(2)) + img_ydata = img_ydata(1) + [0, size(img_data,1)-1]; + endif + + [y_dim, x_dim] = size (img_data(:,:,1)); + if (x_dim > 1) + dx = abs (img_xdata(2)-img_xdata(1))/(x_dim-1); + else + x_dim = 2; + img_data = [img_data, img_data]; + dx = abs (img_xdata(2)-img_xdata(1)); + endif + if (y_dim > 1) + dy = abs (img_ydata(2)-img_ydata(1))/(y_dim-1); + else + y_dim = 2; + img_data = [img_data; img_data]; + dy = abs (img_ydata(2)-img_ydata(1)); + endif + + x_origin = min (img_xdata); + y_origin = min (img_ydata); + + if (ndims (img_data) == 3) + data{data_idx} = permute (img_data, [3, 1, 2])(:); + format = "1:2:3"; + imagetype = "rgbimage"; + else + data{data_idx} = img_data(:); + format = "1"; + imagetype = "image"; + endif + + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("binary array=%dx%d scan=yx origin=(%.15g,%.15g) dx=%.15g dy=%.15g using %s", + x_dim, y_dim, x_origin, y_origin, dx, dy, format); + withclause{data_idx} = sprintf ("with %s;", imagetype); + + case "line" + if (strncmp (obj.linestyle, "none", 4) + && (! isfield (obj, "marker") + || (isfield (obj, "marker") + && strncmp (obj.marker, "none", 4)))) + continue; + endif + data_idx++; + is_image_data(data_idx) = false; + parametric(data_idx) = true; + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = false; + if (isempty (obj.displayname)) + titlespec{data_idx} = "title \"\""; + else + tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); + titlespec{data_idx} = cstrcat ("title \"", tmp, "\""); + endif + usingclause{data_idx} = sprintf ("record=%d", numel (obj.xdata)); + errbars = ""; + if (nd == 3) + xdat = obj.xdata(:); + ydat = obj.ydata(:); + if (! isempty (obj.zdata)) + zdat = obj.zdata(:); + else + zdat = zeros (size (xdat)); + endif + data{data_idx} = [xdat, ydat, zdat]'; + usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", numel (xdat)); + ## fputs (plot_stream, "set parametric;\n"); + else + xdat = obj.xdata(:); + ydat = obj.ydata(:); + data{data_idx} = [xdat, ydat]'; + usingclause{data_idx} = sprintf ("record=%d using ($1):($2) axes %s%s", + rows(xdat), xaxisloc_using, yaxisloc_using); + endif + + style = do_linestyle_command (obj, obj.color, data_idx, mono, + plot_stream, errbars); + + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{1}, data_idx); + + if (length (style) > 1) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = have_cdata(data_idx - 1); + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = usingclause{data_idx - 1}; + data{data_idx} = data{data_idx - 1}; + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{2}, data_idx); + endif + if (length (style) > 2) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = have_cdata(data_idx - 1); + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = usingclause{data_idx - 1}; + data{data_idx} = data{data_idx - 1}; + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{3}, data_idx); + endif + + case "patch" + cmap = parent_figure_obj.colormap; + [nr, nc] = size (obj.xdata); + + if (! isempty (obj.cdata)) + cdat = obj.cdata; + if (strcmpi (obj.cdatamapping, "direct")) + cdatadirect = true; + endif + else + cdat = []; + endif + + data_3d_idx = NaN; + for i = 1:nc + xcol = obj.xdata(:,i); + ycol = obj.ydata(:,i); + if (nd == 3) + if (! isempty (obj.zdata)) + zcol = obj.zdata(:,i); + else + zcol = zeros (size (xcol)); + endif + endif + + if (! isnan (xcol) && ! isnan (ycol)) + ## Is the patch closed or not + if (strncmp (obj.facecolor, "none", 4)) + hidden_removal = false; + else + + if (isnan (hidden_removal)) + hidden_removal = true; + endif + if (nd == 3) + if (numel (xcol) > 3) + error ("__go_draw_axes__: gnuplot (as of v4.2) only supports 3D filled triangular patches"); + else + if (isnan (data_3d_idx)) + data_idx++; + data_3d_idx = data_idx; + is_image_data(data_idx) = false; + parametric(data_idx) = false; + have_cdata(data_idx) = true; + have_3d_patch(data_idx) = true; + withclause{data_3d_idx} = sprintf ("with pm3d"); + usingclause{data_3d_idx} = "using 1:2:3:4"; + data{data_3d_idx} = []; + endif + local_idx = data_3d_idx; + ccdat = NaN; + endif + else + data_idx++; + local_idx = data_idx; + is_image_data(data_idx) = false; + parametric(data_idx) = false; + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = false; + endif + + if (i > 1 || isempty (obj.displayname)) + titlespec{local_idx} = "title \"\""; + else + tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); + titlespec{local_idx} = cstrcat ("title \"", tmp, "\""); + endif + if (isfield (obj, "facecolor")) + if ((strncmp (obj.facecolor, "flat", 4) + || strncmp (obj.facecolor, "interp", 6)) + && isfield (obj, "cdata")) + if (ndims (obj.cdata) == 2 + && (size (obj.cdata, 2) == nc + && (size (obj.cdata, 1) == 1 + || size (obj.cdata, 1) == 3))) + ccol = cdat (:, i); + elseif (ndims (obj.cdata) == 2 + && (size (obj.cdata, 1) == nc + && (size (obj.cdata, 2) == 1 + || size (obj.cdata, 2) == 3))) + ccol = cdat (i, :); + elseif (ndims (obj.cdata) == 3) + ccol = permute (cdat (:, i, :), [1, 3, 2]); + else + ccol = cdat; + endif + if (strncmp (obj.facecolor, "flat", 4)) + if (isequal (size (ccol), [1, 3])) + ## RGB Triplet + color = ccol; + elseif (nd == 3 && numel (xcol) == 3) + ccdat = ccol; + else + if (cdatadirect) + r = round (ccol); + else + r = 1 + round ((size (cmap, 1) - 1) + * (ccol - clim(1))/(clim(2) - clim(1))); + endif + r = max (1, min (r, size (cmap, 1))); + color = cmap(r, :); + endif + elseif (strncmp (obj.facecolor, "interp", 6)) + if (nd == 3 && numel (xcol) == 3) + ccdat = ccol; + if (! isvector (ccdat)) + tmp = rows(cmap) + rows(addedcmap) + ... + [1 : rows(ccdat)]; + addedcmap = [addedcmap; ccdat]; + ccdat = tmp(:); + else + ccdat = ccdat(:); + endif + else + if (sum (diff (ccol))) + warning ("\"interp\" not supported, using 1st entry of cdata"); + endif + if (cdatadirect) + r = round (ccol); + else + r = 1 + round ((size (cmap, 1) - 1) + * (ccol - clim(1))/(clim(2) - clim(1))); + endif + r = max (1, min (r, size (cmap, 1))); + color = cmap(r(1),:); + endif + endif + elseif (isnumeric (obj.facecolor)) + color = obj.facecolor; + else + color = [0, 1, 0]; + endif + else + color = [0, 1, 0]; + endif + + if (nd == 3 && numel (xcol) == 3) + if (isnan (ccdat)) + ccdat = (rows (cmap) + rows(addedcmap) + 1) * ones(3, 1); + addedcmap = [addedcmap; reshape(color, 1, 3)]; + endif + data{data_3d_idx} = [data{data_3d_idx}, ... + [[xcol; xcol(end)], [ycol; ycol(end)], ... + [zcol; zcol(end)], [ccdat; ccdat(end)]]']; + else + if (mono) + colorspec = ""; + elseif (__gnuplot_has_feature__ ("transparent_patches") + && isscalar (obj.facealpha)) + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\" fillstyle transparent solid %f", + round (255*color), obj.facealpha); + else + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*color)); + endif + + withclause{data_idx} = sprintf ("with filledcurve %s", + colorspec); + data{data_idx} = [xcol, ycol]'; + usingclause{data_idx} = sprintf ("record=%d using ($1):($2)", + numel (xcol)); + endif + endif + endif + + ## patch outline + if (!(strncmp (obj.edgecolor, "none", 4) + && (strncmp (obj.marker, "none", 4) + || (strncmp (obj.markeredgecolor, "none", 4) + && strncmp (obj.markerfacecolor, "none", 4))))) + + data_idx++; + is_image_data(data_idx) = false; + parametric(data_idx) = false; + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = false; + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("record=%d", numel (obj.xdata)); + + if (isfield (obj, "markersize")) + mdat = obj.markersize / 3; + endif + + if (isfield (obj, "edgecolor")) + ## FIXME + ## This is the wrong thing to do as edgecolor, markeredgecolor + ## and markerfacecolor can have different values and we should + ## treat them seperately. However, the below allow the scatter + ## functions to work as expected, where only one of these values + ## is set + if (strncmp (obj.edgecolor, "none", 4)) + if (strncmp (obj.markeredgecolor, "none", 4)) + ec = obj.markerfacecolor; + else + ec = obj.markeredgecolor; + endif + else + ec = obj.edgecolor; + endif + + if ((strncmp (ec, "flat", 4) + || strncmp (ec, "interp", 6)) + && isfield (obj, "cdata")) + if (ndims (obj.cdata) == 2 + && (size (obj.cdata, 2) == nc + && (size (obj.cdata, 1) == 1 + || size (obj.cdata, 1) == 3))) + ccol = cdat (:, i); + elseif (ndims (obj.cdata) == 2 + && (size (obj.cdata, 1) == nc + && (size (obj.cdata, 2) == 1 + || size (obj.cdata, 2) == 3))) + ccol = cdat (i, :); + elseif (ndims (obj.cdata) == 3) + ccol = permute (cdat (:, i, :), [1, 3, 2]); + else + ccol = cdat; + endif + if (strncmp (ec, "flat", 4)) + if (numel(ccol) == 3) + color = ccol; + else + if (isscalar (ccol)) + ccol = repmat(ccol, numel (xcol), 1); + endif + color = "flat"; + have_cdata(data_idx) = true; + endif + elseif (strncmp (ec, "interp", 6)) + if (numel(ccol) == 3) + warning ("\"interp\" not supported, using 1st entry of cdata"); + color = ccol(1,:); + else + if (isscalar (ccol)) + ccol = repmat(ccol, numel (xcol), 1); + endif + color = "interp"; + have_cdata(data_idx) = true; + endif + endif + elseif (isnumeric (ec)) + color = ec; + else + color = [0, 0, 0]; + endif + else + color = [0, 0, 0]; + endif + + if (isfield (obj, "linestyle")) + switch (obj.linestyle) + case "-" + lt = "lt 1"; + case "--" + lt = "lt 2"; + case ":" + lt = "lt 3"; + case "-." + lt = "lt 6"; + case "none" + lt = ""; + otherwise + lt = ""; + endswitch + else + lt = ""; + endif + + if (isfield (obj, "linewidth")) + lw = sprintf("linewidth %f", obj.linewidth); + else + lw = ""; + endif + + [pt, pt2, obj] = gnuplot_pointtype (obj); + if (! isempty (pt)) + pt = sprintf ("pointtype %s", pt); + endif + if (! isempty (pt2)) + pt2 = sprintf ("pointtype %s", pt2); + endif + + if (mono) + colorspec = ""; + else + if (ischar (color)) + colorspec = "palette"; + else + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*color)); + endif + endif + + sidx = 1; + if (isempty (lt)) + style = ""; + else + style = "lines"; + endif + tmpwith = {}; + + facesame = true; + if (! isequal (pt, pt2) && isfield (obj, "markerfacecolor") + && !strncmp (obj.markerfacecolor, "none", 4)) + if (strncmp (obj.markerfacecolor, "auto", 4) + || ! isnumeric (obj.markerfacecolor) + || (isnumeric (obj.markerfacecolor) + && isequal (color, obj.markerfacecolor))) + style = strcat (style, "points"); + if (isfield (obj, "markersize")) + if (length (mdat) == nc) + m = mdat(i); + else + m = mdat; + endif + ps = sprintf("pointsize %f", m / 3); + else + ps = ""; + endif + + tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", + style, lw, pt2, lt, ps, + colorspec); + else + facesame = false; + if (! isempty (style)) + tmpwith{sidx} = sprintf ("with %s %s %s %s", + style, lw, lt, + colorspec); + sidx ++; + endif + if (isnumeric (obj.markerfacecolor) && ! mono) + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*obj.markerfacecolor)); + endif + style = "points"; + if (isfield (obj, "markersize")) + if (length (mdat) == nc) + m = mdat(i); + else + m = mdat; + endif + ps = sprintf("pointsize %f", m / 3); + else + ps = ""; + endif + tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", + style, lw, pt2, lt, ps, + colorspec); + endif + endif + + if (isfield (obj, "markeredgecolor") + && !strncmp (obj.markeredgecolor, "none", 4)) + if (facesame && !isempty (pt) + && (strncmp (obj.markeredgecolor, "auto", 4) + || ! isnumeric (obj.markeredgecolor) + || (isnumeric (obj.markeredgecolor) + && isequal (color, obj.markeredgecolor)))) + if (sidx == 1 && ((length (style) == 5 + && strncmp (style, "lines", 5)) + || isempty (style))) + style = strcat (style, "points"); + if (isfield (obj, "markersize")) + if (length (mdat) == nc) + m = mdat(i); + else + m = mdat; + endif + ps = sprintf("pointsize %f", m / 3); + else + ps = ""; + endif + tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", + style, lw, pt, lt, ps, + colorspec); + endif + else + if (!isempty (style)) + if (length(tmpwith) < sidx || isempty (tmpwith{sidx})) + tmpwith{sidx} = sprintf ("with %s %s %s %s", + style, lw, lt, + colorspec); + endif + sidx ++; + endif + + if (!isempty (pt)) + if (! mono) + if (strncmp (obj.markeredgecolor, "auto", 4)) + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*color)); + elseif (isnumeric (obj.markeredgecolor) && ! mono) + colorspec = sprintf ("lc rgb \"#%02x%02x%02x\"", + round (255*obj.markeredgecolor)); + endif + endif + style = "points"; + if (isfield (obj, "markersize")) + if (length (mdat) == nc) + m = mdat(i); + else + m = mdat; + endif + ps = sprintf("pointsize %f", m / 3); + else + ps = ""; + endif + tmpwith{sidx} = sprintf ("with %s %s %s %s %s %s", + style, lw, pt, lt, ps, + colorspec); + endif + endif + endif + + if (isempty (tmpwith)) + withclause{data_idx} = sprintf ("with %s %s %s %s %s", + style, lw, pt, lt, + colorspec); + else + withclause{data_idx} = tmpwith{1}; + endif + if (nd == 3) + if (ischar (color)) + if (! isnan (xcol) && ! isnan (ycol) && ! isnan (zcol)) + data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... + [zcol; zcol(1)], [ccol; ccol(1)]]'; + else + data{data_idx} = [xcol, ycol, zcol, ccol]'; + endif + usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3):($4)", columns (data{data_idx})); + else + if (! isnan (xcol) && ! isnan (ycol) && ! isnan (zcol)) + data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... + [zcol; zcol(1)]]'; + else + data{data_idx} = [xcol, ycol, zcol]'; + endif + usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", columns (data{data_idx})); + endif + else + if (ischar (color)) + if (! isnan (xcol) && ! isnan (ycol)) + data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)], ... + [ccol; ccol(1)]]'; + else + data{data_idx} = [xcol, ycol, ccol]'; + endif + usingclause{data_idx} = sprintf ("record=%d using ($1):($2):($3)", columns (data{data_idx})); + else + if (! isnan (xcol) && ! isnan (ycol)) + data{data_idx} = [[xcol; xcol(1)], [ycol; ycol(1)]]'; + else + data{data_idx} = [xcol, ycol]'; + endif + usingclause{data_idx} = sprintf ("record=%d using ($1):($2)", columns (data{data_idx})); + endif + endif + + if (length (tmpwith) > 1) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = have_cdata(data_idx - 1); + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = usingclause{data_idx - 1}; + data{data_idx} = data{data_idx - 1}; + withclause{data_idx} = tmpwith{2}; + endif + if (length (tmpwith) > 2) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = have_cdata(data_idx - 1); + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = usingclause{data_idx - 1}; + data{data_idx} = data{data_idx - 1}; + withclause{data_idx} = tmpwith{3}; + endif + endif + endfor + + case "surface" + view_map = true; + if (! (strncmp (obj.edgecolor, "none", 4) + && strncmp (obj.facecolor, "none", 4))) + data_idx++; + is_image_data(data_idx) = false; + parametric(data_idx) = false; + have_cdata(data_idx) = true; + have_3d_patch(data_idx) = false; + style = do_linestyle_command (obj, obj.edgecolor, + data_idx, mono, + plot_stream); + + if (isempty (obj.displayname)) + titlespec{data_idx} = "title \"\""; + else + tmp = undo_string_escapes (__maybe_munge_text__ (enhanced, obj, "displayname")); + titlespec{data_idx} = cstrcat ("title \"", tmp, "\""); + endif + withclause{data_idx} = sprintf ("with pm3d linestyle %d", + data_idx); + withpm3d = true; + pm3didx = data_idx; + + xdat = obj.xdata; + ydat = obj.ydata; + zdat = obj.zdata; + cdat = obj.cdata; + + err = false; + if (! size_equal(zdat, cdat)) + err = true; + endif + if (isvector (xdat) && isvector (ydat) && ismatrix (zdat)) + if (rows (zdat) == length (ydat) + && columns (zdat) == length (xdat)) + [xdat, ydat] = meshgrid (xdat, ydat); + else + err = true; + endif + elseif (ismatrix (xdat) && ismatrix (ydat) && ismatrix (zdat)) + if (! size_equal (xdat, ydat, zdat)) + err = true; + endif + else + err = true; + endif + if (err) + error ("__go_draw_axes__: invalid grid data"); + endif + xlen = columns (zdat); + ylen = rows (zdat); + if (xlen == columns (xdat) && xlen == columns (ydat) + && ylen == rows (xdat) && ylen == rows (ydat)) + len = 4 * xlen; + zz = zeros (ylen, len); + k = 1; + for kk = 1:4:len + zz(:,kk) = xdat(:,k); + zz(:,kk+1) = ydat(:,k); + zz(:,kk+2) = zdat(:,k); + zz(:,kk+3) = cdat(:,k); + k++; + endfor + data{data_idx} = zz.'; + endif + + if (doing_interp_color) + interp_str = "interpolate 0, 0"; + else + ## No interpolation of facecolors. + interp_str = ""; + endif + usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3):($4)", ylen, xlen); + + flat_interp_face = (strncmp (obj.facecolor, "flat", 4) + || strncmp (obj.facecolor, "interp", 6)); + flat_interp_edge = (strncmp (obj.edgecolor, "flat", 4) + || strncmp (obj.edgecolor, "interp", 6)); + + facecolor_none_or_white = (strncmp (obj.facecolor, "none", 4) + || (isnumeric (obj.facecolor) + && all (obj.facecolor == 1))); + hidden_removal = false; + fputs (plot_stream, "set style increment default;\n"); + if (flat_interp_edge && facecolor_none_or_white) + withpm3d = false; + withclause{data_idx} = sprintf ("with %s palette", style {1}); + fputs (plot_stream, "unset pm3d\n"); + if (all (obj.facecolor == 1)) + hidden_removal = true; + endif + elseif (facecolor_none_or_white) + if (all (obj.facecolor == 1)) + hidden_removal = true; + endif + fputs(plot_stream,"unset pm3d;\n"); + fputs(plot_stream,"set style increment user;\n"); + withpm3d = false; + withclause{data_idx} = sprintf("with %s linestyle %d", + style{1}, data_idx); + fputs (plot_stream, "unset pm3d\n"); + endif + + if (doing_interp_color) + ## "depthorder" interferes with interpolation of colors. + dord = "scansautomatic"; + else + dord = "depthorder"; + endif + + if (flat_interp_face && strncmp (obj.edgecolor, "flat", 4)) + fprintf (plot_stream, "set pm3d explicit at s %s %s corners2color c3;\n", + interp_str, dord); + elseif (!facecolor_none_or_white) + if (strncmp (obj.edgecolor, "none", 4)) + if (__gnuplot_has_feature__ ("transparent_surface") + && isscalar (obj.facealpha)) + fprintf (plot_stream, + "set style fill transparent solid %f;\n", + obj.facealpha); + endif + fprintf (plot_stream, "set pm3d explicit at s %s corners2color c3;\n", + interp_str, dord); + else + fprintf (plot_stream, "set pm3d explicit at s hidden3d %d %s %s corners2color c3;\n", + data_idx, interp_str, dord); + + if (__gnuplot_has_feature__ ("transparent_surface") + && isscalar (obj.facealpha)) + fprintf (plot_stream, + "set style fill transparent solid %f;\n", + obj.facealpha); + endif + endif + endif + + zz = []; + if (length (style) > 1) + len = 3 * xlen; + zz = zeros (ylen, len); + k = 1; + for kk = 1:3:len + zz(:,kk) = xdat(:,k); + zz(:,kk+1) = ydat(:,k); + zz(:,kk+2) = zdat(:,k); + k++; + endfor + zz = zz.'; + + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); + data{data_idx} = zz; + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{2}, data_idx); + + endif + if (length (style) > 2) + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); + data{data_idx} = zz; + withclause{data_idx} = sprintf ("with %s linestyle %d", + style{3}, data_idx); + endif + if (withpm3d && strncmp (style {1}, "linespoints", 11)) + if (isempty(zz)) + len = 3 * xlen; + zz = zeros (ylen, len); + k = 1; + for kk = 1:3:len + zz(:,kk) = xdat(:,k); + zz(:,kk+1) = ydat(:,k); + zz(:,kk+2) = zdat(:,k); + k++; + endfor + zz = zz.'; + endif + data_idx++; + is_image_data(data_idx) = is_image_data(data_idx - 1); + parametric(data_idx) = parametric(data_idx - 1); + have_cdata(data_idx) = false; + have_3d_patch(data_idx) = have_3d_patch(data_idx - 1); + titlespec{data_idx} = "title \"\""; + usingclause{data_idx} = sprintf ("record=%dx%d using ($1):($2):($3)", ylen, xlen); + data{data_idx} = zz; + withclause{data_idx} = sprintf ("with points linestyle %d", + pm3didx); + endif + endif + + case "text" + [label, f, s] = __maybe_munge_text__ (enhanced, obj, "string"); + fontspec = create_fontspec (f, s, gnuplot_term); + lpos = obj.position; + halign = obj.horizontalalignment; + valign = obj.verticalalignment; + angle = obj.rotation; + units = obj.units; + color = obj.color; + if (strcmpi (units, "normalized")) + units = "graph"; + elseif (strcmp (axis_obj.yaxislocation, "right") + && strcmp (units, "data")) + units = "second"; + else + units = ""; + endif + + if (isnumeric (color)) + colorspec = get_text_colorspec (color, mono); + endif + + if (ischar (obj.string)) + num_lines = size (obj.string, 1); + else + num_lines = numel (obj.string); + endif + switch valign + ## Text offset in characters. This relies on gnuplot for font metrics. + case "top" + dy = -0.5; + case "cap" + dy = -0.5; + case "middle" + dy = 0.5 * (num_lines - 1); + case "baseline" + dy = 0.5 + (num_lines - 1); + case "bottom" + dy = 0.5 + (num_lines - 1); + endswitch + ## Gnuplot's Character units are different for x/y and vary with fontsize. The aspect ratio + ## of 1:1.7 was determined by experiment to work for eps/ps/etc. For the MacOS aqua terminal + ## a value of 2.5 is needed. However, the difference is barely noticable. + dx_and_dy = [(-dy * sind (angle)), (dy * cosd(angle))] .* [1.7 1]; + + ## FIXME - Multiline text produced the gnuplot "warning: ft_render: skipping glyph" + if (nd == 3) + ## This produces the desired vertical alignment in 3D. + fprintf (plot_stream, + "set label \"%s\" at %s %.15e,%.15e,%.15e %s rotate by %f offset character %f,%f %s %s front %s;\n", + undo_string_escapes (label), units, lpos(1), + lpos(2), lpos(3), halign, angle, dx_and_dy, fontspec, + __do_enhanced_option__ (enhanced, obj), colorspec); + else + fprintf (plot_stream, + "set label \"%s\" at %s %.15e,%.15e %s rotate by %f offset character %f,%f %s %s front %s;\n", + undo_string_escapes (label), units, + lpos(1), lpos(2), halign, angle, dx_and_dy, fontspec, + __do_enhanced_option__ (enhanced, obj), colorspec); + endif + + case "hggroup" + ## Push group children into the kid list. + if (isempty (kids)) + kids = obj.children; + elseif (! isempty (obj.children)) + kids = [kids; obj.children]; + endif + + otherwise + error ("__go_draw_axes__: unknown object class, %s", + obj.type); + endswitch + + endwhile + + ## This is need to prevent warnings for rotations in 3D plots, while + ## allowing colorbars with contours. + if (nd == 2 || (data_idx > 1 && !view_map)) + fputs (plot_stream, "set pm3d implicit;\n"); + else + fputs (plot_stream, "set pm3d explicit;\n"); + endif + + if (isnan(hidden_removal) || hidden_removal) + fputs (plot_stream, "set hidden3d;\n"); + else + fputs (plot_stream, "unset hidden3d;\n"); + endif + + have_data = (! (isempty (data) || all (cellfun ("isempty", data)))); + + ## Note we don't use the [xy]2range of gnuplot as we don't use the + ## dual axis plotting features of gnuplot. + if (isempty (xlim)) + return; + endif + if (strcmpi (axis_obj.xdir, "reverse")) + xdir = "reverse"; + else + xdir = "noreverse"; + endif + fprintf (plot_stream, "set xrange [%.15e:%.15e] %s;\n", xlim, xdir); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "set x2range [%.15e:%.15e] %s;\n", xlim, xdir); + endif + + if (isempty (ylim)) + return; + endif + if (strcmpi (axis_obj.ydir, "reverse")) + ydir = "reverse"; + else + ydir = "noreverse"; + endif + fprintf (plot_stream, "set yrange [%.15e:%.15e] %s;\n", ylim, ydir); + if (strcmpi (axis_obj.yaxislocation, "right")) + fprintf (plot_stream, "set y2range [%.15e:%.15e] %s;\n", ylim, ydir); + endif + + if (nd == 3) + if (isempty (zlim)) + return; + endif + if (strcmpi (axis_obj.zdir, "reverse")) + zdir = "reverse"; + else + zdir = "noreverse"; + endif + fprintf (plot_stream, "set zrange [%.15e:%.15e] %s;\n", zlim, zdir); + endif + + cmap = parent_figure_obj.colormap; + cmap_sz = rows(cmap); + if (! any (isinf (clim))) + if (truecolor || ! cdatadirect) + if (rows(addedcmap) > 0) + for i = 1:data_idx + if (have_3d_patch(i)) + data{i}(end,:) = clim(2) * (data{i}(end, :) - 0.5) / cmap_sz; + endif + endfor + fprintf (plot_stream, "set cbrange [%g:%g];\n", clim(1), clim(2) * + (cmap_sz + rows(addedcmap)) / cmap_sz); + else + fprintf (plot_stream, "set cbrange [%g:%g];\n", clim); + endif + else + fprintf (plot_stream, "set cbrange [1:%d];\n", cmap_sz + + rows (addedcmap)); + endif + endif + + if (strcmpi (axis_obj.box, "on")) + if (nd == 3) + fputs (plot_stream, "set border 4095;\n"); + else + fputs (plot_stream, "set border 431;\n"); + endif + else + if (nd == 3) + fputs (plot_stream, "set border 895;\n"); + elseif (! isempty (axis_obj.ytick)) + if (strcmpi (axis_obj.yaxislocation, "right")) + fprintf (plot_stream, "unset ytics; set y2tics %s nomirror\n", + axis_obj.tickdir); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 12;\n"); + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 9;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 8;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); + endif + elseif (strcmpi (axis_obj.yaxislocation, "left")) + fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", + axis_obj.tickdir); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 6;\n"); + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 3;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 2;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); + endif + else # yaxislocation == zero + fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", + axis_obj.tickdir); + if (strcmpi (axis_obj.xaxislocation, "top")) + fprintf (plot_stream, "unset xtics; set x2tics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 4;\n"); + elseif (strcmpi (axis_obj.xaxislocation, "bottom")) + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "set border 1;\n"); + else # xaxislocation == zero + fprintf (plot_stream, "unset y2tics; set ytics %s nomirror\n", + axis_obj.tickdir); + fprintf (plot_stream, "unset x2tics; set xtics %s nomirror\n", + axis_obj.tickdir); + fputs (plot_stream, "unset border;\n"); + fprintf (plot_stream, "set xzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); + endif + fprintf (plot_stream, "set yzeroaxis lt -1 lw %f;\n", + axis_obj.linewidth); + endif + endif + endif + + if (strcmpi (axis_obj.visible, "off")) + fputs (plot_stream, "unset border; unset tics\n"); + else + fprintf (plot_stream, "set border lw %f;\n", axis_obj.linewidth); + endif + + if (! isempty (hlgnd) && ! isempty (hlgnd.children) + && any (strcmpi (get (hlgnd.children, "visible"), "on"))) + if (strcmpi (hlgnd.box, "on")) + box = "box"; + else + box = "nobox"; + endif + if (strcmpi (hlgnd.orientation, "vertical")) + horzvert = "vertical"; + else + horzvert = "horizontal"; + endif + if (strcmpi (hlgnd.textposition, "right")) + reverse = "reverse"; + else + reverse = "noreverse"; + endif + inout = "inside"; + keypos = hlgnd.location; + if (ischar (keypos)) + keypos = lower (keypos); + keyout = findstr (keypos, "outside"); + if (! isempty (keyout)) + inout = "outside"; + keypos = keypos(1:keyout-1); + endif + endif + switch (keypos) + case "north" + pos = "center top"; + case "south" + pos = "center bottom"; + case "east" + pos = "right center"; + case "west" + pos = "left center"; + case "northeast" + pos = "right top"; + case "northwest" + pos = "left top"; + case "southeast" + pos = "right bottom"; + case "southwest" + pos = "left bottom"; + case "best" + pos = ""; + warning ("legend: 'Best' not yet implemented for location specifier.\n"); + ## Least conflict with data in plot. + ## Least unused space outside plot. + otherwise + pos = ""; + endswitch + if (__gnuplot_has_feature__ ("key_has_font_properties")) + [fontname, fontsize] = get_fontname_and_size (hlgnd); + fontspec = create_fontspec (fontname, fontsize, gnuplot_term); + else + fontspec = ""; + endif + fprintf (plot_stream, "set key %s %s;\nset key %s %s %s %s;\n", + inout, pos, box, reverse, horzvert, fontspec); + else + fputs (plot_stream, "unset key;\n"); + endif + fputs (plot_stream, "set style data lines;\n"); + + cmap = [cmap; addedcmap]; + cmap_sz = cmap_sz + rows(addedcmap); + if (length(cmap) > 0) + fprintf (plot_stream, + "set palette positive color model RGB maxcolors %i;\n", + cmap_sz); + fprintf (plot_stream, + "set palette file \"-\" binary record=%d using 1:2:3:4;\n", + cmap_sz); + fwrite (plot_stream, [1:cmap_sz; cmap.'], "float32"); + fwrite (plot_stream, "\n"); + endif + + fputs (plot_stream, "unset colorbox;\n"); + + if (have_data) + if (nd == 2) + plot_cmd = "plot"; + else + plot_cmd = "splot"; + rot_x = 90 - axis_obj.view(2); + rot_z = axis_obj.view(1); + while (rot_z < 0) + rot_z += 360; + endwhile + fputs (plot_stream, "set ticslevel 0;\n"); + if (view_map && rot_x == 0 && rot_z == 0) + fputs (plot_stream, "set view map;\n"); + else + fprintf (plot_stream, "set view %.15g, %.15g;\n", rot_x, rot_z); + endif + endif + if (have_3d_patch (1)) + fputs (plot_stream, "set pm3d depthorder\n"); + fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, + usingclause{1}, titlespec{1}, withclause{1}); + elseif (is_image_data (1)) + if (numel (is_image_data) > 1 && is_image_data(2)) + ## Remove terminating semicolon + n = max (strfind (withclause{1}, ";")); + if (! isempty(n)) + withclause{1} = withclause{1}(1:n-1); + endif + endif + fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, + usingclause{1}, titlespec{1}, withclause{1}); + else + fprintf (plot_stream, "%s \"-\" binary format='%%float64' %s %s %s \\\n", plot_cmd, + usingclause{1}, titlespec{1}, withclause{1}); + endif + for i = 2:data_idx + if (have_3d_patch (i)) + fprintf (plot_stream, ", \"-\" %s %s %s \\\n", + usingclause{i}, titlespec{i}, withclause{i}); + elseif (is_image_data (i)) + if (! is_image_data (i-1)) + fputs (plot_stream, "; "); + if (bg_is_set) + fputs (plot_stream, "unset obj 1; \\\n"); + bg_is_set = false; + endif + if (fg_is_set) + fputs (plot_stream, "unset obj 2; \\\n"); + fg_is_set = false; + endif + if (numel (is_image_data) > i && is_image_data(i+1)) + ## Remove terminating semicolon + n = max (strfind (withclause{i}, ";")); + if (! isempty(n)) + withclause{i} = withclause{i}(1:n-1); + endif + endif + fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", plot_cmd, + usingclause{i}, titlespec{i}, withclause{i}); + else + ## For consecutive images continue with the same plot command + fprintf (plot_stream, "%s \"-\" %s %s %s \\\n", ",", + usingclause{i}, titlespec{i}, withclause{i}); + endif + elseif (is_image_data (i-1)) + if (bg_is_set) + fputs (plot_stream, "unset obj 1; \\\n"); + bg_is_set = false; + endif + if (fg_is_set) + fputs (plot_stream, "unset obj 2; \\\n"); + fg_is_set = false; + endif + fprintf (plot_stream, "%s \"-\" binary format='%%float64' %s %s %s \\\n", plot_cmd, + usingclause{i}, titlespec{i}, withclause{i}); + else + fprintf (plot_stream, ", \"-\" binary format='%%float64' %s %s %s \\\n", + usingclause{i}, titlespec{i}, withclause{i}); + endif + endfor + fputs (plot_stream, ";\n"); + for i = 1:data_idx + if (have_3d_patch (i)) + ## Can't write 3d patch data as binary as can't plot more than + ## a single patch at a time and have to plot all patches together + ## so that the gnuplot depth ordering is done correctly + for j = 1 : 4 : columns(data{i}) + if (j != 1) + fputs (plot_stream, "\n\n"); + endif + fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j).'); + fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n\n", data{i}(:,j+1).'); + fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j+2).'); + fprintf (plot_stream, "%.15g %.15g %.15g %.15g\n", data{i}(:,j+3).'); + endfor + fputs (plot_stream, "e\n"); + elseif (is_image_data(i)) + fwrite (plot_stream, data{i}, "float32"); + else + __gnuplot_write_data__ (plot_stream, data{i}, nd, parametric(i), + have_cdata(i)); + endif + endfor + else + fputs (plot_stream, "plot \"-\";\nInf Inf\ne\n"); + endif + + ## Needed to allow mouse rotation with pcolor. + if (view_map) + fputs (plot_stream, "unset view;\n"); + endif + + if (bg_is_set) + fputs (plot_stream, "unset obj 1;\n"); + bg_is_set = false; + endif + + fflush (plot_stream); + + else + print_usage (); + endif + +endfunction + +function x = flip (x) + if (size (x, 1) == 1) + x = fliplr (x); + elseif (size (x, 2) == 1 || ischar (x)) + x = flipud (x); + else + x = flipud (fliplr (x)); + endif +endfunction + +function fontspec = create_fontspec (f, s, gp_term) + if (strcmp (f, "*") || strcmp (gp_term, "tikz")) + fontspec = sprintf ("font \",%d\"", s); + else + fontspec = sprintf ("font \"%s,%d\"", f, s); + endif +endfunction + +function style = do_linestyle_command (obj, linecolor, idx, mono, + plot_stream, errbars = "") + style = {}; + + fprintf (plot_stream, "set style line %d default;\n", idx); + fprintf (plot_stream, "set style line %d", idx); + + found_style = false; + if (isnumeric (linecolor)) + color = linecolor; + if (! mono) + fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", + round (255*color)); + endif + else + color = [0, 0, 0]; + endif + + if (isfield (obj, "linestyle")) + switch (obj.linestyle) + case "-" + lt = "1"; + case "--" + lt = "2"; + case ":" + lt = "3"; + case "-." + lt = "6"; + case "none" + lt = ""; + otherwise + lt = ""; + endswitch + + if (! isempty (lt)) + fprintf (plot_stream, " linetype %s", lt); + endif + + else + lt = ""; + endif + if (! isempty (errbars)) + found_style = true; + endif + + if (isfield (obj, "linewidth")) + fprintf (plot_stream, " linewidth %f", obj.linewidth); + found_style = true; + endif + + [pt, pt2, obj] = gnuplot_pointtype (obj); + + if (! isempty (pt)) + found_style = true; + endif + + sidx = 1; + if (isempty (errbars)) + if (isempty (lt)) + style {sidx} = ""; + else + style {sidx} = "lines"; + endif + + facesame = true; + if (! isequal (pt, pt2) && isfield (obj, "markerfacecolor") + && !strncmp (obj.markerfacecolor, "none", 4)) + if (strncmp (obj.markerfacecolor, "auto", 4) + || ! isnumeric (obj.markerfacecolor) + || (isnumeric (obj.markerfacecolor) + && isequal (color, obj.markerfacecolor))) + if (! isempty (pt2)) + fprintf (plot_stream, " pointtype %s", pt2); + style {sidx} = strcat (style{sidx}, "points"); + endif + if (isfield (obj, "markersize")) + fprintf (plot_stream, " pointsize %f", obj.markersize / 3); + endif + else + facesame = false; + if (! found_style) + fputs (plot_stream, " default"); + endif + fputs (plot_stream, ";\n"); + if (! isempty (style {sidx})) + sidx ++; + idx ++; + else + fputs (plot_stream, ";\n"); + endif + fprintf (plot_stream, "set style line %d default;\n", idx); + fprintf (plot_stream, "set style line %d", idx); + if (isnumeric (obj.markerfacecolor) && ! mono) + fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", + round (255*obj.markerfacecolor)); + endif + if (! isempty (pt2)) + style {sidx} = "points"; + fprintf (plot_stream, " pointtype %s", pt2); + endif + if (isfield (obj, "markersize")) + fprintf (plot_stream, " pointsize %f", obj.markersize / 3); + endif + endif + endif + if (isfield (obj, "markeredgecolor") + && !strncmp (obj.markeredgecolor, "none", 4)) + if (facesame && !isempty (pt) + && (strncmp (obj.markeredgecolor, "auto", 4) + || ! isnumeric (obj.markeredgecolor) + || (isnumeric (obj.markeredgecolor) + && isequal (color, obj.markeredgecolor)))) + if (sidx == 1 && ((length (style {sidx}) == 5 + && strncmp (style {sidx}, "lines", 5)) || isempty (style {sidx}))) + if (! isempty (pt)) + style {sidx} = strcat (style{sidx}, "points"); + fprintf (plot_stream, " pointtype %s", pt); + endif + if (isfield (obj, "markersize")) + fprintf (plot_stream, " pointsize %f", obj.markersize / 3); + endif + endif + else + if (! found_style) + fputs (plot_stream, " default"); + endif + fputs (plot_stream, ";\n"); + if (!isempty (style {sidx})) + sidx ++; + idx ++; + else + fputs (plot_stream, ";\n"); + endif + fprintf (plot_stream, "set style line %d default;\n", idx); + fprintf (plot_stream, "set style line %d", idx); + if (! mono) + if (strncmp (obj.markeredgecolor, "auto", 4)) + fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", + round (255*color)); + elseif (isnumeric (obj.markeredgecolor) && ! mono) + fprintf (plot_stream, " linecolor rgb \"#%02x%02x%02x\"", + round (255*obj.markeredgecolor)); + endif + endif + if (! isempty (pt)) + style {sidx} = "points"; + fprintf (plot_stream, " pointtype %s", pt); + endif + if (isfield (obj, "markersize")) + fprintf (plot_stream, " pointsize %f", obj.markersize / 3); + endif + endif + endif + else + style{1} = errbars; + fputs (plot_stream, " pointtype 0"); + endif + + if (! found_style && isempty (style {1})) + fputs (plot_stream, " default"); + endif + + fputs (plot_stream, ";\n"); + +endfunction + +function [pt, pt2, obj] = gnuplot_pointtype (obj) + if (isfield (obj, "marker")) + switch (obj.marker) + case "+" + pt = pt2 = "1"; + case "o" + pt = "6"; + pt2 = "7"; + case "*" + pt = pt2 = "3"; + case "." + pt = "6"; + pt2 = "7"; + if (isfield (obj, "markerfacecolor") + || strncmp (obj.markerfacecolor, "none", 4)) + obj.markerfacecolor = "auto"; + endif + if (isfield (obj, "markersize")) + obj.markersize /= 3; + else + obj.markersize = 5; + endif + case "x" + pt = pt2 = "2"; + case {"square", "s"} + pt = "4"; + pt2 = "5"; + case {"diamond", "d"} + pt = "12"; + pt2 = "13"; + case "^" + pt = "8"; + pt2 = "9"; + case "v" + pt = "10"; + pt2 = "11"; + case ">" + ## FIXME -- should be triangle pointing right, use triangle pointing up + pt = "8"; + pt2 = "9"; + case "<" + ## FIXME -- should be triangle pointing left, use triangle pointing down + pt = "10"; + pt2 = "11"; + case {"pentagram", "p"} + ## FIXME -- should be pentagram, using pentagon + pt = "14"; + pt2 = "15"; + case {"hexagram", "h"} + ## FIXME -- should be 6 pt start, using "*" instead + pt = pt2 = "3"; + case "none" + pt = pt2 = ""; + otherwise + pt = pt2 = ""; + endswitch + else + pt = pt2 = ""; + endif +endfunction + +function __gnuplot_write_data__ (plot_stream, data, nd, parametric, cdata) + + ## DATA is already transposed. + + ## FIXME -- this may need to be converted to C++ for speed. + + ## Convert NA elements to normal NaN values because fprintf writes + ## "NA" and that confuses gnuplot. + idx = find (isna (data)); + if (any (idx)) + data(idx) = NaN; + endif + + if (nd == 2) + fwrite (plot_stream, data, "float64"); + elseif (nd == 3) + if (parametric) + fwrite (plot_stream, data, "float64"); + else + nr = rows (data); + if (cdata) + for j = 1:4:nr + fwrite (plot_stream, data(j:j+3,:), "float64"); + endfor + else + for j = 1:3:nr + fwrite (plot_stream, data(j:j+2,:), "float64"); + endfor + endif + endif + endif + +endfunction + +function do_tics (obj, plot_stream, ymirror, mono, gnuplot_term) + + obj.xticklabel = ticklabel_to_cell (obj.xticklabel); + obj.yticklabel = ticklabel_to_cell (obj.yticklabel); + obj.zticklabel = ticklabel_to_cell (obj.zticklabel); + + if (strcmp (obj.xminorgrid, "on")) + obj.xminortick = "on"; + endif + if (strcmp (obj.yminorgrid, "on")) + obj.yminortick = "on"; + endif + if (strcmp (obj.zminorgrid, "on")) + obj.zminortick = "on"; + endif + + [fontname, fontsize] = get_fontname_and_size (obj); + fontspec = create_fontspec (fontname, fontsize, gnuplot_term); + + ## A Gnuplot tic scale of 69 is equivalent to Octave's 0.5. + ticklength = sprintf ("scale %4.1f", (69/0.5)*obj.ticklength(1)); + + if (strcmpi (obj.xaxislocation, "top")) + do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, + obj.xticklabel, obj.xcolor, "x2", plot_stream, true, mono, + "border", obj.tickdir, ticklength, fontname, fontspec, + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); + do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, + obj.xcolor, "x", plot_stream, true, mono, "border", + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + obj.xsgn, gnuplot_term); + elseif (strcmpi (obj.xaxislocation, "zero")) + do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, + obj.xticklabel, obj.xcolor, "x", plot_stream, true, mono, + "axis", obj.tickdir, ticklength, fontname, fontspec, + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); + do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, + obj.xcolor, "x2", plot_stream, true, mono, "axis", + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + obj.xsgn, gnuplot_term); + else + do_tics_1 (obj.xtickmode, obj.xtick, obj.xminortick, obj.xticklabelmode, + obj.xticklabel, obj.xcolor, "x", plot_stream, true, mono, + "border", obj.tickdir, ticklength, fontname, fontspec, + obj.interpreter, obj.xscale, obj.xsgn, gnuplot_term); + do_tics_1 ("manual", [], "off", obj.xticklabelmode, obj.xticklabel, + obj.xcolor, "x2", plot_stream, true, mono, "border", + "", "", fontname, fontspec, obj.interpreter, obj.xscale, + obj.xsgn, gnuplot_term); + endif + if (strcmpi (obj.yaxislocation, "right")) + do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, + obj.yticklabel, obj.ycolor, "y2", plot_stream, ymirror, mono, + "border", obj.tickdir, ticklength, fontname, fontspec, + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); + do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, + obj.ycolor, "y", plot_stream, ymirror, mono, "border", + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + obj.ysgn, gnuplot_term); + elseif (strcmpi (obj.yaxislocation, "zero")) + do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, + obj.yticklabel, obj.ycolor, "y", plot_stream, ymirror, mono, + "axis", obj.tickdir, ticklength, fontname, fontspec, + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); + do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, + obj.ycolor, "y2", plot_stream, ymirror, mono, "axis", + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + obj.ysgn, gnuplot_term); + else + do_tics_1 (obj.ytickmode, obj.ytick, obj.yminortick, obj.yticklabelmode, + obj.yticklabel, obj.ycolor, "y", plot_stream, ymirror, mono, + "border", obj.tickdir, ticklength, fontname, fontspec, + obj.interpreter, obj.yscale, obj.ysgn, gnuplot_term); + do_tics_1 ("manual", [], "off", obj.yticklabelmode, obj.yticklabel, + obj.ycolor, "y2", plot_stream, ymirror, mono, "border", + "", "", fontname, fontspec, obj.interpreter, obj.yscale, + obj.ysgn, gnuplot_term); + endif + do_tics_1 (obj.ztickmode, obj.ztick, obj.zminortick, obj.zticklabelmode, + obj.zticklabel, obj.zcolor, "z", plot_stream, true, mono, + "border", obj.tickdir, ticklength, fontname, fontspec, + obj.interpreter, obj.zscale, obj.zsgn, gnuplot_term); +endfunction + +function do_tics_1 (ticmode, tics, mtics, labelmode, labels, color, ax, + plot_stream, mirror, mono, axispos, tickdir, ticklength, + fontname, fontspec, interpreter, scale, sgn, gnuplot_term) + persistent warned_latex = false; + if (strcmpi (interpreter, "tex")) + for n = 1 : numel(labels) + labels{n} = __tex2enhanced__ (labels{n}, fontname, false, false); + endfor + elseif (strcmpi (interpreter, "latex")) + if (! warned_latex) + warning ("latex markup not supported for tick marks"); + warned_latex = true; + endif + endif + if (strcmp (scale, "log")) + num_mtics = 10; + if (any (strcmp (gnuplot_term, {"tikz", "pstex", "pslatex", "epslatex"}))) + fmt = "$10^{%T}$"; + else + fmt = "10^{%T}"; + endif + if (sgn < 0) + fmt = strcat ("-", fmt); + endif + else + fmt = "%g"; + num_mtics = 5; + endif + colorspec = get_text_colorspec (color, mono); + if (strcmpi (ticmode, "manual") || strcmpi (labelmode, "manual")) + if (isempty (tics)) + fprintf (plot_stream, "unset %stics;\nunset m%stics;\n", ax, ax); + elseif (strcmpi (labelmode, "manual")) + if (ischar (labels)) + labels = cellstr (labels); + endif + if (isnumeric (labels)) + labels = num2str (real (labels(:))); + endif + if (ischar (labels)) + labels = permute (cellstr (labels), [2, 1]); + endif + if (iscellstr (labels)) + k = 1; + ntics = numel (tics); + nlabels = numel (labels); + fprintf (plot_stream, "set format %s \"%%s\";\n", ax); + if (mirror) + fprintf (plot_stream, "set %stics %s %s %s mirror (", ax, + tickdir, ticklength, axispos); + else + fprintf (plot_stream, "set %stics %s %s %s nomirror (", ax, + tickdir, ticklength, axispos); + endif + + labels = regexprep(labels, '%', "%%"); + for i = 1:ntics + fprintf (plot_stream, " \"%s\" %.15g", labels{k++}, tics(i)); + if (i < ntics) + fputs (plot_stream, ", "); + endif + if (k > nlabels) + k = 1; + endif + endfor + fprintf (plot_stream, ") %s %s;\n", colorspec, fontspec); + if (strcmp (mtics, "on")) + fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); + else + fprintf (plot_stream, "unset m%stics;\n", ax); + endif + else + error ("__go_draw_axes__: unsupported type of ticklabel"); + endif + else + fprintf (plot_stream, "set format %s \"%s\";\n", ax, fmt); + if (mirror) + fprintf (plot_stream, "set %stics %s %s %s mirror (", ax, tickdir, + ticklength, axispos); + else + fprintf (plot_stream, "set %stics %s %s %s nomirror (", ax, tickdir, + ticklength, axispos); + endif + fprintf (plot_stream, " %.15g,", tics(1:end-1)); + fprintf (plot_stream, " %.15g) %s;\n", tics(end), fontspec); + if (strcmp (mtics, "on")) + fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); + else + fprintf (plot_stream, "unset m%stics;\n", ax); + endif + endif + else + fprintf (plot_stream, "set format %s \"%s\";\n", ax, fmt); + if (mirror) + fprintf (plot_stream, "set %stics %s %s %s mirror %s %s;\n", ax, + axispos, tickdir, ticklength, colorspec, fontspec); + else + fprintf (plot_stream, "set %stics %s %s %s nomirror %s %s;\n", ax, + tickdir, ticklength, axispos, colorspec, fontspec); + endif + if (strcmp (mtics, "on")) + fprintf (plot_stream, "set m%stics %d;\n", ax, num_mtics); + else + fprintf (plot_stream, "unset m%stics;\n", ax); + endif + endif +endfunction + +function ticklabel = ticklabel_to_cell (ticklabel) + if (isnumeric (ticklabel)) + ## Use upto 5 significant digits + ticklabel = num2str (ticklabel(:), 5); + endif + if (ischar (ticklabel)) + if (size (ticklabel, 1) == 1 && any (ticklabel == "|")) + n = setdiff (findstr (ticklabel, "|"), findstr (ticklabel, '\|')); + ticklabel = strsplit (ticklabel, "|"); + else + ticklabel = cellstr (ticklabel); + endif + elseif (isempty (ticklabel)) + ticklabel = {""}; + else + ticklabel = ticklabel; + endif +endfunction + +function colorspec = get_text_colorspec (color, mono) + if (mono) + colorspec = ""; + else + colorspec = sprintf ("textcolor rgb \"#%02x%02x%02x\"", + round (255*color)); + endif +endfunction + +function [f, s, fnt, it, bld] = get_fontname_and_size (t) + if (isempty (t.fontname) || strcmp (t.fontname, "*")) + fnt = "{}"; + else + fnt = t.fontname; + endif + f = fnt; + it = false; + bld = false; + if (! isempty (t.fontweight) && strcmpi (t.fontweight, "bold")) + if (! isempty(t.fontangle) + && (strcmpi (t.fontangle, "italic") + || strcmpi (t.fontangle, "oblique"))) + f = cstrcat (f, "-bolditalic"); + it = true; + bld = true; + else + f = cstrcat (f, "-bold"); + bld = true; + endif + elseif (! isempty(t.fontangle) + && (strcmpi (t.fontangle, "italic") + || strcmpi (t.fontangle, "oblique"))) + f = cstrcat (f, "-italic"); + it = true; + endif + if (isempty (t.fontsize)) + s = 10; + else + s = t.fontsize; + endif +endfunction + +function [str, f, s] = __maybe_munge_text__ (enhanced, obj, fld) + + persistent warned_latex = false; + + if (strcmp (fld, "string")) + [f, s, fnt, it, bld] = get_fontname_and_size (obj); + else + f = "Helvetica"; + s = 10; + fnt = f; + it = false; + bld = false; + endif + + ## The text object maybe multiline, and may be of any class + str = getfield (obj, fld); + if (ischar (str) && size (str, 1) > 1) + str = cellstr (str); + elseif (isnumeric (str)) + str = cellstr (num2str (str(:))); + endif + if (iscellstr (str)) + for n = 1:numel(str) + if (isnumeric (str{n})) + str{n} = num2str (str{n}); + endif + endfor + str = sprintf ("%s\n", str{:})(1:end-1); + endif + + if (enhanced) + if (strcmpi (obj.interpreter, "tex")) + if (iscellstr (str)) + for n = 1:numel(str) + str{n} = __tex2enhanced__ (str{n}, fnt, it, bld); + endfor + else + str = __tex2enhanced__ (str, fnt, it, bld); + endif + elseif (strcmpi (obj.interpreter, "latex")) + if (! warned_latex) + warning ("latex markup not supported for text objects"); + warned_latex = true; + endif + elseif (enhanced) + str = no_super_sub_scripts (str); + endif + endif +endfunction + +function str = no_super_sub_scripts (str) + if (iscellstr (str)) + labels = str; + else + labels = cellstr (str); + endif + for marker = "_^" + for m = 1 : numel(labels) + n1 = strfind (labels{m}, sprintf ("\\%s", marker)); + n2 = strfind (labels{m}, marker); + if (! isempty (n1)) + n1 = n1 + 1; + n2 = setdiff (n2, n1); + end + for n = numel(n2):-1:1 + labels{m} = [labels{m}(1:n2(n)-1), "\\", labels{m}(n2(n):end)] + endfor + endfor + endfor + if (iscellstr (str)) + str = labels; + else + str = char (labels); + endif +endfunction + +function str = __tex2enhanced__ (str, fnt, it, bld) + persistent sym = __setup_sym_table__ (); + persistent flds = fieldnames (sym); + + [s, e, m] = regexp(str,'\\([a-zA-Z]+|0)','start','end','matches'); + + for i = length (s) : -1 : 1 + ## special case for "\0" and replace with "{/Symbol \306}' + if (strncmp (m{i}, '\0', 2)) + str = cstrcat (str(1:s(i) - 1), '{/Symbol \306}', str(s(i) + 2:end)); + else + f = m{i}(2:end); + if (isfield (sym, f)) + g = getfield(sym, f); + ## FIXME The symbol font doesn't seem to support bold or italic + ##if (bld) + ## if (it) + ## g = regexprep (g, '/Symbol', '/Symbol-bolditalic'); + ## else + ## g = regexprep (g, '/Symbol', '/Symbol-bold'); + ## endif + ##elseif (it) + ## g = regexprep (g, '/Symbol', '/Symbol-italic'); + ##endif + str = cstrcat (str(1:s(i) - 1), g, str(e(i) + 1:end)); + elseif (strncmp (f, "rm", 2)) + bld = false; + it = false; + str = cstrcat (str(1:s(i) - 1), '/', fnt, ' ', str(s(i) + 3:end)); + elseif (strncmp (f, "it", 2) || strncmp (f, "sl", 2)) + it = true; + if (bld) + str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bolditalic ', + str(s(i) + 3:end)); + else + str = cstrcat (str(1:s(i) - 1), '/', fnt, '-italic ', + str(s(i) + 3:end)); + endif + elseif (strncmp (f, "bf", 2)) + bld = true; + if (it) + str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bolditalic ', + str(2(i) + 3:end)); + else + str = cstrcat (str(1:s(i) - 1), '/', fnt, '-bold ', + str(s(i) + 3:end)); + endif + elseif (strcmpi (f, "color")) + ## FIXME Ignore \color but remove trailing {} block as well + d = strfind(str(e(i) + 1:end),'}'); + if (isempty (d)) + warning ('syntax error in \color argument'); + else + str = cstrcat (str(1:s(i) - 1), str(e(i) + d + 1:end)); + endif + elseif(strcmpi (f, "fontname")) + b1 = strfind(str(e(i) + 1:end),'{'); + b2 = strfind(str(e(i) + 1:end),'}'); + if (isempty(b1) || isempty(b2)) + warning ('syntax error in \fontname argument'); + else + str = cstrcat (str(1:s(i) - 1), '/', + str(e(i)+b1(1) + 1:e(i)+b2(1)-1), '{}', + str(e(i) + b2(1) + 1:end)); + endif + elseif(strcmpi (f, "fontsize")) + b1 = strfind(str(e(i) + 1:end),'{'); + b2 = strfind(str(e(i) + 1:end),'}'); + if (isempty(b1) || isempty(b2)) + warning ('syntax error in \fontname argument'); + else + str = cstrcat (str(1:s(i) - 1), '/=', + str(e(i)+b1(1) + 1:e(i)+b2(1)-1), '{}', + str(e(i) + b2(1) + 1:end)); + endif + else + ## Last desperate attempt to treat the symbol. Look for things + ## like \pix, that should be translated to the symbol Pi and x + for j = 1 : length (flds) + if (strncmp (flds{j}, f, length (flds{j}))) + g = getfield(sym, flds{j}); + ## FIXME The symbol font doesn't seem to support bold or italic + ##if (bld) + ## if (it) + ## g = regexprep (g, '/Symbol', '/Symbol-bolditalic'); + ## else + ## g = regexprep (g, '/Symbol', '/Symbol-bold'); + ## endif + ##elseif (it) + ## g = regexprep (g, '/Symbol', '/Symbol-italic'); + ##endif + str = cstrcat (str(1:s(i) - 1), g, + str(s(i) + length (flds{j}) + 1:end)); + break; + endif + endfor + endif + endif + endfor + + ## Prepend @ to things things like _0^x or _{-100}^{100} for + ## alignment But need to put the shorter of the two arguments first. + ## Carful of nested {} and unprinted characters when defining + ## shortest.. Don't have to worry about things like ^\theta as they + ## are already converted to ^{/Symbol q}. + + ## FIXME -- This is a mess... Is it worth it just for a "@" character? + + [s, m] = regexp(str,'[_\^]','start','matches'); + i = 1; + p = 0; + while (i < length (s)) + if (i < length(s)) + if (str(s(i) + p + 1) == "{") + s1 = strfind(str(s(i) + p + 2:end),'{'); + si = 1; + l1 = strfind(str(s(i) + p + 1:end),'}'); + li = 1; + while (li <= length (l1) && si <= length (s1)) + if (l1(li) < s1(si)) + if (li == si) + break; + endif + li++; + else + si++; + endif + endwhile + l1 = l1 (min (length(l1), si)); + if (s(i) + l1 + 1 == s(i+1)) + if (str(s(i + 1) + p + 1) == "{") + s2 = strfind(str(s(i + 1) + p + 2:end),'{'); + si = 1; + l2 = strfind(str(s(i + 1) + p + 1:end),'}'); + li = 1; + while (li <= length (l2) && si <= length (s2)) + if (l2(li) < s2(si)) + if (li == si) + break; + endif + li++; + else + si++; + endif + endwhile + l2 = l2 (min (length(l2), si)); + if (length_string (str(s(i)+p+2:s(i)+p+l1-1)) <= + length_string(str(s(i+1)+p+2:s(i+1)+p+l2-1))) + ## Shortest already first! + str = cstrcat (str(1:s(i)+p-1), "@", str(s(i)+p:end)); + else + ## Have to swap sub/super-script to get shortest first. + str = cstrcat (str(1:s(i)+p-1), "@", str(s(i+1)+p:s(i+1)+p+l2), + str(s(i)+p:s(i)+p+l1), str(s(i+1)+p+l2+1:end)); + endif + else + ## Have to swap sub/super-script to get shortest first. + str = cstrcat (str(1:s(i)+p-1), "@", str(s(i+1)+p:s(i+1)+p+1), + str(s(i)+p:s(i)+p+l1), str(s(i+1)+p+2:end)); + endif + i += 2; + p ++; + else + i++; + endif + else + if (s(i+1) == s(i) + 2) + ## Shortest already first! + str = cstrcat (str(1:s(i)+p-1), "@", str(s(i)+p:end)); + p ++; + i += 2; + else + i ++; + endif + endif + else + i ++; + endif + endwhile + +endfunction + +function l = length_string (s) + l = length (s) - length (strfind(s,'{')) - length (strfind(s,'}')); + m = regexp (s, '/([\w-]+|[\w-]+=\d+)', 'matches'); + if (!isempty (m)) + l = l - sum (cellfun ("length", m)); + endif +endfunction + +function sym = __setup_sym_table__ () + ## Setup the translation table for TeX to gnuplot enhanced mode. + sym.forall = '{/Symbol \042}'; + sym.exists = '{/Symbol \044}'; + sym.ni = '{/Symbol \047}'; + sym.cong = '{/Symbol \100}'; + sym.Delta = '{/Symbol D}'; + sym.Phi = '{/Symbol F}'; + sym.Gamma = '{/Symbol G}'; + sym.vartheta = '{/Symbol J}'; + sym.Lambda = '{/Symbol L}'; + sym.Pi = '{/Symbol P}'; + sym.Theta = '{/Symbol Q}'; + sym.Sigma = '{/Symbol S}'; + sym.varsigma = '{/Symbol V}'; + sym.Omega = '{/Symbol W}'; + sym.Xi = '{/Symbol X}'; + sym.Psi = '{/Symbol Y}'; + sym.perp = '{/Symbol \136}'; + sym.alpha = '{/Symbol a}'; + sym.beta = '{/Symbol b}'; + sym.chi = '{/Symbol c}'; + sym.delta = '{/Symbol d}'; + sym.epsilon = '{/Symbol e}'; + sym.phi = '{/Symbol f}'; + sym.gamma = '{/Symbol g}'; + sym.eta = '{/Symbol h}'; + sym.iota = '{/Symbol i}'; + sym.varphi = '{/Symbol j}'; + sym.kappa = '{/Symbol k}'; + sym.lambda = '{/Symbol l}'; + sym.mu = '{/Symbol m}'; + sym.nu = '{/Symbol n}'; + sym.o = '{/Symbol o}'; + sym.pi = '{/Symbol p}'; + sym.theta = '{/Symbol q}'; + sym.rho = '{/Symbol r}'; + sym.sigma = '{/Symbol s}'; + sym.tau = '{/Symbol t}'; + sym.upsilon = '{/Symbol u}'; + sym.varpi = '{/Symbol v}'; + sym.omega = '{/Symbol w}'; + sym.xi = '{/Symbol x}'; + sym.psi = '{/Symbol y}'; + sym.zeta = '{/Symbol z}'; + sym.sim = '{/Symbol \176}'; + sym.Upsilon = '{/Symbol \241}'; + sym.prime = '{/Symbol \242}'; + sym.leq = '{/Symbol \243}'; + sym.infty = '{/Symbol \245}'; + sym.clubsuit = '{/Symbol \247}'; + sym.diamondsuit = '{/Symbol \250}'; + sym.heartsuit = '{/Symbol \251}'; + sym.spadesuit = '{/Symbol \252}'; + sym.leftrightarrow = '{/Symbol \253}'; + sym.leftarrow = '{/Symbol \254}'; + sym.uparrow = '{/Symbol \255}'; + sym.rightarrow = '{/Symbol \256}'; + sym.downarrow = '{/Symbol \257}'; + sym.circ = '{/Symbol \260}'; + sym.pm = '{/Symbol \261}'; + sym.geq = '{/Symbol \263}'; + sym.times = '{/Symbol \264}'; + sym.propto = '{/Symbol \265}'; + sym.partial = '{/Symbol \266}'; + sym.bullet = '{/Symbol \267}'; + sym.div = '{/Symbol \270}'; + sym.neq = '{/Symbol \271}'; + sym.equiv = '{/Symbol \272}'; + sym.approx = '{/Symbol \273}'; + sym.ldots = '{/Symbol \274}'; + sym.mid = '{/Symbol \275}'; + sym.aleph = '{/Symbol \300}'; + sym.Im = '{/Symbol \301}'; + sym.Re = '{/Symbol \302}'; + sym.wp = '{/Symbol \303}'; + sym.otimes = '{/Symbol \304}'; + sym.oplus = '{/Symbol \305}'; + sym.oslash = '{/Symbol \306}'; + sym.cap = '{/Symbol \307}'; + sym.cup = '{/Symbol \310}'; + sym.supset = '{/Symbol \311}'; + sym.supseteq = '{/Symbol \312}'; + sym.subset = '{/Symbol \314}'; + sym.subseteq = '{/Symbol \315}'; + sym.in = '{/Symbol \316}'; + sym.notin = '{/Symbol \317}'; + sym.angle = '{/Symbol \320}'; + sym.bigtriangledown = '{/Symbol \321}'; + sym.langle = '{/Symbol \341}'; + sym.rangle = '{/Symbol \361}'; + sym.nabla = '{/Symbol \321}'; + sym.prod = '{/Symbol \325}'; + sym.surd = '{/Symbol \326}'; + sym.cdot = '{/Symbol \327}'; + sym.neg = '{/Symbol \330}'; + sym.wedge = '{/Symbol \331}'; + sym.vee = '{/Symbol \332}'; + sym.Leftrightarrow = '{/Symbol \333}'; + sym.Leftarrow = '{/Symbol \334}'; + sym.Uparrow = '{/Symbol \335}'; + sym.Rightarrow = '{/Symbol \336}'; + sym.Downarrow = '{/Symbol \337}'; + sym.diamond = '{/Symbol \340}'; + sym.copyright = '{/Symbol \343}'; + sym.lfloor = '{/Symbol \353}'; + sym.lceil = '{/Symbol \351}'; + sym.rfloor = '{/Symbol \373}'; + sym.rceil = '{/Symbol \371}'; + sym.int = '{/Symbol \362}'; +endfunction + +function retval = __do_enhanced_option__ (enhanced, obj) + retval = ""; + if (enhanced) + if (strcmpi (obj.interpreter, "none")) + retval = "noenhanced"; + else + retval = "enhanced"; + endif + endif +endfunction diff --git a/octave_packages/m/plot/private/__go_draw_figure__.m b/octave_packages/m/plot/private/__go_draw_figure__.m new file mode 100644 index 0000000..057620c --- /dev/null +++ b/octave_packages/m/plot/private/__go_draw_figure__.m @@ -0,0 +1,198 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __go_draw_figure__ (@var{h}, @var{plot_stream}, @var{enhanced}, @var{mono}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function __go_draw_figure__ (h, plot_stream, enhanced, mono) + + if (nargin == 4) + htype = get (h, "type"); + if (strcmp (htype, "figure")) + ## Get complete list of children. + kids = allchild (h); + nkids = length (kids); + + if (nkids > 0) + fputs (plot_stream, "\nreset;\n"); + fputs (plot_stream, "set autoscale keepfix;\n"); + fputs (plot_stream, "set origin 0, 0\n"); + fputs (plot_stream, "set size 1, 1\n"); + bg = get (h, "color"); + if (isnumeric (bg)) + fprintf (plot_stream, "set obj 1 rectangle from screen 0,0 to screen 1,1 behind fc rgb \"#%02x%02x%02x\"\n", 255 * bg); + bg_is_set = true; + else + bg_is_set = false; + endif + + for i = nkids:-1:1 + type = get (kids(i), "type"); + switch (type) + case "axes" + if (strcmpi (get (kids (i), "tag"), "legend")) + ## This is so ugly. If there was a way of getting + ## gnuplot to give us the text extents of strings + ## then we could get rid of this mess. + lh = getfield (get (kids(i), "userdata"), "handle"); + if (isscalar (lh)) + ## We have a legend with a single parent. It'll be handled + ## below as a gnuplot key to the axis it corresponds to + continue; + else + ca = lh(1); + ## Rely upon listener to convert axes position + ## to "normalized" units. + legend_axes_units = get (kids(i), "units"); + legend_axes_position = get (kids(i), "position"); + legend_axes_outerposition = get (kids(i), "outerposition"); + legend_axes_box = get (kids(i), "box"); + legend_axes_ylim = get (kids(i), "ylim"); + orig_axes_units = get (ca, "units"); + hlgnd = get (kids(i)); + + unwind_protect + set (ca, "units", "normalized"); + set (kids(i), "units", "normalized", "box", "off", + "ylim", [-2, -1], "position", get (ca(1), "position"), + "outerposition", get (ca(1), "outerposition")); + + ## Create a new set of lines with the appropriate + ## displaynames, etc + toberm = []; + hobj = get (kids(i), "children"); + for j = numel (hobj) : -1 : 1 + if (! strcmp (get (hobj(j), "type"), "text")) + continue; + endif + displayname = get (hobj(j), "string"); + ll = []; + lm = []; + for k = numel (hobj) : -1 : 1 + if (! strcmp (get (hobj(k), "type"), "line")) + continue; + endif + if (get (hobj(j), "userdata") + != get (hobj(k), "userdata")) + continue; + endif + if (! strcmp (get (hobj(k), "linestyle"), "none")) + ll = hobj(k); + endif + if (! strcmp (get (hobj(k), "marker"), "none")) + lm = hobj(k); + endif + endfor + + if (! isempty (ll)) + if (!isempty (lm)) + toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(lm,"color"), "linestyle", get(ll,"linestyle"), "marker", get(lm,"marker"), "markeredgecolor", get(lm,"markeredgecolor"), "markerfacecolor", get(lm,"markerfacecolor"), "markersize", get (lm, "markersize"), "displayname", displayname, "parent", kids(i))]; + else + toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(ll,"color"), "linestyle", get(ll,"linestyle"), "marker", "none", "displayname", displayname, "parent", kids(i))]; + endif + elseif (! isempty (lm)) + toberm = [toberm, line("xdata",[0,0],"ydata",[0,0], "color", get(lm,"color"), "linestyle", "none", "marker", get(lm,"marker"), "markeredgecolor", get(lm,"markeredgecolor"), "markerfacecolor", get(lm,"markerfacecolor"), "markersize", get (lm, "markersize"), "displayname", displayname, "parent", kids(i))]; + endif + endfor + if (bg_is_set) + fprintf (plot_stream, "set border linecolor rgb \"#%02x%02x%02x\"\n", 255 * (1 - bg)); + endif + __go_draw_axes__ (kids(i), plot_stream, enhanced, mono, + bg_is_set, false, hlgnd); + unwind_protect_cleanup + ## Return axes "units" and "position" back to + ## their original values. + set (ca, "units", orig_axes_units); + set (kids(i), "units", legend_axes_units, + "box", legend_axes_box, + "ylim", legend_axes_ylim, + "position", legend_axes_position, + "outerposition", legend_axes_outerposition); + delete (toberm); + bg_is_set = false; + end_unwind_protect + endif + else + ## Rely upon listener to convert axes position + ## to "normalized" units. + orig_axes_units = get (kids(i), "units"); + orig_axes_position = get (kids(i), "position"); + unwind_protect + set (kids(i), "units", "normalized"); + fg = get (kids(i), "color"); + if (isnumeric (fg) && strcmp (get (kids(i), "visible"), "on")) + fprintf (plot_stream, "set obj 2 rectangle from graph 0,0 to graph 1,1 behind fc rgb \"#%02x%02x%02x\"\n", 255 * fg); + fg_is_set = true; + else + fg_is_set = false; + endif + if (bg_is_set) + fprintf (plot_stream, "set border linecolor rgb \"#%02x%02x%02x\"\n", 255 * (1 - bg)); + endif + ## Find if this axes has an associated legend axes and pass it + ## to __go_draw_axes__ + hlegend = []; + fkids = get (h, "children"); + for j = 1 : numel(fkids) + if (ishandle (fkids (j)) + && strcmp (get (fkids (j), "type"), "axes") + && (strcmp (get (fkids (j), "tag"), "legend"))) + udata = get (fkids (j), "userdata"); + if (isscalar(udata.handle) + && ! isempty (intersect (udata.handle, kids (i)))) + hlegend = get (fkids (j)); + break; + endif + endif + endfor + __go_draw_axes__ (kids(i), plot_stream, enhanced, mono, + bg_is_set, fg_is_set, hlegend); + unwind_protect_cleanup + ## Return axes "units" and "position" back to + ## their original values. + set (kids(i), "units", orig_axes_units); + set (kids(i), "position", orig_axes_position); + bg_is_set = false; + fg_is_set = false; + end_unwind_protect + endif + case "uimenu" + ## ignore uimenu objects + otherwise + error ("__go_draw_figure__: unknown object class, %s", type); + endswitch + endfor + fputs (plot_stream, "\nunset multiplot;\n"); + else + fputs (plot_stream, "\nreset; clear;\n"); + fflush (plot_stream); + endif + else + error ("__go_draw_figure__: expecting figure object, found `%s'", + htype); + endif + else + print_usage (); + endif + +endfunction + diff --git a/octave_packages/m/plot/private/__interp_cube__.m b/octave_packages/m/plot/private/__interp_cube__.m new file mode 100644 index 0000000..6f319a1 --- /dev/null +++ b/octave_packages/m/plot/private/__interp_cube__.m @@ -0,0 +1,184 @@ +## Copyright (C) 2009-2012 Martin Helm +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Author: Martin Helm + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{vxyz}, @var{idx}, @var{frac}] =} __interp_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{v}) +## Undocumented internal function. +## @end deftypefn + +function [Vxyz, idx, frac] = __interp_cube__(x, y, z, val, v, req = "values" ) + if (ismatrix (x) && ndims (x) == 3 && ismatrix (y) && ndims (y) == 3 ... + && ismatrix (z) && ndims (z) == 3 && size_equal (x, y, z, val)) + x = squeeze (x(1,:,1))(:); + y = squeeze (y(:,1,1))(:); + z = squeeze (z(1,1,:))(:); + elseif (isvector (x) && isvector (y) && isvector (z) ) + x = x(:); + y = y(:); + z = z(:); + else + error("__interp_cube__: X, Y, Z have wrong dimensions"); + endif + if (size (val) != [length(x), length(y), length(z)]) + error ("__interp_cube__: VAL has wrong dimensions"); + endif + if (size (v, 2) != 3) + error ( "v has to be N*3 matrix"); + endif + if (!ischar (req)) + error ("__interp_cube__: Invalid request parameter use 'values', 'normals' or 'normals8'"); + endif + if (isempty (v)) + Vxyz = idx = frac = []; + return + endif + + switch (req) + case "values" + [Vxyz, idx, frac] = interp_cube_trilin (x, y, z, val, v); + case "normals" + [idx, frac] = cube_idx (x, y, z, v); + + dx = x(2:end) - x(1:end-1); + dy = y(2:end) - y(1:end-1); + dz = z(2:end) - z(1:end-1); + dx = 0.5 .* [dx;dx(end)](idx(:,2)); + dy = 0.5 .* [dy;dy(end)](idx(:,1)); + dz = 0.5 .* [dz;dz(end)](idx(:,3)); + + p000 = [v(:, 1) - dx, v(:, 2) - dy, v(:, 3) - dz]; + p100 = [v(:, 1) + dx, v(:, 2) - dy, v(:, 3) - dz]; + p010 = [v(:, 1) - dx, v(:, 2) + dy, v(:, 3) - dz]; + p001 = [v(:, 1) - dx, v(:, 2) - dy, v(:, 3) + dz]; + p011 = [v(:, 1) - dx, v(:, 2) + dy, v(:, 3) + dz]; + p101 = [v(:, 1) + dx, v(:, 2) - dy, v(:, 3) + dz]; + p110 = [v(:, 1) + dx, v(:, 2) + dy, v(:, 3) - dz]; + p111 = [v(:, 1) + dx, v(:, 2) + dy, v(:, 3) + dz]; + + v000 = interp_cube_trilin (x, y, z, val, p000); + v100 = interp_cube_trilin (x, y, z, val, p100); + v010 = interp_cube_trilin (x, y, z, val, p010); + v001 = interp_cube_trilin (x, y, z, val, p001); + v011 = interp_cube_trilin (x, y, z, val, p011); + v101 = interp_cube_trilin (x, y, z, val, p101); + v110 = interp_cube_trilin (x, y, z, val, p110); + v111 = interp_cube_trilin (x, y, z, val, p111); + + Dx = -v000 .+ v100 .- v010 .- v001 .- v011 .+ v101 .+ v110 .+ v111; + Dy = -v000 .- v100 .+ v010 .- v001 .+ v011 .- v101 .+ v110 .+ v111; + Dz = -v000 .- v100 .- v010 .+ v001 .+ v011 .+ v101 .- v110 .+ v111; + Vxyz = 0.5 .* [Dx./dx, Dy./dy, Dz./dz]; + case "normals8" + [idx, frac] = cube_idx (x, y, z, v); + + dx = x(2:end) - x(1:end-1); + dy = y(2:end) - y(1:end-1); + dz = z(2:end) - z(1:end-1); + dx = [dx;dx(end)](idx(:,2)); + dy = [dy;dy(end)](idx(:,1)); + dz = [dz;dz(end)](idx(:,3)); + [Dx, Dy, Dz, idx, frac] = interp_cube_trilin_grad (x, y, z, val, v); + Vxyz = [Dx./dx, Dy./dy, Dz./dz]; + otherwise + error ("__interp_cube__: Invalid request type '%s', use 'values', 'normals' or 'normals8'", req); + endswitch +endfunction + +function [Vxyz, idx, frac] = interp_cube_trilin(x, y, z, val, v) + [idx, frac] = cube_idx (x(:), y(:), z(:), v); + sval = size (val); + i000 = sub2ind (sval, idx(:, 1), idx(:, 2), idx(:, 3)); + i100 = sub2ind (sval, idx(:, 1)+1, idx(:, 2), idx(:, 3)); + i010 = sub2ind (sval, idx(:, 1), idx(:, 2)+1, idx(:, 3)); + i001 = sub2ind (sval, idx(:, 1), idx(:, 2), idx(:, 3)+1); + i101 = sub2ind (sval, idx(:, 1)+1, idx(:, 2), idx(:, 3)+1); + i011 = sub2ind (sval, idx(:, 1), idx(:, 2)+1, idx(:, 3)+1); + i110 = sub2ind (sval, idx(:, 1)+1, idx(:, 2)+1, idx(:, 3)); + i111 = sub2ind (sval, idx(:, 1)+1, idx(:, 2)+1, idx(:, 3)+1 ); + Bx = frac(:, 1); + By = frac(:, 2); + Bz = frac(:, 3); + Vxyz = ... + val( i000 ) .* (1 .- Bx) .* (1 .- By) .* (1 .- Bz) .+ ... + val( i100 ) .* Bx .* (1 .- By) .* (1 .- Bz) .+ ... + val( i010 ) .* (1 .- Bx) .* By .* (1 .- Bz) .+ ... + val( i001 ) .* (1 .- Bx) .* (1 .- By) .* Bz .+ ... + val( i011 ) .* (1 .- Bx) .* By .* Bz .+ ... + val( i101 ) .* Bx .* (1 .- By) .* Bz .+ ... + val( i110 ) .* Bx .* By .* (1 .- Bz) .+ ... + val( i111 ) .* Bx .* By .* Bz; +endfunction + +function [Dx, Dy, Dz, idx, frac] = interp_cube_trilin_grad(x, y, z, val, v) + [idx, frac] = cube_idx (x(:), y(:), z(:), v); + sval = size (val); + i000 = sub2ind (sval, idx(:, 1), idx(:, 2), idx(:, 3)); + i100 = sub2ind (sval, idx(:, 1)+1, idx(:, 2), idx(:, 3)); + i010 = sub2ind (sval, idx(:, 1), idx(:, 2)+1, idx(:, 3)); + i001 = sub2ind (sval, idx(:, 1), idx(:, 2), idx(:, 3)+1); + i101 = sub2ind (sval, idx(:, 1)+1, idx(:, 2), idx(:, 3)+1); + i011 = sub2ind (sval, idx(:, 1), idx(:, 2)+1, idx(:, 3)+1); + i110 = sub2ind (sval, idx(:, 1)+1, idx(:, 2)+1, idx(:, 3)); + i111 = sub2ind (sval, idx(:, 1)+1, idx(:, 2)+1, idx(:, 3)+1 ); + Bx = frac(:, 1); + By = frac(:, 2); + Bz = frac(:, 3); + Dx = ... + val( i000 ) .* -1 .* (1 .- By) .* (1 .- Bz) .+ ... + val( i100 ) .* (1 .- By) .* (1 .- Bz) .+ ... + val( i010 ) .* -1 .* By .* (1 .- Bz) .+ ... + val( i001 ) .* -1 .* (1 .- By) .* Bz .+ ... + val( i011 ) .* -1 .* By .* Bz .+ ... + val( i101 ) .* (1 .- By) .* Bz .+ ... + val( i110 ) .* By .* (1 .- Bz) .+ ... + val( i111 ) .* By .* Bz; + Dy = ... + val( i000 ) .* (1 .- Bx) .* -1 .* (1 .- Bz) .+ ... + val( i100 ) .* Bx .* -1 .* (1 .- Bz) .+ ... + val( i010 ) .* (1 .- Bx) .* (1 .- Bz) .+ ... + val( i001 ) .* (1 .- Bx) .* -1 .* Bz .+ ... + val( i011 ) .* (1 .- Bx) .* Bz .+ ... + val( i101 ) .* Bx .* -1 .* Bz .+ ... + val( i110 ) .* Bx .* (1 .- Bz) .+ ... + val( i111 ) .* Bx .* Bz; + Dz = ... + val( i000 ) .* (1 .- Bx) .* (1 .- By) .* -1 .+ ... + val( i100 ) .* Bx .* (1 .- By) .* -1 .+ ... + val( i010 ) .* (1 .- Bx) .* By .* -1 .+ ... + val( i001 ) .* (1 .- Bx) .* (1 .- By) .+ ... + val( i011 ) .* (1 .- Bx) .* By + ... + val( i101 ) .* Bx .* (1 .- By) .+ ... + val( i110 ) .* Bx .* By .* -1 .+ ... + val( i111 ) .* Bx .* By; +endfunction + +function [idx, frac] = cube_idx(x, y, z, v) + idx = zeros (size (v)); + frac = zeros (size (v)); + idx(:, 2) = lookup (x(2:end-1), v(:, 1)) + 1; + frac(:, 2) = (v(:, 1) - x(idx(:, 2)) )... + ./ (x(idx(:, 2)+1) - x(idx(:, 2))); + idx(:, 1) = lookup (y(2:end-1), v(:, 2)) + 1; + frac(:, 1) = (v(:, 2) - y(idx(:, 1))) ... + ./ (y(idx(:, 1)+1) - y(idx(:, 1))); + idx(:, 3) = lookup (z(2:end-1), v(:, 3)) + 1; + frac(:, 3) = (v(:, 3) - z(idx(:, 3))) ... + ./ (z(idx(:, 3)+1) - z(idx(:, 3))); +endfunction diff --git a/octave_packages/m/plot/private/__is_function__.m b/octave_packages/m/plot/private/__is_function__.m new file mode 100644 index 0000000..7992839 --- /dev/null +++ b/octave_packages/m/plot/private/__is_function__.m @@ -0,0 +1,31 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{result} =} __is_function__ (@var{func}) +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function result = __is_function__ (func) + + existval = exist (func); + result = (existval == 2 || existval == 3 || existval == 5 || existval == 6); + +endfunction diff --git a/octave_packages/m/plot/private/__line__.m b/octave_packages/m/plot/private/__line__.m new file mode 100644 index 0000000..cbe27dc --- /dev/null +++ b/octave_packages/m/plot/private/__line__.m @@ -0,0 +1,121 @@ +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} __line__ (@var{p}, @dots{}) +## Undocumented internal function. +## @end deftypefn + +## __line__ (p, x, y, z) +## Create line object from x, y, and z with parent p. +## Return handle to line object. + +## Author: jwe + +function h = __line__ (p, varargin) + + if (nargin < 1) + print_usage (); + endif + + nvargs = numel (varargin); + + if (nvargs > 1 && isnumeric (varargin{1}) && isnumeric (varargin{2})) + if (nvargs > 2 && isnumeric (varargin{3})) + num_data_args = 3; + else + num_data_args = 2; + endif + else + num_data_args = 0; + endif + + if (num_data_args > 0 && ! size_equal (varargin{1:num_data_args})) + error ("line: number of X, Y, and Z points must be equal"); + endif + + if (rem (nvargs - num_data_args, 2) != 0) + error ("line: invalid number of PROPERTY / VALUE pairs"); + endif + + other_args = {}; + if (nvargs > num_data_args) + other_args = varargin(num_data_args+1:end); + endif + + nlines = 0; + nvecpts = 0; + ismat = false (1, 3); + for i = 1:num_data_args + tmp = varargin{i}(:,:); + if (isvector (tmp)) + nlines = max (1, nlines); + if (! isscalar (tmp)) + if (nvecpts == 0) + nvecpts = numel (tmp); + elseif (nvecpts != numel (tmp)) + error ("line: data size mismatch"); + endif + endif + else + ismat(i) = true; + nlines = max (columns (tmp), nlines); + endif + varargin{i} = tmp; + endfor + + if (num_data_args == 0) + varargin = {[0, 1], [0, 1]}; + num_data_args = 2; + nlines = 1; + endif + + handles = zeros (nlines, 1); + + data = cell (1, 3); + + if (num_data_args > 1) + data(1) = varargin{1}; + data(2) = varargin{2}; + if (num_data_args == 3) + data(3) = varargin{3}; + endif + endif + + data_args = reshape ({"xdata", "ydata", "zdata"; data{:}}, [1, 6]); + mask = reshape ([false(1,3); ismat], [1, 6]); + + for i = 1:nlines + tmp = data(ismat); + if (! size_equal (tmp) + || (nvecpts != 0 && any (nvecpts != cellfun ("size", tmp, 1)))) + error ("line: data size_mismatch"); + endif + + data_args(mask) = cellfun (@(x) x(:,i), data(ismat), + "uniformoutput", false); + + handles(i) = __go_line__ (p, data_args{:}, other_args{:}); + + endfor + + if (nargout > 0) + h = handles; + endif + +endfunction diff --git a/octave_packages/m/plot/private/__marching_cube__.m b/octave_packages/m/plot/private/__marching_cube__.m new file mode 100644 index 0000000..1be93ab --- /dev/null +++ b/octave_packages/m/plot/private/__marching_cube__.m @@ -0,0 +1,530 @@ +## Copyright (C) 2009-2012 Martin Helm +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{t}, @var{p}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}) +## @deftypefnx {Function File} {[@var{t}, @var{p}, @var{c}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}) +## Undocumented internal function. +## @end deftypefn + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{t}, @var{p}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}) +## @deftypefnx {Function File} {[@var{t}, @var{p}, @var{c}] =} __marching_cube__ (@var{x}, @var{y}, @var{z}, @var{val}, @var{iso}, @var{col}) +## +## Return the triangulation information @var{t} at points @var{p} for +## the isosurface values resp. the volume data @var{val} and the iso +## level @var{iso}. It is considered that the volume data @var{val} is +## given at the points @var{x}, @var{y} and @var{z} which are of type +## three--dimensional numeric arrays. The orientation of the triangles +## is choosen such that the normals point from the higher values to the +## lower values. +## +## Optionally the color data @var{col} can be passed to this function +## whereas computed vertices color data @var{c} is returned as third +## argument. +## +## The marching cube algorithm is well known and described, for example, at +## Wikipedia. The triangulation lookup table and the edge table used +## here are based on Cory Gene Bloyd's implementation and can be found +## beyond other surface and geometry stuff at Paul Bourke's website +## @uref{http://local.wasp.uwa.edu.au/~pbourke/geometry/polygonise}. +## +## For example: +## +## @example +## @group +## N = 20; +## lin = linspace (0, 2, N); +## [x, y, z] = meshgrid (lin, lin, lin); +## +## c = (x-.5).^2 + (y-.5).^2 + (z-.5).^2; +## [t, p] = __marching_cube__ (x, y, z, c, .5); +## +## figure (); +## trimesh (t, p(:,1), p(:,2), p(:,3)); +## @end group +## @end example +## +## Instead of the @command{trimesh} function the @command{patch} +## function can be used to visualize the geometry. For example: +## +## @example +## @group +## figure (); view (-38, 20); +## pa = patch ("Faces", t, "Vertices", p, "FaceVertexCData", p, \ +## "FaceColor", "interp", "EdgeColor", "none"); +## +## ## Revert normals +## set (pa, "VertexNormals", -get (pa, "VertexNormals")); +## +## ## Set lightning (available with the JHandles package) +## # set (pa, "FaceLighting", "gouraud"); +## # light ( "Position", [1 1 5]); +## @end group +## @end example +## +## @end deftypefn + +## Author: Martin Helm + +function [T, p, col] = __marching_cube__ (xx, yy, zz, c, iso, colors) + + persistent edge_table=[]; + persistent tri_table=[]; + + calc_cols = false; + lindex = 4; + + if (isempty (tri_table) || isempty (edge_table)) + [edge_table, tri_table] = init_mc (); + endif + + if ((nargin != 5 && nargin != 6) || (nargout != 2 && nargout != 3)) + print_usage (); + endif + + if (!ismatrix (xx) || !ismatrix (yy) || !ismatrix (zz) || !ismatrix (c) || ... + ndims (xx) != 3 || ndims (yy) != 3 || ndims (zz) != 3 || ndims (c) != 3) + error ("__marching_cube__: XX, YY, ZZ, C must be matrices of dim 3"); + endif + + if (!size_equal (xx, yy, zz, c)) + error ("__marching_cube__: XX, YY, ZZ, C must be of equal size"); + endif + + if (any (size (xx) < [2 2 2])) + error ("__marching_cube__: grid size must be at least 2x2x2"); + endif + + if (!isscalar (iso)) + error ("__marching_cube__: ISO must be scalar value"); + endif + + if (nargin == 6) + if ( !ismatrix (colors) || ndims (colors) != 3 || size (colors) != size (c) ) + error ( "COLORS must be a matrix of dim 3 and of same size as C" ); + endif + calc_cols = true; + lindex = 5; + endif + + n = size (c) - 1; + + ## phase I: assign information to each voxel which edges are intersected by + ## the isosurface + cc = zeros (n(1), n(2), n(3), "uint16"); + cedge = zeros (size (cc), "uint16"); + + vertex_idx = {1:n(1), 1:n(2), 1:n(3); ... + 2:n(1)+1, 1:n(2), 1:n(3); ... + 2:n(1)+1, 2:n(2)+1, 1:n(3); ... + 1:n(1), 2:n(2)+1, 1:n(3); ... + 1:n(1), 1:n(2), 2:n(3)+1; ... + 2:n(1)+1, 1:n(2), 2:n(3)+1; ... + 2:n(1)+1, 2:n(2)+1, 2:n(3)+1; ... + 1:n(1), 2:n(2)+1, 2:n(3)+1 }; + + ## calculate which vertices have values higher than iso + for ii=1:8 + idx = c(vertex_idx{ii, :}) > iso; + cc(idx) = bitset (cc(idx), ii); + endfor + + cedge = edge_table(cc+1); # assign the info about intersected edges + id = find (cedge); # select only voxels which are intersected + if (isempty (id)) + T = p = col = []; + return + endif + + ## phase II: calculate the list of intersection points + xyz_off = [1, 1, 1; 2, 1, 1; 2, 2, 1; 1, 2, 1; 1, 1, 2; 2, 1, 2; 2, 2, 2; 1, 2, 2]; + edges = [1 2; 2 3; 3 4; 4 1; 5 6; 6 7; 7 8; 8 5; 1 5; 2 6; 3 7; 4 8]; + offset = sub2ind (size (c), xyz_off(:, 1), xyz_off(:, 2), xyz_off(:, 3)) -1; + pp = zeros (length (id), lindex, 12); + ccedge = [vec(cedge(id)), id]; + ix_offset=0; + for jj=1:12 + id__ = bitget (ccedge(:, 1), jj); + id_ = ccedge(id__, 2); + [ix iy iz] = ind2sub (size (cc), id_); + id_c = sub2ind (size (c), ix, iy, iz); + id1 = id_c + offset(edges(jj, 1)); + id2 = id_c + offset(edges(jj, 2)); + if (calc_cols) + pp(id__, 1:5, jj) = [vertex_interp(iso, xx(id1), yy(id1), zz(id1), ... + xx(id2), yy(id2), zz(id2), c(id1), c(id2), colors(id1), colors(id2)), ... + (1:size (id_, 1))' + ix_offset ]; + else + pp(id__, 1:4, jj) = [vertex_interp(iso, xx(id1), yy(id1), zz(id1), ... + xx(id2), yy(id2), zz(id2), c(id1), c(id2)), ... + (1:size (id_, 1))' + ix_offset ]; + endif + ix_offset += size (id_, 1); + endfor + + ## phase III: calculate the triangulation from the point list + T = []; + tri = tri_table(cc(id)+1, :); + for jj=1:3:15 + id_ = find (tri(:, jj)>0); + p = [id_, lindex*ones(size (id_, 1), 1),tri(id_, jj:jj+2)]; + if (!isempty (p)) + p1 = sub2ind (size (pp), p(:,1), p(:,2), p(:,3)); + p2 = sub2ind (size (pp), p(:,1), p(:,2), p(:,4)); + p3 = sub2ind (size (pp), p(:,1), p(:,2), p(:,5)); + T = [T; pp(p1), pp(p2), pp(p3)]; + endif + endfor + + p = []; + col = []; + for jj = 1:12 + idp = pp(:, lindex, jj) > 0; + if (any (idp)) + p(pp(idp, lindex, jj), 1:3) = pp(idp, 1:3, jj); + if (calc_cols) + col(pp(idp, lindex, jj),1) = pp(idp, 4, jj); + endif + endif + endfor +endfunction + +function p = vertex_interp(isolevel,p1x, p1y, p1z,... + p2x, p2y, p2z,valp1,valp2, col1, col2) + + if (nargin == 9) + p = zeros (length (p1x), 3); + elseif (nargin == 11) + p = zeros (length (p1x), 4); + else + error ("__marching_cube__: wrong number of arguments"); + endif + mu = zeros (length (p1x), 1); + id = abs (valp1-valp2) < (10*eps) .* (abs (valp1) .+ abs (valp2)); + if (any (id)) + p(id, 1:3) = [ p1x(id), p1y(id), p1z(id) ]; + if (nargin == 11) + p(id, 4) = col1(id); + endif + endif + nid = !id; + if (any (nid)) + mu(nid) = (isolevel - valp1(nid)) ./ (valp2(nid) - valp1(nid)); + p(nid, 1:3) = [p1x(nid) + mu(nid) .* (p2x(nid) - p1x(nid)), ... + p1y(nid) + mu(nid) .* (p2y(nid) - p1y(nid)), ... + p1z(nid) + mu(nid) .* (p2z(nid) - p1z(nid))]; + if (nargin == 11) + p(nid, 4) = col1(nid) + mu(nid) .* (col2(nid) - col1(nid)); + endif + endif +endfunction + +function [edge_table, tri_table] = init_mc() + edge_table = [ + 0x0 , 0x109, 0x203, 0x30a, 0x406, 0x50f, 0x605, 0x70c, ... + 0x80c, 0x905, 0xa0f, 0xb06, 0xc0a, 0xd03, 0xe09, 0xf00, ... + 0x190, 0x99 , 0x393, 0x29a, 0x596, 0x49f, 0x795, 0x69c, ... + 0x99c, 0x895, 0xb9f, 0xa96, 0xd9a, 0xc93, 0xf99, 0xe90, ... + 0x230, 0x339, 0x33 , 0x13a, 0x636, 0x73f, 0x435, 0x53c, ... + 0xa3c, 0xb35, 0x83f, 0x936, 0xe3a, 0xf33, 0xc39, 0xd30, ... + 0x3a0, 0x2a9, 0x1a3, 0xaa , 0x7a6, 0x6af, 0x5a5, 0x4ac, ... + 0xbac, 0xaa5, 0x9af, 0x8a6, 0xfaa, 0xea3, 0xda9, 0xca0, ... + 0x460, 0x569, 0x663, 0x76a, 0x66 , 0x16f, 0x265, 0x36c, ... + 0xc6c, 0xd65, 0xe6f, 0xf66, 0x86a, 0x963, 0xa69, 0xb60, ... + 0x5f0, 0x4f9, 0x7f3, 0x6fa, 0x1f6, 0xff , 0x3f5, 0x2fc, ... + 0xdfc, 0xcf5, 0xfff, 0xef6, 0x9fa, 0x8f3, 0xbf9, 0xaf0, ... + 0x650, 0x759, 0x453, 0x55a, 0x256, 0x35f, 0x55 , 0x15c, ... + 0xe5c, 0xf55, 0xc5f, 0xd56, 0xa5a, 0xb53, 0x859, 0x950, ... + 0x7c0, 0x6c9, 0x5c3, 0x4ca, 0x3c6, 0x2cf, 0x1c5, 0xcc , ... + 0xfcc, 0xec5, 0xdcf, 0xcc6, 0xbca, 0xac3, 0x9c9, 0x8c0, ... + 0x8c0, 0x9c9, 0xac3, 0xbca, 0xcc6, 0xdcf, 0xec5, 0xfcc, ... + 0xcc , 0x1c5, 0x2cf, 0x3c6, 0x4ca, 0x5c3, 0x6c9, 0x7c0, ... + 0x950, 0x859, 0xb53, 0xa5a, 0xd56, 0xc5f, 0xf55, 0xe5c, ... + 0x15c, 0x55 , 0x35f, 0x256, 0x55a, 0x453, 0x759, 0x650, ... + 0xaf0, 0xbf9, 0x8f3, 0x9fa, 0xef6, 0xfff, 0xcf5, 0xdfc, ... + 0x2fc, 0x3f5, 0xff , 0x1f6, 0x6fa, 0x7f3, 0x4f9, 0x5f0, ... + 0xb60, 0xa69, 0x963, 0x86a, 0xf66, 0xe6f, 0xd65, 0xc6c, ... + 0x36c, 0x265, 0x16f, 0x66 , 0x76a, 0x663, 0x569, 0x460, ... + 0xca0, 0xda9, 0xea3, 0xfaa, 0x8a6, 0x9af, 0xaa5, 0xbac, ... + 0x4ac, 0x5a5, 0x6af, 0x7a6, 0xaa , 0x1a3, 0x2a9, 0x3a0, ... + 0xd30, 0xc39, 0xf33, 0xe3a, 0x936, 0x83f, 0xb35, 0xa3c, ... + 0x53c, 0x435, 0x73f, 0x636, 0x13a, 0x33 , 0x339, 0x230, ... + 0xe90, 0xf99, 0xc93, 0xd9a, 0xa96, 0xb9f, 0x895, 0x99c, ... + 0x69c, 0x795, 0x49f, 0x596, 0x29a, 0x393, 0x99 , 0x190, ... + 0xf00, 0xe09, 0xd03, 0xc0a, 0xb06, 0xa0f, 0x905, 0x80c, ... + 0x70c, 0x605, 0x50f, 0x406, 0x30a, 0x203, 0x109, 0x0 ]; + + tri_table =[ + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 8, 3, 9, 8, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 1, 2, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 2, 10, 0, 2, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 8, 3, 2, 10, 8, 10, 9, 8, -1, -1, -1, -1, -1, -1, -1; + 3, 11, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 11, 2, 8, 11, 0, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 9, 0, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 11, 2, 1, 9, 11, 9, 8, 11, -1, -1, -1, -1, -1, -1, -1; + 3, 10, 1, 11, 10, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 10, 1, 0, 8, 10, 8, 11, 10, -1, -1, -1, -1, -1, -1, -1; + 3, 9, 0, 3, 11, 9, 11, 10, 9, -1, -1, -1, -1, -1, -1, -1; + 9, 8, 10, 10, 8, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 7, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 3, 0, 7, 3, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 9, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 1, 9, 4, 7, 1, 7, 3, 1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 4, 7, 3, 0, 4, 1, 2, 10, -1, -1, -1, -1, -1, -1, -1; + 9, 2, 10, 9, 0, 2, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1; + 2, 10, 9, 2, 9, 7, 2, 7, 3, 7, 9, 4, -1, -1, -1, -1; + 8, 4, 7, 3, 11, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 11, 4, 7, 11, 2, 4, 2, 0, 4, -1, -1, -1, -1, -1, -1, -1; + 9, 0, 1, 8, 4, 7, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1; + 4, 7, 11, 9, 4, 11, 9, 11, 2, 9, 2, 1, -1, -1, -1, -1; + 3, 10, 1, 3, 11, 10, 7, 8, 4, -1, -1, -1, -1, -1, -1, -1; + 1, 11, 10, 1, 4, 11, 1, 0, 4, 7, 11, 4, -1, -1, -1, -1; + 4, 7, 8, 9, 0, 11, 9, 11, 10, 11, 0, 3, -1, -1, -1, -1; + 4, 7, 11, 4, 11, 9, 9, 11, 10, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 4, 0, 8, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 5, 4, 1, 5, 0, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 8, 5, 4, 8, 3, 5, 3, 1, 5, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 9, 5, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 8, 1, 2, 10, 4, 9, 5, -1, -1, -1, -1, -1, -1, -1; + 5, 2, 10, 5, 4, 2, 4, 0, 2, -1, -1, -1, -1, -1, -1, -1; + 2, 10, 5, 3, 2, 5, 3, 5, 4, 3, 4, 8, -1, -1, -1, -1; + 9, 5, 4, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 11, 2, 0, 8, 11, 4, 9, 5, -1, -1, -1, -1, -1, -1, -1; + 0, 5, 4, 0, 1, 5, 2, 3, 11, -1, -1, -1, -1, -1, -1, -1; + 2, 1, 5, 2, 5, 8, 2, 8, 11, 4, 8, 5, -1, -1, -1, -1; + 10, 3, 11, 10, 1, 3, 9, 5, 4, -1, -1, -1, -1, -1, -1, -1; + 4, 9, 5, 0, 8, 1, 8, 10, 1, 8, 11, 10, -1, -1, -1, -1; + 5, 4, 0, 5, 0, 11, 5, 11, 10, 11, 0, 3, -1, -1, -1, -1; + 5, 4, 8, 5, 8, 10, 10, 8, 11, -1, -1, -1, -1, -1, -1, -1; + 9, 7, 8, 5, 7, 9, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 3, 0, 9, 5, 3, 5, 7, 3, -1, -1, -1, -1, -1, -1, -1; + 0, 7, 8, 0, 1, 7, 1, 5, 7, -1, -1, -1, -1, -1, -1, -1; + 1, 5, 3, 3, 5, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 7, 8, 9, 5, 7, 10, 1, 2, -1, -1, -1, -1, -1, -1, -1; + 10, 1, 2, 9, 5, 0, 5, 3, 0, 5, 7, 3, -1, -1, -1, -1; + 8, 0, 2, 8, 2, 5, 8, 5, 7, 10, 5, 2, -1, -1, -1, -1; + 2, 10, 5, 2, 5, 3, 3, 5, 7, -1, -1, -1, -1, -1, -1, -1; + 7, 9, 5, 7, 8, 9, 3, 11, 2, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 7, 9, 7, 2, 9, 2, 0, 2, 7, 11, -1, -1, -1, -1; + 2, 3, 11, 0, 1, 8, 1, 7, 8, 1, 5, 7, -1, -1, -1, -1; + 11, 2, 1, 11, 1, 7, 7, 1, 5, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 8, 8, 5, 7, 10, 1, 3, 10, 3, 11, -1, -1, -1, -1; + 5, 7, 0, 5, 0, 9, 7, 11, 0, 1, 0, 10, 11, 10, 0, -1; + 11, 10, 0, 11, 0, 3, 10, 5, 0, 8, 0, 7, 5, 7, 0, -1; + 11, 10, 5, 7, 11, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 10, 6, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 0, 1, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 8, 3, 1, 9, 8, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1; + 1, 6, 5, 2, 6, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 6, 5, 1, 2, 6, 3, 0, 8, -1, -1, -1, -1, -1, -1, -1; + 9, 6, 5, 9, 0, 6, 0, 2, 6, -1, -1, -1, -1, -1, -1, -1; + 5, 9, 8, 5, 8, 2, 5, 2, 6, 3, 2, 8, -1, -1, -1, -1; + 2, 3, 11, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 11, 0, 8, 11, 2, 0, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 9, 2, 3, 11, 5, 10, 6, -1, -1, -1, -1, -1, -1, -1; + 5, 10, 6, 1, 9, 2, 9, 11, 2, 9, 8, 11, -1, -1, -1, -1; + 6, 3, 11, 6, 5, 3, 5, 1, 3, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 11, 0, 11, 5, 0, 5, 1, 5, 11, 6, -1, -1, -1, -1; + 3, 11, 6, 0, 3, 6, 0, 6, 5, 0, 5, 9, -1, -1, -1, -1; + 6, 5, 9, 6, 9, 11, 11, 9, 8, -1, -1, -1, -1, -1, -1, -1; + 5, 10, 6, 4, 7, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 3, 0, 4, 7, 3, 6, 5, 10, -1, -1, -1, -1, -1, -1, -1; + 1, 9, 0, 5, 10, 6, 8, 4, 7, -1, -1, -1, -1, -1, -1, -1; + 10, 6, 5, 1, 9, 7, 1, 7, 3, 7, 9, 4, -1, -1, -1, -1; + 6, 1, 2, 6, 5, 1, 4, 7, 8, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 5, 5, 2, 6, 3, 0, 4, 3, 4, 7, -1, -1, -1, -1; + 8, 4, 7, 9, 0, 5, 0, 6, 5, 0, 2, 6, -1, -1, -1, -1; + 7, 3, 9, 7, 9, 4, 3, 2, 9, 5, 9, 6, 2, 6, 9, -1; + 3, 11, 2, 7, 8, 4, 10, 6, 5, -1, -1, -1, -1, -1, -1, -1; + 5, 10, 6, 4, 7, 2, 4, 2, 0, 2, 7, 11, -1, -1, -1, -1; + 0, 1, 9, 4, 7, 8, 2, 3, 11, 5, 10, 6, -1, -1, -1, -1; + 9, 2, 1, 9, 11, 2, 9, 4, 11, 7, 11, 4, 5, 10, 6, -1; + 8, 4, 7, 3, 11, 5, 3, 5, 1, 5, 11, 6, -1, -1, -1, -1; + 5, 1, 11, 5, 11, 6, 1, 0, 11, 7, 11, 4, 0, 4, 11, -1; + 0, 5, 9, 0, 6, 5, 0, 3, 6, 11, 6, 3, 8, 4, 7, -1; + 6, 5, 9, 6, 9, 11, 4, 7, 9, 7, 11, 9, -1, -1, -1, -1; + 10, 4, 9, 6, 4, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 10, 6, 4, 9, 10, 0, 8, 3, -1, -1, -1, -1, -1, -1, -1; + 10, 0, 1, 10, 6, 0, 6, 4, 0, -1, -1, -1, -1, -1, -1, -1; + 8, 3, 1, 8, 1, 6, 8, 6, 4, 6, 1, 10, -1, -1, -1, -1; + 1, 4, 9, 1, 2, 4, 2, 6, 4, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 8, 1, 2, 9, 2, 4, 9, 2, 6, 4, -1, -1, -1, -1; + 0, 2, 4, 4, 2, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 8, 3, 2, 8, 2, 4, 4, 2, 6, -1, -1, -1, -1, -1, -1, -1; + 10, 4, 9, 10, 6, 4, 11, 2, 3, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 2, 2, 8, 11, 4, 9, 10, 4, 10, 6, -1, -1, -1, -1; + 3, 11, 2, 0, 1, 6, 0, 6, 4, 6, 1, 10, -1, -1, -1, -1; + 6, 4, 1, 6, 1, 10, 4, 8, 1, 2, 1, 11, 8, 11, 1, -1; + 9, 6, 4, 9, 3, 6, 9, 1, 3, 11, 6, 3, -1, -1, -1, -1; + 8, 11, 1, 8, 1, 0, 11, 6, 1, 9, 1, 4, 6, 4, 1, -1; + 3, 11, 6, 3, 6, 0, 0, 6, 4, -1, -1, -1, -1, -1, -1, -1; + 6, 4, 8, 11, 6, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 7, 10, 6, 7, 8, 10, 8, 9, 10, -1, -1, -1, -1, -1, -1, -1; + 0, 7, 3, 0, 10, 7, 0, 9, 10, 6, 7, 10, -1, -1, -1, -1; + 10, 6, 7, 1, 10, 7, 1, 7, 8, 1, 8, 0, -1, -1, -1, -1; + 10, 6, 7, 10, 7, 1, 1, 7, 3, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 6, 1, 6, 8, 1, 8, 9, 8, 6, 7, -1, -1, -1, -1; + 2, 6, 9, 2, 9, 1, 6, 7, 9, 0, 9, 3, 7, 3, 9, -1; + 7, 8, 0, 7, 0, 6, 6, 0, 2, -1, -1, -1, -1, -1, -1, -1; + 7, 3, 2, 6, 7, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 3, 11, 10, 6, 8, 10, 8, 9, 8, 6, 7, -1, -1, -1, -1; + 2, 0, 7, 2, 7, 11, 0, 9, 7, 6, 7, 10, 9, 10, 7, -1; + 1, 8, 0, 1, 7, 8, 1, 10, 7, 6, 7, 10, 2, 3, 11, -1; + 11, 2, 1, 11, 1, 7, 10, 6, 1, 6, 7, 1, -1, -1, -1, -1; + 8, 9, 6, 8, 6, 7, 9, 1, 6, 11, 6, 3, 1, 3, 6, -1; + 0, 9, 1, 11, 6, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 7, 8, 0, 7, 0, 6, 3, 11, 0, 11, 6, 0, -1, -1, -1, -1; + 7, 11, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 7, 6, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 8, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 9, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 8, 1, 9, 8, 3, 1, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1; + 10, 1, 2, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 3, 0, 8, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1; + 2, 9, 0, 2, 10, 9, 6, 11, 7, -1, -1, -1, -1, -1, -1, -1; + 6, 11, 7, 2, 10, 3, 10, 8, 3, 10, 9, 8, -1, -1, -1, -1; + 7, 2, 3, 6, 2, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 7, 0, 8, 7, 6, 0, 6, 2, 0, -1, -1, -1, -1, -1, -1, -1; + 2, 7, 6, 2, 3, 7, 0, 1, 9, -1, -1, -1, -1, -1, -1, -1; + 1, 6, 2, 1, 8, 6, 1, 9, 8, 8, 7, 6, -1, -1, -1, -1; + 10, 7, 6, 10, 1, 7, 1, 3, 7, -1, -1, -1, -1, -1, -1, -1; + 10, 7, 6, 1, 7, 10, 1, 8, 7, 1, 0, 8, -1, -1, -1, -1; + 0, 3, 7, 0, 7, 10, 0, 10, 9, 6, 10, 7, -1, -1, -1, -1; + 7, 6, 10, 7, 10, 8, 8, 10, 9, -1, -1, -1, -1, -1, -1, -1; + 6, 8, 4, 11, 8, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 6, 11, 3, 0, 6, 0, 4, 6, -1, -1, -1, -1, -1, -1, -1; + 8, 6, 11, 8, 4, 6, 9, 0, 1, -1, -1, -1, -1, -1, -1, -1; + 9, 4, 6, 9, 6, 3, 9, 3, 1, 11, 3, 6, -1, -1, -1, -1; + 6, 8, 4, 6, 11, 8, 2, 10, 1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 3, 0, 11, 0, 6, 11, 0, 4, 6, -1, -1, -1, -1; + 4, 11, 8, 4, 6, 11, 0, 2, 9, 2, 10, 9, -1, -1, -1, -1; + 10, 9, 3, 10, 3, 2, 9, 4, 3, 11, 3, 6, 4, 6, 3, -1; + 8, 2, 3, 8, 4, 2, 4, 6, 2, -1, -1, -1, -1, -1, -1, -1; + 0, 4, 2, 4, 6, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 9, 0, 2, 3, 4, 2, 4, 6, 4, 3, 8, -1, -1, -1, -1; + 1, 9, 4, 1, 4, 2, 2, 4, 6, -1, -1, -1, -1, -1, -1, -1; + 8, 1, 3, 8, 6, 1, 8, 4, 6, 6, 10, 1, -1, -1, -1, -1; + 10, 1, 0, 10, 0, 6, 6, 0, 4, -1, -1, -1, -1, -1, -1, -1; + 4, 6, 3, 4, 3, 8, 6, 10, 3, 0, 3, 9, 10, 9, 3, -1; + 10, 9, 4, 6, 10, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 9, 5, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 4, 9, 5, 11, 7, 6, -1, -1, -1, -1, -1, -1, -1; + 5, 0, 1, 5, 4, 0, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1; + 11, 7, 6, 8, 3, 4, 3, 5, 4, 3, 1, 5, -1, -1, -1, -1; + 9, 5, 4, 10, 1, 2, 7, 6, 11, -1, -1, -1, -1, -1, -1, -1; + 6, 11, 7, 1, 2, 10, 0, 8, 3, 4, 9, 5, -1, -1, -1, -1; + 7, 6, 11, 5, 4, 10, 4, 2, 10, 4, 0, 2, -1, -1, -1, -1; + 3, 4, 8, 3, 5, 4, 3, 2, 5, 10, 5, 2, 11, 7, 6, -1; + 7, 2, 3, 7, 6, 2, 5, 4, 9, -1, -1, -1, -1, -1, -1, -1; + 9, 5, 4, 0, 8, 6, 0, 6, 2, 6, 8, 7, -1, -1, -1, -1; + 3, 6, 2, 3, 7, 6, 1, 5, 0, 5, 4, 0, -1, -1, -1, -1; + 6, 2, 8, 6, 8, 7, 2, 1, 8, 4, 8, 5, 1, 5, 8, -1; + 9, 5, 4, 10, 1, 6, 1, 7, 6, 1, 3, 7, -1, -1, -1, -1; + 1, 6, 10, 1, 7, 6, 1, 0, 7, 8, 7, 0, 9, 5, 4, -1; + 4, 0, 10, 4, 10, 5, 0, 3, 10, 6, 10, 7, 3, 7, 10, -1; + 7, 6, 10, 7, 10, 8, 5, 4, 10, 4, 8, 10, -1, -1, -1, -1; + 6, 9, 5, 6, 11, 9, 11, 8, 9, -1, -1, -1, -1, -1, -1, -1; + 3, 6, 11, 0, 6, 3, 0, 5, 6, 0, 9, 5, -1, -1, -1, -1; + 0, 11, 8, 0, 5, 11, 0, 1, 5, 5, 6, 11, -1, -1, -1, -1; + 6, 11, 3, 6, 3, 5, 5, 3, 1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 10, 9, 5, 11, 9, 11, 8, 11, 5, 6, -1, -1, -1, -1; + 0, 11, 3, 0, 6, 11, 0, 9, 6, 5, 6, 9, 1, 2, 10, -1; + 11, 8, 5, 11, 5, 6, 8, 0, 5, 10, 5, 2, 0, 2, 5, -1; + 6, 11, 3, 6, 3, 5, 2, 10, 3, 10, 5, 3, -1, -1, -1, -1; + 5, 8, 9, 5, 2, 8, 5, 6, 2, 3, 8, 2, -1, -1, -1, -1; + 9, 5, 6, 9, 6, 0, 0, 6, 2, -1, -1, -1, -1, -1, -1, -1; + 1, 5, 8, 1, 8, 0, 5, 6, 8, 3, 8, 2, 6, 2, 8, -1; + 1, 5, 6, 2, 1, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 3, 6, 1, 6, 10, 3, 8, 6, 5, 6, 9, 8, 9, 6, -1; + 10, 1, 0, 10, 0, 6, 9, 5, 0, 5, 6, 0, -1, -1, -1, -1; + 0, 3, 8, 5, 6, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 10, 5, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 11, 5, 10, 7, 5, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 11, 5, 10, 11, 7, 5, 8, 3, 0, -1, -1, -1, -1, -1, -1, -1; + 5, 11, 7, 5, 10, 11, 1, 9, 0, -1, -1, -1, -1, -1, -1, -1; + 10, 7, 5, 10, 11, 7, 9, 8, 1, 8, 3, 1, -1, -1, -1, -1; + 11, 1, 2, 11, 7, 1, 7, 5, 1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 1, 2, 7, 1, 7, 5, 7, 2, 11, -1, -1, -1, -1; + 9, 7, 5, 9, 2, 7, 9, 0, 2, 2, 11, 7, -1, -1, -1, -1; + 7, 5, 2, 7, 2, 11, 5, 9, 2, 3, 2, 8, 9, 8, 2, -1; + 2, 5, 10, 2, 3, 5, 3, 7, 5, -1, -1, -1, -1, -1, -1, -1; + 8, 2, 0, 8, 5, 2, 8, 7, 5, 10, 2, 5, -1, -1, -1, -1; + 9, 0, 1, 5, 10, 3, 5, 3, 7, 3, 10, 2, -1, -1, -1, -1; + 9, 8, 2, 9, 2, 1, 8, 7, 2, 10, 2, 5, 7, 5, 2, -1; + 1, 3, 5, 3, 7, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 7, 0, 7, 1, 1, 7, 5, -1, -1, -1, -1, -1, -1, -1; + 9, 0, 3, 9, 3, 5, 5, 3, 7, -1, -1, -1, -1, -1, -1, -1; + 9, 8, 7, 5, 9, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 5, 8, 4, 5, 10, 8, 10, 11, 8, -1, -1, -1, -1, -1, -1, -1; + 5, 0, 4, 5, 11, 0, 5, 10, 11, 11, 3, 0, -1, -1, -1, -1; + 0, 1, 9, 8, 4, 10, 8, 10, 11, 10, 4, 5, -1, -1, -1, -1; + 10, 11, 4, 10, 4, 5, 11, 3, 4, 9, 4, 1, 3, 1, 4, -1; + 2, 5, 1, 2, 8, 5, 2, 11, 8, 4, 5, 8, -1, -1, -1, -1; + 0, 4, 11, 0, 11, 3, 4, 5, 11, 2, 11, 1, 5, 1, 11, -1; + 0, 2, 5, 0, 5, 9, 2, 11, 5, 4, 5, 8, 11, 8, 5, -1; + 9, 4, 5, 2, 11, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 5, 10, 3, 5, 2, 3, 4, 5, 3, 8, 4, -1, -1, -1, -1; + 5, 10, 2, 5, 2, 4, 4, 2, 0, -1, -1, -1, -1, -1, -1, -1; + 3, 10, 2, 3, 5, 10, 3, 8, 5, 4, 5, 8, 0, 1, 9, -1; + 5, 10, 2, 5, 2, 4, 1, 9, 2, 9, 4, 2, -1, -1, -1, -1; + 8, 4, 5, 8, 5, 3, 3, 5, 1, -1, -1, -1, -1, -1, -1, -1; + 0, 4, 5, 1, 0, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 8, 4, 5, 8, 5, 3, 9, 0, 5, 0, 3, 5, -1, -1, -1, -1; + 9, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 11, 7, 4, 9, 11, 9, 10, 11, -1, -1, -1, -1, -1, -1, -1; + 0, 8, 3, 4, 9, 7, 9, 11, 7, 9, 10, 11, -1, -1, -1, -1; + 1, 10, 11, 1, 11, 4, 1, 4, 0, 7, 4, 11, -1, -1, -1, -1; + 3, 1, 4, 3, 4, 8, 1, 10, 4, 7, 4, 11, 10, 11, 4, -1; + 4, 11, 7, 9, 11, 4, 9, 2, 11, 9, 1, 2, -1, -1, -1, -1; + 9, 7, 4, 9, 11, 7, 9, 1, 11, 2, 11, 1, 0, 8, 3, -1; + 11, 7, 4, 11, 4, 2, 2, 4, 0, -1, -1, -1, -1, -1, -1, -1; + 11, 7, 4, 11, 4, 2, 8, 3, 4, 3, 2, 4, -1, -1, -1, -1; + 2, 9, 10, 2, 7, 9, 2, 3, 7, 7, 4, 9, -1, -1, -1, -1; + 9, 10, 7, 9, 7, 4, 10, 2, 7, 8, 7, 0, 2, 0, 7, -1; + 3, 7, 10, 3, 10, 2, 7, 4, 10, 1, 10, 0, 4, 0, 10, -1; + 1, 10, 2, 8, 7, 4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 9, 1, 4, 1, 7, 7, 1, 3, -1, -1, -1, -1, -1, -1, -1; + 4, 9, 1, 4, 1, 7, 0, 8, 1, 8, 7, 1, -1, -1, -1, -1; + 4, 0, 3, 7, 4, 3, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 4, 8, 7, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 9, 10, 8, 10, 11, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 9, 3, 9, 11, 11, 9, 10, -1, -1, -1, -1, -1, -1, -1; + 0, 1, 10, 0, 10, 8, 8, 10, 11, -1, -1, -1, -1, -1, -1, -1; + 3, 1, 10, 11, 3, 10, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 2, 11, 1, 11, 9, 9, 11, 8, -1, -1, -1, -1, -1, -1, -1; + 3, 0, 9, 3, 9, 11, 1, 2, 9, 2, 11, 9, -1, -1, -1, -1; + 0, 2, 11, 8, 0, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 3, 2, 11, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 3, 8, 2, 8, 10, 10, 8, 9, -1, -1, -1, -1, -1, -1, -1; + 9, 10, 2, 0, 9, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 2, 3, 8, 2, 8, 10, 0, 1, 8, 1, 10, 8, -1, -1, -1, -1; + 1, 10, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 1, 3, 8, 9, 1, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 9, 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + 0, 3, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1; + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1 ] + 1; +endfunction diff --git a/octave_packages/m/plot/private/__next_line_color__.m b/octave_packages/m/plot/private/__next_line_color__.m new file mode 100644 index 0000000..773d39e --- /dev/null +++ b/octave_packages/m/plot/private/__next_line_color__.m @@ -0,0 +1,54 @@ +## Copyright (C) 2007-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{rgb} =} __next_line_color__ (@var{reset}) +## Undocumented internal function. +## @end deftypefn + +## Return the next line color in the rotation. + +## Author: jwe + +function rgb = __next_line_color__ (reset) + + persistent color_rotation; + persistent num_colors; + persistent color_index; + + if (nargin < 2) + if (nargin == 1) + if (reset || isempty (color_rotation)) + color_rotation = get (gca (), "colororder"); + num_colors = rows (color_rotation); + color_index = 1; + endif + elseif (! isempty (color_rotation)) + rgb = color_rotation(color_index,:); + if (++color_index > num_colors) + color_index = 1; + __next_line_style__ ("incr"); + endif + else + error ("__next_line_color__: color_rotation not initialized"); + endif + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/plot/private/__next_line_style__.m b/octave_packages/m/plot/private/__next_line_style__.m new file mode 100644 index 0000000..db078d0 --- /dev/null +++ b/octave_packages/m/plot/private/__next_line_style__.m @@ -0,0 +1,61 @@ +## Copyright (C) 2010-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{style} =} __next_line_style__ (@var{reset}) +## Undocumented internal function. +## @end deftypefn + +## Return the next line style in the rotation. + + +function [linestyle, marker] = __next_line_style__ (reset) + + persistent style_rotation; + persistent num_styles; + persistent style_index; + + if (nargin < 2) + if (nargin == 1) + if (ischar (reset) && strncmp (reset, "incr", 4)) + if (isempty (style_rotation)) + error ("__next_line_style__: style_rotation not initialized"); + elseif (++style_index > num_styles) + style_index = 1; + endif + elseif (reset || isempty (style_rotation)) + style_rotation = get (gca (), "linestyleorder"); + if (ischar (style_rotation)) + style_rotation = strsplit (style_rotation, "|"); + endif + num_styles = length (style_rotation); + style_index = 1; + endif + elseif (! isempty (style_rotation)) + options = __pltopt__ ("__next_line_style__", + style_rotation (style_index)); + linestyle = options.linestyle; + marker = options.marker; + else + error ("__next_line_style__: style_rotation not initialized"); + endif + else + print_usage (); + endif + +endfunction diff --git a/octave_packages/m/plot/private/__patch__.m b/octave_packages/m/plot/private/__patch__.m new file mode 100644 index 0000000..77118cc --- /dev/null +++ b/octave_packages/m/plot/private/__patch__.m @@ -0,0 +1,368 @@ +## Copyright (C) 2007-2012 John W. Eaton, Shai Ayal, Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{h}, @var{fail}] =} __patch__ (@var{p}, @dots{}) +## Undocumented internal function. +## @end deftypefn + +## __patch__ (p, x, y, c) +## Create patch object from x and y with color c and parent p. +## Return handle to patch object. + +## Author: Kai Habel + +function [h, failed] = __patch__ (p, varargin) + + h = NaN; + failed = false; + + is_numeric_arg = cellfun (@isnumeric, varargin); + + if (isempty (varargin)) + args = {"xdata", [0; 1; 0], "ydata", [1; 1; 0], "facecolor", [0, 0, 0]}; + args = setvertexdata (args); + elseif (isstruct (varargin{1})) + if (isfield (varargin{1}, "vertices") && isfield (varargin{1}, "faces")) + args{1} = "faces"; + args{2} = getfield(varargin{1}, "faces"); + args{3} = "vertices"; + args{4} = getfield(varargin{1}, "vertices"); + args{5} = "facevertexcdata"; + if (isfield (varargin{1}, "facevertexcdata")) + args{6} = getfield(varargin{1}, "facevertexcdata"); + else + args{6} = []; + endif + args = [args; varargin(2:end)]; + args = setdata (args); + else + failed = true; + endif + elseif (is_numeric_arg(1)) + if (nargin < 3 || ! is_numeric_arg(2)) + failed = true; + else + + if (nargin > 4 && all (is_numeric_arg(1:4))) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + c = varargin{4}; + iarg = 5; + elseif (nargin > 3 && all (is_numeric_arg(1:3))) + x = varargin{1}; + y = varargin{2}; + iarg = 4; + if (rem (nargin - iarg, 2) == 1) + c = varargin {iarg}; + z = varargin{3}; + iarg = 5; + else + z = []; + c = varargin{3}; + endif + elseif (nargin > 2 && all (is_numeric_arg(1:2))) + x = varargin{1}; + y = varargin{2}; + z = []; + iarg = 3; + if (rem (nargin - iarg, 2) == 1) + c = varargin {iarg}; + iarg++; + else + c = []; + endif + endif + + if (isvector (x)) + x = x(:); + y = y(:); + z = z(:); + if (isnumeric (c)) + if (isvector (c) && numel (c) == numel (x)) + c = c(:); + elseif (size (c, 1) != numel (x) && size (c, 2) == numel (x)) + c = c.'; + endif + endif + endif + args{1} = "xdata"; + args{2} = x; + args{3} = "ydata"; + args{4} = y; + args{5} = "zdata"; + args{6} = z; + + if (isnumeric (c)) + + if (ndims (c) == 3 && size (c, 2) == 1) + c = permute (c, [1, 3, 2]); + endif + + if (isvector (c) && numel (c) == columns (x)) + if (isnan (c)) + args{7} = "facecolor"; + args{8} = [1, 1, 1]; + args{9} = "cdata"; + args{10} = c; + elseif (isnumeric (c)) + args{7} = "facecolor"; + args{8} = "flat"; + args{9} = "cdata"; + args{10} = c; + else + error ("patch: color value not valid"); + endif + elseif (isvector (c) && numel (c) == 3) + args{7} = "facecolor"; + args{8} = c; + args{9} = "cdata"; + args{10} = []; + elseif (ndims (c) == 3 && size (c, 3) == 3) + ## CDATA is specified as RGB data + if ((size (c, 1) == 1 && size (c, 2) == 1) ... + || (size (c, 1) == 1 && size (c, 2) == columns (x))) + ## Single patch color or per-face color + args{7} = "facecolor"; + args{8} = "flat"; + args{9} = "cdata"; + args{10} = c; + elseif (size (c, 1) == rows (x) && size (c, 2) == columns (x)) + ## Per-vertex color + args{7} = "facecolor"; + args{8} = "interp"; + args{9} = "cdata"; + agrs{10} = c; + else + error ("patch: color value not valid"); + endif + else + ## Color Vectors + if (isempty (c)) + args{7} = "facecolor"; + args{8} = "interp"; + args{9} = "cdata"; + args{10} = []; + elseif (isequal (size (c), size (x)) && isequal (size (c), size (y))) + args{7} = "facecolor"; + args{8} = "interp"; + args{9} = "cdata"; + args{10} = c; + else + error ("patch: size of x, y, and c must be equal"); + endif + endif + elseif (ischar (c) && rem (nargin - iarg, 2) == 0) + ## Assume that any additional argument over an even number is + ## color string. + args{7} = "facecolor"; + args{8} = tolower (c); + args{9} = "cdata"; + args{10} = []; + else + args{7} = "facecolor"; + args{8} = [0, 1, 0]; + args{9} = "cdata"; + args{10} = []; + endif + + args = [args, varargin(iarg:end)]; + args = setvertexdata (args); + endif + else + args = varargin; + if (any (strcmpi (args, "faces") | strcmpi (args, "vertices"))) + args = setdata (args); + else + args = setvertexdata (args); + endif + endif + + if (!failed) + h = __go_patch__ (p, args {:}); + + ## Setup listener functions + addlistener (h, "xdata", @update_data); + addlistener (h, "ydata", @update_data); + addlistener (h, "zdata", @update_data); + addlistener (h, "cdata", @update_data); + + addlistener (h, "faces", @update_fvc); + addlistener (h, "vertices", @update_fvc); + addlistener (h, "facevertexcdata", @update_fvc); + endif +endfunction + +function args = delfields(args, flds) + idx = cellfun (@(x) any (strcmpi (x, flds)), args); + if (rows (idx) == 1) + idx = idx | [false, idx(1:end-1)]; + else + idx = idx | [false; idx(1:end-1)]; + endif + args (idx) = []; +endfunction + +function args = setdata (args) + args = delfields (args, {"xdata", "ydata", "zdata", "cdata"}); + ## Remove the readonly fields as well + args = delfields (args, {"type", "uicontextmenu"}); + nargs = length (args); + idx = find (strcmpi (args, "faces"), 1, "last") + 1; + if (idx > nargs) + faces = []; + else + faces = args {idx}; + endif + idx = find (strcmpi (args, "vertices"), 1, "last") + 1; + if (idx > nargs) + vert = []; + else + vert = args {idx}; + endif + idx = find (strcmpi (args, "facevertexcdata"), 1, "last") + 1; + if (isempty(idx) || idx > nargs) + fvc = []; + else + fvc = args {idx}; + endif + idx = find (strcmpi (args, "facecolor"), 1, "last") + 1; + if (isempty(idx) || idx > nargs) + if (!isempty (fvc)) + fc = "flat"; + else + fc = [0, 1, 0]; + endif + args = {"facecolor", fc, args{:}}; + endif + + nc = size (faces, 1); + idx = faces .'; + t1 = isnan (idx); + for i = find (any (t1)) + first_idx_in_column = find (t1(:,i), 1); + idx(first_idx_in_column:end,i) = idx(first_idx_in_column-1,i); + endfor + x = reshape (vert(:,1)(idx), size (idx)); + y = reshape (vert(:,2)(idx), size (idx)); + if (size(vert,2) > 2) + z = reshape (vert(:,3)(idx), size (idx)); + else + z = []; + endif + + if (size(fvc, 1) == nc || size (fvc, 1) == 1) + c = reshape (fvc, [1, size(fvc)]); + else + if (size(fvc, 2) == 3) + c = cat(3, reshape (fvc(idx, 1), size(idx)), + reshape (fvc(idx, 2), size(idx)), + reshape (fvc(idx, 3), size(idx))); + elseif (isempty (fvc)) + c = []; + else ## if (size (fvc, 2) == 1) + c = permute (fvc(faces), [2, 1]); + endif + endif + args = {"xdata", x, "ydata", y, "zdata", z, "cdata", c, args{:}}; +endfunction + +function args = setvertexdata (args) + args = delfields (args, {"vertices", "faces", "facevertexcdata"}); + ## Remove the readonly fields as well + args = delfields (args, {"type", "uicontextmenu"}); + nargs = length (args); + idx = find (strcmpi (args, "xdata"), 1, "last") + 1; + if (idx > nargs) + x = []; + else + x = args {idx}; + endif + idx = find (strcmpi (args, "ydata"), 1, "last") + 1; + if (idx > nargs) + y = []; + else + y = args {idx}; + endif + idx = find (strcmpi (args, "zdata"), 1, "last") + 1; + if (isempty(idx) || idx > nargs) + z = []; + else + z = args {idx}; + endif + idx = find (strcmpi (args, "cdata"), 1, "last") + 1; + if (isempty(idx) || idx > nargs) + c = []; + else + c = args {idx}; + endif + idx = find (strcmpi (args, "facecolor"), 1, "last") + 1; + if (isempty(idx) || idx > nargs) + if (!isempty (c)) + fc = "flat"; + else + fc = [0, 1, 0]; + endif + args = {"facecolor", fc, args{:}}; + endif + + [nr, nc] = size (x); + if (nr == 1 && nc > 1) + nr = nc; + nc = 1; + end + if (!isempty (z)) + vert = [x(:), y(:), z(:)]; + else + vert = [x(:), y(:)]; + endif + faces = reshape (1:numel(x), nr, nc); + faces = faces'; + + if (ndims (c) == 3) + fvc = reshape (c, size (c, 1) * size (c, 2), size(c, 3)); + else + fvc = c(:); + endif + + args = {"faces", faces, "vertices", vert, "facevertexcdata", fvc, args{:}}; +endfunction + +function update_data (h, d) + update_handle (h, false); +endfunction + +function update_fvc (h, d) + update_handle (h, true); +endfunction + +function update_handle (h, isfv) + persistent recursive = false; + + if (! recursive) + recursive = true; + f = get (h); + if (isfv) + set (h, setdata ([fieldnames(f), struct2cell(f)].'(:)){:}); + else + set (h, setvertexdata ([fieldnames(f), struct2cell(f)].'(:)){:}); + endif + recursive = false; + endif +endfunction diff --git a/octave_packages/m/plot/private/__pie__.m b/octave_packages/m/plot/private/__pie__.m new file mode 100644 index 0000000..da84a47 --- /dev/null +++ b/octave_packages/m/plot/private/__pie__.m @@ -0,0 +1,200 @@ +## Copyright (C) 2007-2012 David Bateman +## Copyright (C) 2010 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hlist} =} __pie__ (caller, @dots{}) +## Undocumented internal function. +## @end deftypefn + +function hlist = __pie__ (caller, varargin) + + h = varargin{1}; + x = abs (varargin{2}); + iarg = 3; + + if (! isvector (x)) + error ("%s: expecting vector argument", caller); + endif + + len = length (x); + + have_explode = false; + have_labels = false; + + while (iarg <= nargin - 1) + arg = varargin{iarg++}; + if (iscell (arg)) + labels = arg; + have_labels = true; + if (numel (x) != numel (labels)) + error ("%s: mismatch in number of labels and data", caller); + endif + elseif (isnumeric (arg) || islogical (arg)) + explode = arg; + have_explode = true; + if (! size_equal (x, explode)) + error ("%s: mismatch in number of elements in explode and data", + caller); + endif + else + error ("%s: %s is invalid as an optional argument", caller, class (arg)); + endif + endwhile + + if (! have_explode) + explode = zeros (size (x)); + endif + + normalize = true; + if (sum (x(:)) < 1) + normalize = false; + endif + + if (! have_labels) + if (normalize) + xp = round (100 * x ./ sum (x)); + else + xp = round (100 * x); + endif + for i = 1:len + labels{i} = sprintf ("%d%%", xp(i)); + endfor + endif + + hlist = []; + refinement = 90; + phi = 0:refinement:360; + if (normalize) + xphi = cumsum (x / sum (x) * 360); + else + xphi = cumsum (x * 360); + endif + + for i = 1:len + if (i == 1) + xn = 0 : 360 / refinement : xphi(i); + else + xn = xphi(i-1) : 360 / refinement : xphi(i); + endif + + if (xn(end) != xphi(i)) + xn = [xn, xphi(i)]; + endif + + xn2 = (xn(1) + xn(end)) / 2; + if (explode (i)) + xoff = - 0.1 * sind (xn2); + yoff = 0.1 * cosd (xn2); + else + xoff = 0; + yoff = 0; + endif + xt = - 1.2 * sind (xn2); + yt = 1.2 * cosd (xn2); + + if (len == 1) + set (h, "clim", [1, 2]); + else + set (h, "clim", [1, len]); + endif + + if (strncmp (caller, "pie3", 4)) + ln = length (xn); + zlvl = 0.35; + sx = repmat (xoff + [0, - sind(xn), 0], [2 1]); + sy = repmat (yoff + [0, cosd(xn), 0], [2 1]); + sz = [zeros(1, ln + 2); zlvl * ones(1, ln + 2)]; + sc = i * ones (size (sz)); + + hlist = [hlist; + patch(xoff + [0, - sind(xn)], yoff + [0, cosd(xn)], zeros (1, ln + 1), i); + surface(sx, sy, sz, sc); + patch(xoff + [0, - sind(xn)], yoff + [0, cosd(xn)], zlvl * ones (1, ln + 1), i); + text(xt, yt, zlvl, labels{i})]; + + elseif (strncmp (caller, "pie", 3)) + if (xt > 0) + align = "left"; + else + align = "right"; + endif + + hlist = [hlist; patch(xoff + [0, - sind(xn)], yoff + [0, cosd(xn)], i); + text(xt, yt, labels{i}, "horizontalalignment", align)]; + + else + error ("__pie__: unknown caller `%s'", caller); + endif + endfor + + addlistener(gca, "view", {@update_text_pos, hlist}); + + if (strncmp (caller, "pie3", 4)) + axis ([-1.25, 1.25, -1.25, 1.25, -0.05, 0.4], "equal", "off"); + view (-37.5, 30); + elseif (strncmp (caller, "pie", 3)) + axis ([-1.5, 1.5, -1.5, 1.5], "square", "off"); + endif +endfunction + +function update_text_pos (all_handles) + ## Text objects in the foreground should be at the base level. + ## Text objects in the background should be at the top level. + ## Text objects on the right side should be aligned to the right + ## and on the left side to the left. + tobj = findobj (all_handles, "type", "text"); + + ## check if we are called from pie3 + s = findobj (all_handles, "type", "surface"); + is_pie3 = false; + if (length (s) > 0) + is_pie3 = true; + endif + + if (length (tobj) > 0) + ax = get (tobj(1), "parent"); + azel = get (ax, "view"); + pos = get (tobj, "position"); + if (iscell (pos)) + pos = cell2mat (pos); + endif + phi = atand (pos(:,1) ./ pos(:,2)); + [theta, r] = cart2pol (pos(:,1), pos(:,2)); + theta *= 180/pi; + theta -= azel(1); + theta = mod (theta, 360); + ud_mask = (theta > 180); + lr_mask = (theta > 90) & (theta < 270); + for i = 1 : length (tobj) + if (is_pie3) + if (ud_mask(i)) + set (tobj(i), "position", [pos(i,1), pos(i,2), -0.05]); + else + set (tobj(i), "position", [pos(i,1), pos(i,2), 0.40]); + endif + endif + + if (lr_mask(i)) + set (tobj(i), "horizontalalignment", "right"); + else + set (tobj(i), "horizontalalignment", "left"); + endif + endfor + endif +endfunction diff --git a/octave_packages/m/plot/private/__plt__.m b/octave_packages/m/plot/private/__plt__.m new file mode 100644 index 0000000..d3d7017 --- /dev/null +++ b/octave_packages/m/plot/private/__plt__.m @@ -0,0 +1,604 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __plt__ (@var{caller}, @var{h}, @var{varargin}) +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = __plt__ (caller, h, varargin) + + nargs = nargin - 2; + + if (nargs > 0) + + k = 1; + + x_set = false; + y_set = false; + property_set = false; + properties = {}; + + hlegend = []; + fkids = get (gcf(), "children"); + for i = 1 : numel(fkids) + if (ishandle (fkids (i)) && strcmp (get (fkids (i), "type"), "axes") + && (strcmp (get (fkids (i), "tag"), "legend"))) + udata = get (fkids (i), "userdata"); + if (! isempty (intersect (udata.handle, gca ()))) + hlegend = fkids (i); + break; + endif + endif + endfor + + setlgnd = false; + if (isempty (hlegend)) + hlgnd = []; + tlgnd = {}; + else + [hlgnd, tlgnd] = __getlegenddata__ (hlegend); + endif + + ## Gather arguments, decode format, gather plot strings, and plot lines. + + retval = []; + + while (nargs > 0 || x_set) + + if (nargs == 0) + ## Force the last plot when input variables run out. + next_cell = {}; + next_arg = {""}; + else + next_cell = varargin(k); + next_arg = varargin{k++}; + endif + + nargs--; + + if (ischar (next_arg) || iscellstr (next_arg)) + if (x_set) + [options, valid] = __pltopt__ (caller, next_arg, false); + if (! valid) + if (nargs == 0) + error ("%s: properties must appear followed by a value", caller); + endif + properties = [properties, [next_cell, varargin(k++)]]; + nargs--; + continue; + else + while (nargs > 0 && ischar (varargin{k})) + if (nargs < 2) + error ("%s: properties must appear followed by a value", + caller); + endif + properties = [properties, varargin(k:k+1)]; + k += 2; + nargs -= 2; + endwhile + endif + if (y_set) + tmp = __plt2__ (h, x, y, options, properties); + [hlgnd, tlgnd, setlgnd] = __plt_key__ (tmp, options, hlgnd, tlgnd, setlgnd); + properties = {}; + retval = [retval; tmp]; + else + tmp = __plt1__ (h, x, options, properties); + [hlgnd, tlgnd, setlgnd] = __plt_key__ (tmp, options, hlgnd, tlgnd, setlgnd); + properties = {}; + retval = [retval; tmp]; + endif + x_set = false; + y_set = false; + else + error ("plot: no data to plot"); + endif + elseif (x_set) + if (y_set) + options = __pltopt__ (caller, {""}); + tmp = __plt2__ (h, x, y, options, properties); + [hlgnd, tlgnd, setlgnd] = __plt_key__ (tmp, options, hlgnd, tlgnd, setlgnd); + retval = [retval; tmp]; + x = next_arg; + y_set = false; + properties = {}; + else + y = next_arg; + y_set = true; + endif + else + x = next_arg; + x_set = true; + endif + + endwhile + + if (setlgnd) + legend (gca(), hlgnd, tlgnd); + endif + else + error ("__plt__: invalid number of arguments"); + endif + +endfunction + +function [hlgnd, tlgnd, setlgnd] = __plt_key__ (h, options, hlgnd, tlgnd, setlgnd) + n = numel (h); + if (numel (options) == 1) + options = repmat (options(:), n, 1); + endif + + for i = 1 : n + key = options.key; + if (! isempty (key)) + hlgnd = [hlgnd(:); h(i)]; + tlgnd = {tlgnd{:}, key}; + setlgnd = true; + endif + endfor +endfunction + +function retval = __plt1__ (h, x1, options, properties) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (nargin < 3 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 4) + properties = {}; + endif + + if (! isstruct (options)) + error ("__plt1__: options must be a struct array"); + endif + + [nr, nc] = size (x1); + if (nr == 1) + x1 = x1.'; + tmp = nr; + nr = nc; + nc = tmp; + endif + x1_i = imag (x1); + if (any (any (x1_i))) + x2 = x1_i; + x1 = real (x1); + else + x2 = x1; + x1 = (1:nr)'; + endif + + retval = __plt2__ (h, x1, x2, options, properties); + +endfunction + +function retval = __plt2__ (h, x1, x2, options, properties) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (nargin < 4 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 5) + properties = {}; + endif + + if (! isstruct (options)) + error ("__plt1__: options must be a struct array"); + endif + + if (any (any (imag (x1)))) + x1 = real (x1); + endif + + if (any (any (imag (x2)))) + x2 = real (x2); + endif + + h_set = false; + if (isempty (x1) && isempty (x2)) + retval = zeros (0, 1); + elseif (isscalar (x1)) + if (isscalar (x2)) + retval = __plt2ss__ (h, x1, x2, options, properties); + elseif (isvector (x2)) + retval = __plt2sv__ (h, x1, x2, options, properties); + else + error ("__plt2__: invalid data for plotting"); + endif + elseif (isvector (x1)) + if (isscalar (x2)) + retval = __plt2vs__ (h, x1, x2, options, properties); + elseif (isvector (x2)) + retval = __plt2vv__ (h, x1, x2, options, properties); + elseif (ismatrix (x2)) + retval = __plt2vm__ (h, x1, x2, options, properties); + else + error ("__plt2__: invalid data for plotting"); + endif + elseif (ismatrix (x1)) + if (isvector (x2)) + retval = __plt2mv__ (h, x1, x2, options, properties); + elseif (ismatrix (x2)) + retval = __plt2mm__ (h, x1, x2, options, properties); + else + error ("__plt2__: invalid data for plotting"); + endif + else + error ("__plt2__: invalid data for plotting"); + endif + +endfunction + +function retval = __plt2mm__ (h, x, y, options, properties) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (nargin < 4 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 5) + properties = {}; + endif + + [x_nr, x_nc] = size (x); + [y_nr, y_nc] = size (y); + + k = 1; + if (x_nr == y_nr && x_nc == y_nc) + if (x_nc > 0) + if (numel (options) == 1) + options = repmat (options(:), x_nc, 1); + endif + retval = zeros (x_nc, 1); + for i = 1:x_nc + linestyle = options(i).linestyle; + marker = options(i).marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options(i).color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + retval(i) = line (x(:,i), y(:,i), "color", color, + "linestyle", linestyle, + "marker", marker, properties{:}); + endfor + else + error ("__plt2mm__: arguments must be a matrices"); + endif + else + error ("__plt2mm__: matrix dimensions must match"); + endif + +endfunction + +function retval = __plt2mv__ (h, x, y, options, properties) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (nargin < 4 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 5) + properties = {}; + endif + + [x_nr, x_nc] = size (x); + [y_nr, y_nc] = size (y); + + if (y_nr == 1) + y = y'; + tmp = y_nr; + y_nr = y_nc; + y_nc = tmp; + endif + + if (x_nr == y_nr) + 1; + elseif (x_nc == y_nr) + x = x'; + tmp = x_nr; + x_nr = x_nc; + x_nc = tmp; + else + error ("__plt2mv__: matrix dimensions must match"); + endif + + if (x_nc > 0) + if (numel (options) == 1) + options = repmat (options(:), x_nc, 1); + endif + retval = zeros (x_nc, 1); + for i = 1:x_nc + linestyle = options(i).linestyle; + marker = options(i).marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options(i).color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + retval(i) = line (x(:,i), y, "color", color, + "linestyle", linestyle, + "marker", marker, properties{:}); + endfor + else + error ("__plt2mv__: arguments must be a matrices"); + endif + +endfunction + +function retval = __plt2ss__ (h, x, y, options, properties) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (nargin < 4 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 5) + properties = {}; + endif + + if (numel (options) > 1) + options = options(1); + endif + + [x_nr, x_nc] = size (x); + [y_nr, y_nc] = size (y); + + if (x_nr == 1 && x_nr == y_nr && x_nc == 1 && x_nc == y_nc) + linestyle = options.linestyle; + marker = options.marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options.color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + retval = line (x, y, "color", color, + "linestyle", linestyle, + "marker", marker, properties{:}); + else + error ("__plt2ss__: arguments must be scalars"); + endif + +endfunction + +function retval = __plt2sv__ (h, x, y, options, properties) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (nargin < 4 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 5) + properties = {}; + endif + + if (isscalar (x) && isvector (y)) + len = numel (y); + if (numel (options) == 1) + options = repmat (options(:), len, 1); + endif + retval = zeros (len, 1); + for i = 1:len + linestyle = options(i).linestyle; + marker = options(i).marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options(i).color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + retval(i) = line (x, y(i), "color", color, + "linestyle", linestyle, + "marker", marker, properties{:}); + endfor + else + error ("__plt2sv__: first arg must be scalar, second arg must be vector"); + endif + +endfunction + +function retval = __plt2vm__ (h, x, y, options, properties) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (nargin < 4 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 5) + properties = {}; + endif + + [x_nr, x_nc] = size (x); + [y_nr, y_nc] = size (y); + + if (x_nr == 1) + x = x'; + tmp = x_nr; + x_nr = x_nc; + x_nc = tmp; + endif + + if (x_nr == y_nr) + 1; + elseif (x_nr == y_nc) + y = y'; + tmp = y_nr; + y_nr = y_nc; + y_nc = tmp; + else + error ("__plt2vm__: matrix dimensions must match"); + endif + + if (y_nc > 0) + if (numel (options) == 1) + options = repmat (options(:), y_nc, 1); + endif + retval = zeros (y_nc, 1); + for i = 1:y_nc + linestyle = options(i).linestyle; + marker = options(i).marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options(i).color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + retval(i) = line (x, y(:,i), "color", color, + "linestyle", linestyle, + "marker", marker, properties{:}); + endfor + else + error ("__plt2vm__: arguments must be a matrices"); + endif + +endfunction + +function retval = __plt2vs__ (h, x, y, options, properties) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (nargin < 4 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 5) + properties = {}; + endif + + if (isvector (x) && isscalar (y)) + len = numel (x); + if (numel (options) == 1) + options = repmat (options(:), len, 1); + endif + retval = zeros (len, 1); + for i = 1:len + linestyle = options(i).linestyle; + marker = options(i).marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options(i).color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + retval(i) = line (x(i), y, "color", color, + "linestyle", linestyle, + "marker", marker, properties{:}); + endfor + else + error ("__plt2vs__: first arg must be vector, second arg must be scalar"); + endif + +endfunction + +function retval = __plt2vv__ (h, x, y, options, properties) + + if (nargin < 3 || nargin > 5) + print_usage (); + endif + + if (nargin < 4 || isempty (options)) + options = __default_plot_options__ (); + endif + + if (nargin < 5) + properties = {}; + endif + + if (numel (options) > 1) + options = options(1); + endif + + [x_nr, x_nc] = size (x); + [y_nr, y_nc] = size (y); + + if (x_nr == 1) + x = x'; + tmp = x_nr; + x_nr = x_nc; + x_nc = tmp; + endif + + if (y_nr == 1) + y = y'; + tmp = y_nr; + y_nr = y_nc; + y_nc = tmp; + endif + + if (x_nr == y_nr) + linestyle = options.linestyle; + marker = options.marker; + if (isempty (marker) && isempty (linestyle)) + [linestyle, marker] = __next_line_style__ (); + endif + color = options.color; + if (isempty (color)) + color = __next_line_color__ (); + endif + + retval = line (x, y, "color", color, + "linestyle", linestyle, + "marker", marker, properties{:}); + else + error ("__plt2vv__: vector lengths must match"); + endif + +endfunction diff --git a/octave_packages/m/plot/private/__pltopt__.m b/octave_packages/m/plot/private/__pltopt__.m new file mode 100644 index 0000000..418ed4c --- /dev/null +++ b/octave_packages/m/plot/private/__pltopt__.m @@ -0,0 +1,241 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __pltopt__ (@var{caller}, @var{opt}) +## Undocumented internal function. +## @end deftypefn + +## @deftypefn {Function File} {} __pltopt__ (@var{caller}, @var{opt}) +## +## Decode plot option strings. +## +## @var{opt} can currently be some combination of the following: +## +## @table @code +## @item "-" +## For solid linestyle (default). +## +## @item "--" +## For dashed line style. +## +## @item "-." +## For linespoints plot style. +## +## @item ":" +## For dots plot style. +## +## @item "r" +## Red line color. +## +## @item "g" +## Green line color. +## +## @item "b" +## Blue line color. +## +## @item "c" +## Cyan line color. +## +## @item "m" +## Magenta line color. +## +## @item "y" +## Yellow line color. +## +## @item "k" +## Black line color. +## +## @item "w" +## White line color. +## +## @item ";title;" +## Here @code{"title"} is the label for the key. +## +## @item "+" +## @itemx "o" +## @itemx "*" +## @itemx "." +## @itemx "x" +## @itemx "s" +## @itemx "d" +## @itemx "^" +## @itemx "v" +## @itemx ">" +## @itemx "<" +## @itemx "p" +## @itemx "h" +## Used in combination with the points or linespoints styles, set the point +## style. +## @end table +## +## The legend may be fixed to include the name of the variable +## plotted in some future version of Octave. + +## Author: jwe + +function [options, valid] = __pltopt__ (caller, opt, err_on_invalid) + + valid = true; + options = __default_plot_options__ (); + + if ((nargin == 2 || nargin == 3) && (nargout == 1 || nargout == 2)) + if (nargin == 2) + err_on_invalid = true; + endif + if (ischar (opt)) + nel = rows (opt); + elseif (iscellstr (opt)) + nel = numel (opt); + else + error ("__pltopt__: expecting argument to be character string or cell array of character strings"); + endif + if (ischar (opt)) + opt = cellstr (opt); + endif + for i = nel:-1:1 + [options(i), valid] = __pltopt1__ (caller, opt{i}, err_on_invalid); + if (! err_on_invalid && ! valid) + return; + endif + endfor + else + print_usage (); + endif + +endfunction + +## Really decode plot option strings. + +## Author: Rick Niles +## Adapted-By: jwe +## Maintainer: jwe + +function [options, valid] = __pltopt1__ (caller, opt, err_on_invalid) + + options = __default_plot_options__ (); + valid = true; + + more_opts = 1; + + if (nargin != 2 && nargin != 3) + print_usage (); + endif + + if (! ischar (opt)) + return; + endif + + have_linestyle = false; + have_marker = false; + + ## If called by __errplot__, extract the linestyle before proceeding. + if (strcmp (caller,"__errplot__")) + if (strncmp (opt, "#~>", 3)) + n = 3; + elseif (strncmp (opt, "#~", 2) || strncmp (opt, "~>", 2)) + n = 2; + elseif (strncmp (opt, "~", 1) || strncmp (opt, ">", 1) + || strncmp (opt, "#", 1)) + n = 1; + else + n = 0; + endif + options.errorstyle = opt(1:n); + opt(1:n) = []; + else + options.errorstyle = "~"; + endif + + while (! isempty (opt)) + if (strncmp (opt, "--", 2) || strncmp (opt, "-.", 2)) + options.linestyle = opt(1:2); + have_linestyle = true; + n = 2; + else + topt = opt(1); + n = 1; + if (topt == "-" || topt == ":") + have_linestyle = true; + options.linestyle = topt; + elseif (topt == "+" || topt == "o" || topt == "*" + || topt == "." || topt == "x" || topt == "s" + || topt == "d" || topt == "^" || topt == "v" + || topt == ">" || topt == "<" || topt == "p" + || topt == "h" || topt == "@") + have_marker = true; + ## Backward compatibility. Leave undocumented. + if (topt == "@") + topt = "+"; + endif + options.marker = topt; +### Numeric color specs for backward compatibility. Leave undocumented. + elseif (topt == "k" || topt == "0") + options.color = [0, 0, 0]; + elseif (topt == "r" || topt == "1") + options.color = [1, 0, 0]; + elseif (topt == "g" || topt == "2") + options.color = [0, 1, 0]; + elseif (topt == "b" || topt == "3") + options.color = [0, 0, 1]; + elseif (topt == "y") + options.color = [1, 1, 0]; + elseif (topt == "m" || topt == "4") + options.color = [1, 0, 1]; + elseif (topt == "c" || topt == "5") + options.color = [0, 1, 1]; + elseif (topt == "w" || topt == "6") + options.color = [1, 1, 1]; + elseif (isspace (topt)) + ## Do nothing. + elseif (topt == ";") + t = index (opt(2:end), ";"); + if (t) + options.key = undo_string_escapes (opt(2:t)); + n = t+1; + else + if (err_on_invalid) + error ("%s: unfinished key label", caller); + else + valid = false; + options = __default_plot_options__ (); + return; + endif + endif + else + if (err_on_invalid) + error ("%s: unrecognized format character: `%s'", caller, topt); + else + valid = false; + options = __default_plot_options__ (); + return; + endif + endif + endif + opt(1:n) = []; + endwhile + + if (! have_linestyle && have_marker) + options.linestyle = "none"; + endif + + if (have_linestyle && ! have_marker) + options.marker = "none"; + endif + +endfunction diff --git a/octave_packages/m/plot/private/__print_parse_opts__.m b/octave_packages/m/plot/private/__print_parse_opts__.m new file mode 100644 index 0000000..166f62b --- /dev/null +++ b/octave_packages/m/plot/private/__print_parse_opts__.m @@ -0,0 +1,608 @@ +## Copyright (C) 2010-2012 Shai Ayal +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{args} =} __print_parse_opts__ (@var{propname}, @var{propvalue}) +## @deftypefnx {Function File} {@var{args} =} __print_parse_opts__ (@var{struct}) +## Undocumented internal function. +## @end deftypefn + +function arg_st = __print_parse_opts__ (varargin) + + persistent warn_on_missing_binary = true + + arg_st.append_to_file = false; + arg_st.canvas_size = []; + arg_st.debug = false; + arg_st.debug_file = "octave-print-commands.log"; + arg_st.devopt = ""; + arg_st.epstool_binary = __quote_path__ (__find_binary__ ("epstool")); + arg_st.figure = get (0, "currentfigure"); + arg_st.fig2dev_binary = __quote_path__ (__find_binary__ ("fig2dev")); + arg_st.fontsize = ""; + arg_st.font = ""; + arg_st.force_solid = 0; # 0=default, -1=dashed, +1=solid + arg_st.formatted_for_printing = false; + arg_st.ghostscript.binary = __quote_path__ (__ghostscript_binary__ ()); + arg_st.ghostscript.debug = false; + arg_st.ghostscript.device = ""; + arg_st.ghostscript.epscrop = true; + arg_st.ghostscript.level = []; + arg_st.ghostscript.output = ""; + arg_st.ghostscript.papersize = ""; + arg_st.ghostscript.pageoffset = []; + arg_st.ghostscript.resolution = 150; + arg_st.ghostscript.antialiasing = false; + arg_st.loose = false; + arg_st.lpr_binary = __quote_path__ (__find_binary__ ("lpr")); + arg_st.name = ""; + arg_st.orientation = ""; + arg_st.pstoedit_binary = __quote_path__ (__find_binary__ ("pstoedit")); + arg_st.preview = ""; + arg_st.printer = ""; + arg_st.send_to_printer = false; + arg_st.special_flag = "textnormal"; + arg_st.tight_flag = false; + arg_st.use_color = 0; # 0=default, -1=mono, +1=color + + if (isunix ()) + arg_st.lpr_options = "-l"; + elseif (ispc ()) + arg_st.lpr_options = "-o l"; + else + arg_st.lpr_options = ""; + endif + arg_st.unlink = {}; + + if (nargin > 0 && isfigure (varargin{1})) + arg_st.figure = varargin{1}; + varargin(1) = []; + endif + + for i = 1:numel(varargin) + arg = strtrim (varargin{i}); + if (ischar (arg)) + if (strcmp (arg, "-color")) + arg_st.use_color = 1; + elseif (strcmp (arg, "-append")) + arg_st.append_to_file = true; + elseif (strcmp (arg, "-mono")) + arg_st.use_color = -1; + elseif (strcmp (arg, "-solid")) + arg_st.force_solid = 1; + elseif (strcmp (arg, "-dashed")) + arg_st.force_solid = -1; + elseif (strncmp (arg, "-portrait", numel (arg))) + arg_st.orientation = "portrait"; + elseif (strncmp (arg, "-landscape", numel (arg))) + arg_st.orientation = "landscape"; + elseif (strcmp (arg, "-loose")) + arg_st.loose = true; + arg_st.tight_flag = false; + elseif (strcmp (arg, "-tight")) + arg_st.loose = false; + arg_st.tight_flag = true; + elseif (strcmp (arg, "-textspecial")) + arg_st.special_flag = "textspecial"; + elseif (any (strcmp (arg, {"-interchange", "-metafile", "-pict", "-tiff"}))) + arg_st.preview = arg(2:end); + elseif (strncmp (arg, "-debug", 6)) + arg_st.debug = true; + arg_st.ghostscript.debug = true; + if (length (arg) > 7) + arg_st.debug_file = arg(8:end); + endif + elseif (length (arg) > 2 && arg(1:2) == "-d") + arg_st.devopt = tolower (arg(3:end)); + elseif (length (arg) > 2 && arg(1:2) == "-P") + arg_st.printer = arg; + elseif (strncmp (arg, "-EPSTOOL:", 9)) + arg_st.epstool_binary = arg{10:end}; + elseif (strncmp (arg, "-FIG2DEV:", 9)) + arg_st.fig2dev_binary = arg{10:end}; + elseif (strncmp (arg, "-PSTOEDIT:", 9)) + arg_st.pstoedit_binary = arg{10:end}; + elseif ((length (arg) > 2) && arg(1:2) == "-G") + arg_st.ghostscript.binary = file_in_path (getenv ("PATH"), arg(3:end)); + if (isempty (arg_st.ghostscript.binary)) + error ("print: Ghostscript binary ""%s"" could not be located", + arg(3:end)); + else + arg_st.ghostscript_binary = __quote_path__ (arg_st.ghostscript_binary); + endif + elseif (length (arg) > 2 && arg(1:2) == "-F") + idx = rindex (arg, ":"); + if (idx) + arg_st.font = arg(3:idx-1); + arg_st.fontsize = str2num (arg(idx+1:end)); + else + arg_st.font = arg(3:end); + endif + elseif (length (arg) > 2 && arg(1:2) == "-S") + arg_st.canvas_size = str2num (arg(3:end)); + elseif (length (arg) > 2 && arg(1:2) == "-r") + arg_st.ghostscript.resolution = str2double (arg(3:end)); + elseif (length (arg) > 2 && arg(1:2) == "-f") + arg_st.figure = str2num (arg(3:end)); + elseif (length (arg) >= 1 && arg(1) == "-") + error ("print: unknown option `%s'", arg); + elseif (length (arg) > 0) + arg_st.name = arg; + endif + elseif (isfigure (arg)) + arg_st.figure = arg; + else + error ("print: expecting inputs to be character string options or a figure handle"); + endif + endfor + + if (arg_st.ghostscript.resolution == 0) + ## Do as Matlab does. + arg_st.ghostscript.resolution = get (0, "screenpixelsperinch"); + endif + + if (isempty (arg_st.orientation)) + if (isfigure (arg_st.figure)) + arg_st.orientation = get (arg_st.figure, "paperorientation"); + else + ## Allows tests to be run without error. + arg_st.orientation = "portrait"; + endif + endif + + if (isempty (arg_st.ghostscript.binary)) + arg_st.ghostscript.binary = __ghostscript_binary__ (); + endif + + dot = rindex (arg_st.name, "."); + if (isempty (arg_st.devopt)) + if (dot == 0) + arg_st.devopt = "psc"; + else + arg_st.devopt = tolower (arg_st.name(dot+1:end)); + endif + endif + + if (arg_st.use_color == 0) + if (any (strcmp ({"ps", "ps2", "eps", "eps2"}, arg_st.devopt))) + arg_st.use_color = -1; + else + arg_st.use_color = 1; + endif + endif + + if (strcmp (arg_st.devopt, "tex")) + arg_st.devopt = "epslatex"; + elseif (strcmp (arg_st.devopt, "ill")) + arg_st.devopt = "aifm"; + elseif (strcmp (arg_st.devopt, "cdr")) + arg_st.devopt = "corel"; + elseif (strcmp (arg_st.devopt, "meta")) + arg_st.devopt = "emf"; + elseif (strcmp (arg_st.devopt, "jpg")) + arg_st.devopt = "jpeg"; + endif + + dev_list = {"aifm", "corel", "fig", "png", "jpeg", ... + "gif", "pbm", "pbmraw", "dxf", "mf", ... + "svg", "hpgl", "ps", "ps2", "psc", ... + "psc2", "eps", "eps2", "epsc", "epsc2", ... + "emf", "pdf", "pslatex", "epslatex", "epslatexstandalone", ... + "pslatexstandalone", "pdflatexstandalone", ... + "pstex", "tiff", "tiffn" "tikz", "pcxmono", ... + "pcx24b", "pcx256", "pcx16", "pgm", "pgmraw", ... + "ppm", "ppmraw", "pdflatex", "texdraw", ... + "pdfcairo", "pngcairo", "pstricks", ... + "epswrite", "pswrite", "ps2write", "pdfwrite"}; + + suffixes = {"ai", "cdr", "fig", "png", "jpg", ... + "gif", "pbm", "pbm", "dxf", "mf", ... + "svg", "hpgl", "ps", "ps", "ps", ... + "ps", "eps", "eps", "eps", "eps", ... + "emf", "pdf", "tex", "tex", "tex", ... + "tex", "tex", ... + "ps", "tiff", "tiff", "tikz", "pcx", ... + "pcx", "pcx", "pcx", "pgm", "pgm", ... + "ppm", "ppm", "tex", "tex", ... + "pdf", "png", "tex", ... + "eps", "ps", "ps", "pdf"}; + + if (isfigure (arg_st.figure)) + __graphics_toolkit__ = get (arg_st.figure, "__graphics_toolkit__"); + else + ## Allow tests when no figures are present. + __graphics_toolkit__ = get (0, "defaultfigure__graphics_toolkit__"); + endif + + if (strcmp (__graphics_toolkit__, "gnuplot") + && __gnuplot_has_feature__ ("epslatex_implies_eps_filesuffix")) + suffixes(strncmp (dev_list, "epslatex", 8)) = {"eps"}; + endif + + match = strcmpi (dev_list, arg_st.devopt); + if (any (match)) + default_suffix = suffixes {match}; + else + default_suffix = arg_st.devopt; + endif + + if (dot == 0 && ! isempty (arg_st.name)) + arg_st.name = strcat (arg_st.name, ".", default_suffix); + endif + + if (arg_st.append_to_file) + if (isempty (arg_st.name)) + arg_st.append_to_file = false; + elseif (any (strcmpi (arg_st.devopt, {"eps", "eps2", "epsc", "epsc2", ... + "ps", "ps2", "psc", "psc2", "pdf"}))) + have_ghostscript = ! isempty (__ghostscript_binary__ ()); + if (have_ghostscript) + file_exists = ((numel (dir (arg_st.name)) == 1) + && (! isdir (arg_st.name))); + if (! file_exists) + arg_st.append_to_file = false; + endif + else + arg_st.append_to_file = false; + warning ("print.m: appended output requires ghostscript to be installed"); + endif + else + warning ("print.m: appended output is not supported for device '%s'", + arg_st.devopt); + arg_st.append_to_file = false; + endif + endif + + if (! isempty (arg_st.printer) || isempty (arg_st.name)) + arg_st.send_to_printer = true; + endif + + if (any (strcmp (arg_st.devopt, {"ps", "ps2", "psc", "psc2", "pdf"}))) + arg_st.formatted_for_printing = true; + endif + + aliases = gs_aliases (); + if (any (strcmp (arg_st.devopt, fieldnames (aliases)))) + arg_st.devopt = aliases.(arg_st.devopt); + endif + + ## FIXME - eps2 & epsc2 needs to be handled + if (strcmp (arg_st.devopt, "pswrite")) + arg_st.ghostscript.level = 1; + elseif (strcmp (arg_st.devopt, "ps2write")) + arg_st.ghostscript.level = 2; + endif + + if ((any (strcmp (arg_st.devopt, gs_device_list)) + && ! arg_st.formatted_for_printing) + || any (strcmp (arg_st.devopt, {"pswrite", "ps2write", "pdfwrite"}))) + ## Use ghostscript for graphic formats + arg_st.ghostscript.device = arg_st.devopt; + arg_st.ghostscript.output = arg_st.name; + arg_st.ghostscript.antialiasing = true; + if (arg_st.formatted_for_printing) + arg_st.ghostscript.epscrop = ! arg_st.loose; + else + ## pstoedit throws errors if the EPS file isn't cropped + arg_st.ghostscript.epscrop = true; + endif + elseif (all (! strcmp (arg_st.devopt, dev_list))) + ## Assume we are formating output for a printer + arg_st.formatted_for_printing = true; + arg_st.ghostscript.device = arg_st.devopt; + arg_st.ghostscript.output = arg_st.name; + arg_st.ghostscript.antialiasing = false; + arg_st.ghostscript.epscrop = ! arg_st.loose; + endif + + if (isempty (arg_st.canvas_size)) + if (isfigure (arg_st.figure)) + [arg_st.ghostscript.papersize, paperposition] = ... + gs_papersize (arg_st.figure, arg_st.orientation); + else + ## allows tests to be run + arg_st.ghostscript.papersize = "letter"; + paperposition = [0.25, 2.50, 8.00, 6.00] * 72; + endif + arg_st.canvas_size = paperposition(3:4); + if (strcmp (__graphics_toolkit__, "gnuplot") && ! arg_st.ghostscript.epscrop) + arg_st.ghostscript.pageoffset = paperposition(1:2) - 50; + else + arg_st.ghostscript.pageoffset = paperposition(1:2); + endif + else + ## Convert canvas size to points from pixles. + arg_st.canvas_size = arg_st.canvas_size * 72 / arg_st.ghostscript.resolution; + arg_st.ghostscript.papersize = arg_st.canvas_size; + arg_st.ghostscript.epscrop = true; + arg_st.ghostscript.pageoffset = [0, 0]; + endif + + if (arg_st.formatted_for_printing) + arg_st.ghostscript.resolution = []; + else + arg_st.ghostscript.papersize = ""; + arg_st.ghostscript.pageoffset = [0, 0]; + endif + + if (warn_on_missing_binary) + if (isempty (arg_st.ghostscript.binary)) + warning ("print:missing_gs", "print.m: Ghostscript binary is not available.\nOnly eps output is available."); + else + if (isempty (arg_st.epstool_binary)) + warning ("print:missing_epstool", "print.m: epstool binary is not available.\nSome output formats are not available."); + endif + if (isempty (arg_st.fig2dev_binary)) + warning ("print:missing_fig2dev", "print.m: fig2dev binary is not available.\nSome output formats are not available."); + endif + if (isempty (arg_st.pstoedit_binary)) + warning ("print:missing_pstoedit", "print.m: pstoedit binary is not available.\nSome output formats are not available."); + endif + endif + warn_on_missing_binary = false; + endif + +endfunction + +## Test blocks are not allowed (and not needed) for private functions +#%!test +%! opts = __print_parse_opts__ (); +%! assert (opts.devopt, "pswrite"); +%! assert (opts.use_color, 1); +%! assert (opts.send_to_printer, true); +%! assert (opts.canvas_size, [576, 432]); +%! assert (opts.ghostscript.device, "pswrite") + +#%!test +%! opts = __print_parse_opts__ ("test.pdf", "-S640,480"); +%! assert (opts.canvas_size, [307.2, 230.4], 0.1); + +#%!test +%! opts = __print_parse_opts__ ("-dpsc", "-append", "-loose"); +%! assert (opts.devopt, "pswrite"); +%! assert (opts.send_to_printer, true); +%! assert (opts.use_color, 1); +%! assert (opts.append_to_file, false); +%! assert (opts.ghostscript.device, "pswrite") +%! assert (opts.ghostscript.epscrop, false); + +#%!test +%! opts = __print_parse_opts__ ("-deps", "-tight"); +%! assert (opts.tight_flag, true); +%! assert (opts.send_to_printer, true); +%! assert (opts.use_color, -1); +%! assert (opts.ghostscript.device, "") + +#%!test +%! opts = __print_parse_opts__ ("-djpg", "foobar", "-mono", "-loose"); +%! assert (opts.devopt, "jpeg") +%! assert (opts.name, "foobar.jpg") +%! assert (opts.ghostscript.device, "jpeg") +%! assert (opts.ghostscript.epscrop, true); +%! assert (opts.ghostscript.papersize, ""); +%! assert (opts.ghostscript.pageoffset, [0, 0]); +%! assert (opts.send_to_printer, false); +%! assert (opts.printer, ""); +%! assert (opts.use_color, -1); + +#%!test +%! opts = __print_parse_opts__ ("-ddeskjet", "foobar", "-mono", "-Pmyprinter"); +%! assert (opts.ghostscript.output, "foobar.deskjet") +%! assert (opts.ghostscript.device, "deskjet") +%! assert (opts.devopt, "deskjet") +%! assert (opts.send_to_printer, true); +%! assert (opts.printer, "-Pmyprinter"); +%! assert (opts.use_color, -1); + +#%!test +%! opts = __print_parse_opts__ ("-f5", "-dljet3"); +%! assert (opts.ghostscript.device, "ljet3") +%! assert (strfind (opts.ghostscript.output, ".ljet3")) +%! assert (opts.devopt, "ljet3") +%! assert (opts.send_to_printer, true); +%! assert (opts.figure, 5) + +function cmd = __quote_path__ (cmd) + if (any (cmd == " ") && ! (cmd(1) == """" && cmd(end) == """")) + cmd = strcat ("""", strrep (cmd, """", """"""), """"); + endif +endfunction + +function gs = __ghostscript_binary__ () + + persistent ghostscript_binary = "" + persistent warn_on_no_ghostscript = true + persistent warn_on_bad_gsc = true + + if (isempty (ghostscript_binary)) + GSC = getenv ("GSC"); + if (exist (GSC, "file") + || (! isempty (GSC) && file_in_path (getenv ("PATH"), GSC))) + gs_binaries = {GSC}; + elseif (! isempty (GSC) && warn_on_bad_gsc) + warning ("print:badgscenv", + "print.m: GSC environment variable not set properly"); + warn_on_bad_gsc = false; + gs_binaries = {}; + else + gs_binaries = {}; + endif + if (isunix ()) + ## Unix - Includes Mac OSX and Cygwin. + gs_binaries = horzcat (gs_binaries, {"gs", "gs.exe"}); + else + ## pc - Includes Win32 and mingw. + gs_binaries = horzcat (gs_binaries, {"gs.exe", "gswin32c.exe", "mgs.exe"}); + endif + n = 0; + while (n < numel (gs_binaries) && isempty (ghostscript_binary)) + n = n + 1; + ghostscript_binary = file_in_path (getenv ("PATH"), gs_binaries{n}); + endwhile + if (warn_on_no_ghostscript && isempty (ghostscript_binary)) + warning ("print:noghostscript", + "print.m: ghostscript not found in PATH"); + warn_on_no_ghostscript = false; + endif + endif + + gs = ghostscript_binary; + +endfunction + +function bin = __find_binary__ (binary) + + persistent data = struct () + + if (! isfield (data, binary)) + ## Reinitialize when `user_binaries' is present. + data.(binary).bin = ""; + data.(binary).warn_on_absence = false; + endif + + if (isempty (data.(binary).bin)) + if (isunix ()) + ## Unix - Includes Mac OSX and Cygwin. + binaries = strcat (binary, {"", ".exe"}); + else + ## pc - Includes Win32 and mingw. + binaries = strcat (binary, {".exe"}); + endif + n = 0; + while (n < numel (binaries) && isempty (data.(binary).bin)) + n = n + 1; + data.(binary).bin = file_in_path (getenv ("PATH"), binaries{n}); + endwhile + if (isempty (data.(binary).bin) && data.(binary).warn_on_absence) + warning (sprintf ("print:no%s", binary), + "print.m: '%s' not found in PATH", binary); + data.(binary).warn_on_absence = false; + endif + endif + + bin = data.(binary).bin; + +endfunction + +function [papersize, paperposition] = gs_papersize (hfig, paperorientation) + persistent papertypes papersizes + + if (isempty (papertypes)) + papertypes = {"usletter", "uslegal", "a0", "a1", ... + "a2", "a3", "a4", "a5", ... + "b0", "b1", "b2", "b3", ... + "b4", "b5", "arch-a", "arch-b", ... + "arch-c", "arch-d", "arch-e", "a", ... + "b", "c", "d", "e", ... + "tabloid"}; + papersizes = [ 8.5, 11.0; 8.5, 14.0; 33.1, 46.8; 23.4, 33.1; + 16.5, 23.4; 11.7, 16.5; 8.3, 11.7; 5.8, 8.3; + 39.4, 55.7; 27.8, 39.4; 19.7, 27.8; 13.9, 19.7; + 9.8, 13.9; 6.9, 9.8; 9.0, 12.0; 12.0, 18.0; + 18.0, 24.0; 24.0, 36.0; 36.0, 48.0; 8.5, 11.0; + 11.0, 17.0; 18.0, 24.0; 24.0, 36.0; 36.0, 48.0; + 11.0, 17.0] * 72; + endif + + papertype = get (hfig, "papertype"); + paperunits = get (hfig, "paperunits"); + paperposition = get (hfig, "paperposition"); + if (strcmp (papertype, "")) + papersize = get (hfig, "papersize"); + papersize = convert2points (papersize , paperunits); + else + papersize = papersizes (strcmp (papertypes, papertype), :); + endif + + if (strcmp (paperunits, "normalized")) + paperposition = paperposition .* papersize([1,2,1,2]); + else + paperposition = convert2points (paperposition, paperunits); + endif + + ## FIXME - This will be obsoleted by listeners for paper properties. + ## Papersize is tall when portrait,and wide when landscape. + if ((papersize(1) > papersize(2) && strcmpi (paperorientation, "portrait")) + || (papersize(1) < papersize(2) && strcmpi (paperorientation, "landscape"))) + papersize = papersize ([2,1]); + paperposition = paperposition([2,1,4,3]); + endif + + if ((! strcmp (papertype, "")) && (strcmp (paperorientation, "portrait"))) + ## For portrait use the ghostscript name + papersize = papertype; + papersize(papersize=="-") = ""; + papersize = strrep (papersize, "us", ""); + switch (papersize) + case "a" + papersize = "letter"; + case {"b", "tabloid"} + papersize = "11x17"; + case {"c", "d", "e"} + papersize = strcat ("arch", papersize); + endswitch + if (strncmp (papersize, "arch", 4)) + papersize(end) = upper (papersize(end)); + endif + endif + +endfunction + +function value = convert2points (value, units) + switch (units) + case "inches" + value = value * 72; + case "centimeters" + value = value * 72 / 2.54; + case "normalized" + error ("print:customnormalized", + "print.m: papersize=='' and paperunits='normalized' may not be combined"); + endswitch +endfunction + +function device_list = gs_device_list (); + ## Graphics formats/languages, not priners. + device_list = {"bmp16"; "bmp16m"; "bmp256"; "bmp32b"; "bmpgray"; ... + "epswrite"; "jpeg"; "jpegcymk"; "jpeggray"; "pbm"; ... + "pbmraw"; "pcx16"; "pcx24b"; "pcx256"; "pcx2up"; ... + "pcxcmyk"; "pcxgray"; "pcxmono"; "pdfwrite"; "pgm"; ... + "pgmraw"; "pgnm"; "pgnmraw"; "png16"; "png16m"; ... + "png256"; "png48"; "pngalpha"; "pnggray"; "pngmono"; ... + "pnm"; "pnmraw"; "ppm"; "ppmraw"; "ps2write"; ... + "pswrite"; "tiff12nc"; "tiff24nc"; "tiff32nc"; ... + "tiffcrle"; "tiffg3"; "tiffg32d"; "tiffg4"; ... + "tiffgray"; "tifflzw"; "tiffpack"; "tiffsep"}; +endfunction + +function aliases = gs_aliases (); + ## Aliases for other devices: "bmp", "png", "tiff", "tiffn", "pdf", + ## "ps", "ps2", "psc", "psc2" + ## + ## eps, epsc, eps2, epsc2 are not included here because those are + ## are generated by the graphics toolkit. + aliases.bmp = "bmp32b"; + aliases.pdf = "pdfwrite"; + aliases.png = "png16m"; + aliases.ps = "pswrite"; + aliases.ps2 = "ps2write"; + aliases.psc = "pswrite"; + aliases.psc2 = "ps2write"; + aliases.tiff = "tiff24nc"; + aliases.tiffn = "tiff24nc"; +endfunction + diff --git a/octave_packages/m/plot/private/__quiver__.m b/octave_packages/m/plot/private/__quiver__.m new file mode 100644 index 0000000..2114132 --- /dev/null +++ b/octave_packages/m/plot/private/__quiver__.m @@ -0,0 +1,437 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hg} =} __quiver__ (@dots{}) +## Undocumented internal function. +## @end deftypefn + +function hg = __quiver__ (varargin) + + h = varargin{1}; + is3d = varargin{2}; + + autoscale = 0.9; + arrowsize = 0.2; + + firstnonnumeric = Inf; + for i = 3:nargin + if (! isnumeric (varargin{i})) + firstnonnumeric = i; + break; + endif + endfor + + ioff = 3; + if (nargin < (6 + is3d) || firstnonnumeric < (6 + is3d)) + u = varargin{ioff++}; + v = varargin{ioff++}; + if (is3d) + w = varargin{ioff++}; + [x, y, z] = meshgrid (1:size(u,2), 1:size(u,1), 1:max(size(w))); + else + [x, y] = meshgrid (1:size(u,2), 1:size(u,1)); + endif + if (nargin >= ioff && isnumeric (varargin{ioff}) + && isscalar (varargin{ioff})) + autoscale = varargin{ioff++}; + endif + else + x = varargin{ioff++}; + y = varargin{ioff++}; + if (is3d) + z = varargin{ioff++}; + endif + u = varargin{ioff++}; + v = varargin{ioff++}; + if (is3d) + w = varargin{ioff++}; + if (isvector (x) && isvector (y) && isvector (z) + && (! isvector (u) || ! isvector (v) || ! isvector(w))) + [x, y, z] = meshgrid (x, y, z); + endif + else + if (isvector (x) && isvector (y) && (! isvector (u) || ! isvector (v))) + [x, y] = meshgrid (x, y); + endif + endif + if (nargin >= ioff && isnumeric (varargin{ioff}) + && isscalar (varargin{ioff})) + autoscale = varargin{ioff++}; + endif + endif + + have_filled = false; + have_line_spec = false; + args = {}; + while (ioff <= nargin) + arg = varargin{ioff++}; + if (ischar (arg) && strncmpi (arg, "filled", 6)) + have_filled = true; + elseif ((ischar (arg) || iscell (arg)) + && ! have_line_spec) + [linespec, valid] = __pltopt__ ("quiver", arg, false); + if (valid) + have_line_spec = true; + if (strncmp (linespec.linestyle, "none", 4)) + linespec.linestyle = "-"; + endif + else + args {end + 1} = arg; + if (ioff <= nargin) + args {end + 1} = varargin{ioff++}; + endif + endif + else + args {end + 1} = arg; + if (ioff <= nargin) + args {end + 1} = varargin{ioff++}; + endif + endif + endwhile + + if (autoscale && numel (u) > 1) + ## Scale the arrows to fit in the grid + if (isvector (x)) + ny = nx = length (x); + else + [nx, ny] = size (x); + endif + dx = (max(x(:)) - min(x(:))) ./ nx; + dy = (max(y(:)) - min(y(:))) ./ ny; + if (is3d) + dz = (max(z(:)) - min(z(:))) ./ max (size (z)); + len = max (sqrt (u(:).^2 + v(:).^2 + w(:).^2)); + else + dz = 0; + len = max (sqrt (u(:).^2 + v(:).^2)); + endif + if (len > 0) + sd = sqrt (dx.^2 + dy.^2 + dz.^2) / len; + if (sd != 0) + s = sqrt(2) * autoscale * sd; + else # special case of identical points with multiple vectors + s = autoscale; + endif + uu = s * u; + vv = s * v; + if (is3d) + ww = s*w; + endif + endif + else + uu = u; + vv = v; + if (is3d) + ww = w; + endif + endif + + hstate = get (h, "nextplot"); + unwind_protect + hg = hggroup (); + if (is3d) + args = __add_datasource__ ("quiver3", hg, + {"x", "y", "z", "u", "v", "w"}, args{:}); + else + args = __add_datasource__ ("quiver", hg, + {"x", "y", "z", "u", "v", "w"}, args{:}); + endif + hold on; + + addproperty ("xdata", hg, "data", x); + addproperty ("ydata", hg, "data", y); + + addproperty ("udata", hg, "data", u); + addproperty ("vdata", hg, "data", v); + if (is3d) + addproperty ("zdata", hg, "data", z); + addproperty ("wdata", hg, "data", w); + else + addproperty ("zdata", hg, "data", []); + addproperty ("wdata", hg, "data", []); + endif + + addlistener (hg, "xdata", @update_data); + addlistener (hg, "ydata", @update_data); + addlistener (hg, "zdata", @update_data); + addlistener (hg, "udata", @update_data); + addlistener (hg, "vdata", @update_data); + addlistener (hg, "wdata", @update_data); + + x = x(:); + y = y(:); + xend = x + uu(:); + yend = y + vv(:); + if (is3d) + z = z(:); + zend = z + ww(:); + endif + + if (have_line_spec) + if (is3d) + h1 = plot3 ([x.'; xend.'; NaN(1, length (x))](:), + [y.'; yend.'; NaN(1, length (y))](:), + [z.'; zend.'; NaN(1, length (z))](:), + "linestyle", linespec.linestyle, + "color", linespec.color, "parent", hg); + else + h1 = plot ([x.'; xend.'; NaN(1, length (x))](:), + [y.'; yend.'; NaN(1, length (y))](:), + "linestyle", linespec.linestyle, + "color", linespec.color, "parent", hg); + endif + else + if (is3d) + h1 = plot3 ([x.'; xend.'; NaN(1, length (x))](:), + [y.'; yend.'; NaN(1, length (y))](:), + [z.'; zend.'; NaN(1, length (z))](:), + "color", "black", "parent", hg); + else + h1 = plot ([x.'; xend.'; NaN(1, length (x))](:), + [y.'; yend.'; NaN(1, length (y))](:), + "parent", hg); + endif + endif + + xtmp = x + uu(:) .* (1 - arrowsize); + ytmp = y + vv(:) .* (1 - arrowsize); + xarrw1 = xtmp + (y - yend) * arrowsize / 3; + xarrw2 = xtmp - (y - yend) * arrowsize / 3; + yarrw1 = ytmp - (x - xend) * arrowsize / 3; + yarrw2 = ytmp + (x - xend) * arrowsize / 3; + if (is3d) + zarrw1 = zarrw2 = zend - ww(:) * arrowsize; + endif + + if (have_line_spec) + if (isfield (linespec, "marker") + && ! strncmp (linespec.marker, "none", 4)) + if (is3d) + h2 = plot3 ([xarrw1.'; xend.'; xarrw2.'; NaN(1, length (x))](:), + [yarrw1.'; yend.'; yarrw2.'; NaN(1, length (y))](:), + [zarrw1.'; zend.'; zarrw2.'; NaN(1, length (z))](:), + "linestyle", "none", "parent", hg); + else + h2 = plot ([xarrw1.'; xend.'; xarrw2.'; NaN(1, length (x))](:), + [yarrw1.'; yend.'; yarrw2.'; NaN(1, length (y))](:), + "linestyle", "none", "parent", hg); + endif + else + if (is3d) + h2 = plot3 ([xarrw1.'; xend.'; xarrw2.'; NaN(1, length (x))](:), + [yarrw1.'; yend.'; yarrw2.'; NaN(1, length (y))](:), + [zarrw1.'; zend.'; zarrw2.'; NaN(1, length (z))](:), + "linestyle", linespec.linestyle, + "color", linespec.color, "parent", hg); + else + h2 = plot ([xarrw1.'; xend.'; xarrw2.'; NaN(1, length (x))](:), + [yarrw1.'; yend.'; yarrw2.'; NaN(1, length (y))](:), + "linestyle", linespec.linestyle, + "color", linespec.color, "parent", hg); + endif + endif + elseif (is3d) + h2 = plot3 ([xarrw1.'; xend.'; xarrw2.'; NaN(1, length (x))](:), + [yarrw1.'; yend.'; yarrw2.'; NaN(1, length (y))](:), + [zarrw1.'; zend.'; zarrw2.'; NaN(1, length (z))](:), + "color", "black", "parent", hg); + else + h2 = plot ([xarrw1.'; xend.'; xarrw2.'; NaN(1, length (x))](:), + [yarrw1.'; yend.'; yarrw2.'; NaN(1, length (y))](:), + "parent", hg); + endif + + if (! have_line_spec + || (isfield (linespec, "marker") + && strncmp (linespec.marker, "none", 4))) + if (is3d) + h3 = plot3 (x, y, z, "linestyle", "none", "marker", "none", + "parent", hg); + else + h3 = plot (x, y, "linestyle", "none", "marker", "none", "parent", hg); + endif + else + if (is3d) + h3 = plot3 (x, y, z, "linestyle", "none", "marker", linespec.marker, + "parent", hg); + else + + h3 = plot (x, y, "linestyle", "none", "marker", linespec.marker, + "parent", hg); + endif + endif + if (have_filled) + ## FIXME gnuplot doesn't respect the markerfacecolor field + set (h3, "markerfacecolor", get (h1, "color")); + endif + + ## Set up the hggroup properties and listeners + if (autoscale) + addproperty ("autoscale", hg, "radio", "{on}|off", "on"); + addproperty ("autoscalefactor", hg, "data", autoscale); + else + addproperty ("autoscale", hg, "radio", "{on}|off", "off"); + addproperty ("autoscalefactor", hg, "data", 1.0); + endif + addlistener (hg, "autoscale", @update_data); + addlistener (hg, "autoscalefactor", @update_data); + + addproperty ("maxheadsize", hg, "data", arrowsize); + addlistener (hg, "maxheadsize", @update_data); + + addproperty ("showarrowhead", hg, "radio", "{on}|off", "on"); + addlistener (hg, "showarrowhead", @update_props); + + addproperty ("color", hg, "linecolor", get (h1, "color")); + addproperty ("linewidth", hg, "linelinewidth", get (h1, "linewidth")); + addproperty ("linestyle", hg, "linelinestyle", get (h1, "linestyle")); + addproperty ("marker", hg, "linemarker", get (h3, "marker")); + addproperty ("markerfacecolor", hg, "linemarkerfacecolor", + get (h3, "markerfacecolor")); + addproperty ("markersize", hg, "linemarkersize", get (h3, "markersize")); + + addlistener (hg, "color", @update_props); + addlistener (hg, "linewidth", @update_props); + addlistener (hg, "linestyle", @update_props); + addlistener (hg, "marker", @update_props); + addlistener (hg, "markerfacecolor", @update_props); + addlistener (hg, "markersize", @update_props); + + if (! isempty (args)) + set (hg, args{:}); + endif + unwind_protect_cleanup + set (h, "nextplot", hstate); + end_unwind_protect + +endfunction + +function update_data (h, d) + x = get (h, "xdata"); + y = get (h, "ydata"); + z = get (h, "zdata"); + + u = get (h, "udata"); + v = get (h, "vdata"); + w = get (h, "wdata"); + + s = get (h, "autoscalefactor"); + arrowsize = get (h, "maxheadsize"); + + kids = get (h, "children"); + + if (isempty (z) || isempty (w)) + is3d = false; + else + is3d = true; + endif + + if (strcmpi (get (h, "autoscale"), "on") && s != 0) + ## Scale the arrows to fit in the grid + if (isvector (x)) + ny = nx = length (x); + else + [nx, ny] = size (x); + endif + dx = (max(x(:)) - min(x(:))) ./ nx; + dy = (max(y(:)) - min(y(:))) ./ ny; + if (is3d) + dz = (max(z(:)) - min(z(:))) ./ max (size (z)); + len = max (sqrt (u(:).^2 + v(:).^2 + w(:).^2)); + else + dz = 0; + len = max (sqrt (u(:).^2 + v(:).^2)); + endif + if (len > 0) + sd = sqrt (dx.^2 + dy.^2 + dz.^2) / len; + if (sd != 0) + s *= sqrt(2) * sd; + endif + u = s * u; + v = s * v; + if (is3d) + w = s*w; + endif + endif + endif + + x = x(:); + y = y(:); + xend = x + u(:); + yend = y + v(:); + if (is3d) + z = z(:); + zend = z + w(:); + endif + + set (kids (3), "xdata", [x.'; xend.'; NaN(1, length (x))](:)); + set (kids (3), "ydata", [y.'; yend.'; NaN(1, length (y))](:)); + if (is3d) + set (kids (3), "zdata", [z.'; zend.'; NaN(1, length (z))](:)); + endif + + xtmp = x + u(:) .* (1 - arrowsize); + ytmp = y + v(:) .* (1 - arrowsize); + xarrw1 = xtmp + (y - yend) * arrowsize / 3; + xarrw2 = xtmp - (y - yend) * arrowsize / 3; + yarrw1 = ytmp - (x - xend) * arrowsize / 3; + yarrw2 = ytmp + (x - xend) * arrowsize / 3; + if (is3d) + zarrw1 = zarrw2 = zend - w(:) * arrowsize; + endif + + set (kids (2), "xdata", [x.'; xend.'; NaN(1, length (x))](:)); + set (kids (2), "ydata", [y.'; yend.'; NaN(1, length (y))](:)); + if (is3d) + set (kids (2), "zdata", [z.'; zend.'; NaN(1, length (z))](:)); + endif + + set (kids (2), "xdata", [xarrw1.'; xend.'; xarrw2.'; NaN(1, length (x))](:)); + set (kids (2), "ydata", [yarrw1.'; yend.'; yarrw2.'; NaN(1, length (y))](:)); + if (is3d) + set (kids (2), "zdata", [zarrw1.'; zend.'; zarrw2.'; NaN(1, length (z))](:)); + endif + + set (kids (1), "xdata", x); + set (kids (1), "ydata", y); + if (is3d) + set (kids (1), "zdata", z); + endif + +endfunction + +function update_props (h, d) + kids = get (h, "children"); + + set (kids(3), "color", get (h, "color"), + "linewidth", get (h, "linewidth"), + "linestyle", get (h, "linestyle")); + set (kids(2), "color", get (h, "color"), + "linewidth", get (h, "linewidth"), + "linestyle", get (h, "linestyle")); + if (strcmpi (get (h, "showarrowhead"), "on")) + set (kids (2), "visible", "on"); + else + set (kids (2), "visible", "off"); + endif + set (kids(1), "color", get (h, "color"), + "marker", get (h, "marker"), + "markerfacecolor", get (h, "markerfacecolor"), + "markersize", get (h, "markersize")); +endfunction diff --git a/octave_packages/m/plot/private/__scatter__.m b/octave_packages/m/plot/private/__scatter__.m new file mode 100644 index 0000000..f504742 --- /dev/null +++ b/octave_packages/m/plot/private/__scatter__.m @@ -0,0 +1,377 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{hg} =} __scatter__ (@dots{}) +## Undocumented internal function. +## @end deftypefn + +function hg = __scatter__ (varargin) + + h = varargin{1}; + nd = varargin{2}; + fcn = varargin{3}; + x = varargin{4}(:); + y = varargin{5}(:); + istart = 6; + + if (nd == 3) + z = varargin{6}(:); + idx = isnan(x) | isnan (y) | isnan (z); + x (idx) = []; + y (idx) = []; + z (idx) = []; + istart = 7; + else + idx = isnan(x) | isnan (y); + x (idx) = []; + y (idx) = []; + z = zeros (length (x), 0); + endif + + firstnonnumeric = Inf; + for i = istart:nargin + if (! isnumeric (varargin{i})) + firstnonnumeric = i; + break; + endif + endfor + + if (istart <= nargin) + s = varargin{istart}; + if (isempty (s) || ischar (s)) + s = 6; + endif + if (! ischar (varargin{istart})) + istart++; + endif + else + s = 6; + endif + + if (istart <= nargin && firstnonnumeric > istart) + c = varargin{istart}; + if (isvector (c)) + if (columns (c) != 3) + c = c(:); + endif + endif + elseif (firstnonnumeric == istart && ischar (varargin{istart}) + && ! strcmpi (varargin{istart}, "filled")) + c = varargin{istart}; + firstnonnumeric++; + else + c = []; + endif + + newargs = {}; + filled = false; + have_marker = false; + marker = "o"; + iarg = firstnonnumeric; + while (iarg <= nargin) + arg = varargin{iarg++}; + if (ischar (arg) && strncmpi (arg, "filled", 6)) + filled = true; + elseif ((ischar (arg) || iscell (arg)) && ! have_marker) + [linespec, valid] = __pltopt__ (fcn, arg, false); + if (valid) + have_marker = true; + marker = linespec.marker; + if (strncmp (marker, "none", 4)) + marker = "o"; + elseif (isempty (marker)) + have_marker = false; + [dummy, marker] = __next_line_style__ (); + endif + else + error ("%s: invalid linespec", fcn); + endif + else + newargs{end+1} = arg; + if (iarg <= nargin) + newargs{end+1} = varargin{iarg++}; + endif + endif + endwhile + + if (isempty (c)) + c = __next_line_color__(); + endif + + hg = hggroup (); + newargs = __add_datasource__ (fcn, hg, {"x", "y", "z", "c", "size"}, + newargs{:}); + + addproperty ("xdata", hg, "data", x); + addproperty ("ydata", hg, "data", y); + addproperty ("zdata", hg, "data", z); + if (ischar (c)) + addproperty ("cdata", hg, "data", __color_str_rgb__ (c)); + else + addproperty ("cdata", hg, "data", c); + endif + addproperty ("sizedata", hg, "data", s); + addlistener (hg, "xdata", @update_data); + addlistener (hg, "ydata", @update_data); + addlistener (hg, "zdata", @update_data); + addlistener (hg, "cdata", @update_data); + addlistener (hg, "sizedata", @update_data); + + one_explicit_color = ischar (c) || isequal (size (c), [1, 3]); + + if (numel (x) <= 100) + + ## For small number of points, we'll construct an object for each point. + + if (numel (s) == 1) + s = repmat (s, numel(x), 1); + endif + + if (one_explicit_color) + for i = 1 : numel (x) + if (filled) + h = __go_patch__ (hg, "xdata", x(i), "ydata", y(i), "zdata", z(i,:), + "faces", 1, "vertices", [x(i), y(i), z(i,:)], + "facecolor", "none", "edgecolor", "none", + "marker", marker, "markersize", s(i), + "markeredgecolor", c, "markerfacecolor", c, + "linestyle", "none"); + else + h = __go_patch__ (hg, "xdata", x(i), "ydata", y(i), "zdata", z(i,:), + "faces", 1, "vertices", [x(i), y(i), z(i,:)], + "facecolor", "none", "edgecolor", "none", + "marker", marker, "markersize", s(i), + "markeredgecolor", c, "markerfacecolor", "none", + "linestyle", "none"); + endif + endfor + else + if (rows (c) == 1) + c = ones (rows (x), 1) * c; + endif + for i = 1 : numel (x) + if (filled) + h = __go_patch__ (hg, "xdata", x(i), "ydata", y(i), "zdata", z(i,:), + "faces", 1, "vertices", [x(i), y(i), z(i,:)], + "facecolor", "none", "edgecolor", "none", + "marker", marker, "markersize", s(i), + "markeredgecolor", "none", + "markerfacecolor", "flat", + "cdata", c(i,:), "facevertexcdata", c(i,:), + "linestyle", "none"); + else + h = __go_patch__ (hg, "xdata", x(i), "ydata", y(i), "zdata", z(i,:), + "faces", 1, "vertices", [x(i), y(i), z(i,:)], + "facecolor", "none", "edgecolor", "none", + "marker", marker, "markersize", s(i), + "markeredgecolor", "flat", + "markerfacecolor", "none", + "cdata", c(i,:), "facevertexcdata", c(i,:), + "linestyle", "none"); + + endif + endfor + endif + + else + + ## For larger numbers of points, we split the points by common color. + + vert = [x, y, z]; + if (one_explicit_color) + h = render_size_color (hg, vert, s, c, marker, filled, true); + else + if (rows (c) == 1) + c = ones (rows (x), 1) * c; + endif + ## We want to group points by colour. So first get all the unique colours + [cc, ~, c_to_cc] = unique (c, "rows"); + + for i = 1:rows (cc) + ## Now for each possible unique colour, get the logical index of + ## points that correspond to that colour + idx = (i == c_to_cc); + if (isscalar (s)) + h = render_size_color (hg, vert(idx, :), s, c(idx,:), + marker, filled, true); + else + h = render_size_color (hg, vert(idx, :), s(idx), c(idx,:), + marker, filled, true); + endif + endfor + + endif + endif + + if (! ischar (c) && rows (c) > 1) + ax = get (hg, "parent"); + clim = get (ax, "clim"); + if (min(c(:)) < clim(1)) + clim(1) = min(c(:)); + set (ax, "clim", clim); + endif + if (max(c(:)) > clim(2)) + set (ax, "clim", [clim(1), max(c(:))]); + endif + endif + + addproperty ("linewidth", hg, "patchlinewidth", 0.5); + addproperty ("marker", hg, "patchmarker", marker); + if (filled) + addproperty ("markeredgecolor", hg, "patchmarkeredgecolor", "none"); + if (one_explicit_color) + addproperty ("markerfacecolor", hg, "patchmarkerfacecolor", c); + else + addproperty ("markerfacecolor", hg, "patchmarkerfacecolor", "flat"); + endif + else + addproperty ("markerfacecolor", hg, "patchmarkerfacecolor", "none"); + if (one_explicit_color) + addproperty ("markeredgecolor", hg, "patchmarkeredgecolor", c); + else + addproperty ("markeredgecolor", hg, "patchmarkeredgecolor", "flat"); + endif + endif + addlistener (hg, "linewidth", @update_props); + addlistener (hg, "marker", @update_props); + addlistener (hg, "markerfacecolor", @update_props); + addlistener (hg, "markeredgecolor", @update_props); + + if (! isempty (newargs)) + set (hg, newargs{:}); + endif + +endfunction + +function h = render_size_color(hg, vert, s, c, marker, filled, isflat) + if (isscalar (s)) + x = vert(:,1); + y = vert(:,2); + z = vert(:,3:end); + toolkit = get (ancestor (hg, "figure"), "__graphics_toolkit__"); + ## Does gnuplot only support triangles with different vertex colors ? + ## TODO - Verify gnuplot can only support one color. If RGB triplets + ## can be assigned to each vertex, then fix __go_draw_axe__.m + gnuplot_hack = numel (x) > 1 && strcmp (toolkit, "gnuplot"); + if (ischar (c) || ! isflat || gnuplot_hack) + if (filled) + h = __go_patch__ (hg, "xdata", x, "ydata", y, "zdata", z, + "faces", 1:numel(x), "vertices", vert, + "facecolor", "none", "edgecolor", "none", + "marker", marker, + "markeredgecolor", "none", + "markerfacecolor", c(1,:), + "markersize", s, "linestyle", "none"); + else + h = __go_patch__ (hg, "xdata", x, "ydata", y, "zdata", z, + "faces", 1:numel(x), "vertices", vert, + "facecolor", "none", "edgecolor", "none", + "marker", marker, + "markeredgecolor", c(1,:), + "markerfacecolor", "none", + "markersize", s, "linestyle", "none"); + endif + else + if (filled) + h = __go_patch__ (hg, "xdata", x, "ydata", y, "zdata", z, + "faces", 1:numel(x), "vertices", vert, + "facecolor", "none", "edgecolor", "none", + "marker", marker, "markersize", s, + "markeredgecolor", "none", + "markerfacecolor", "flat", + "cdata", c, "facevertexcdata", c, + "linestyle", "none"); + else + h = __go_patch__ (hg, "xdata", x, "ydata", y, "zdata", z, + "faces", 1:numel(x), "vertices", vert, + "facecolor", "none", "edgecolor", "none", + "marker", marker, "markersize", s, + "markeredgecolor", "flat", + "markerfacecolor", "none", + "cdata", c, "facevertexcdata", c, + "linestyle", "none"); + endif + endif + else + ## FIXME: round the size to one decimal place. It's not quite right, though. + [ss, ~, s_to_ss] = unique (ceil (s*10) / 10); + for i = 1:rows (ss) + idx = (i == s_to_ss); + h = render_size_color (hg, vert(idx,:), ss(i), c, + marker, filled, isflat); + endfor + endif +endfunction + +function update_props (h, d) + lw = get (h, "linewidth"); + m = get (h, "marker"); + fc = get (h, "markerfacecolor"); + ec = get (h, "markeredgecolor"); + kids = get (h, "children"); + + for i = 1 : numel (kids) + set (kids (i), "linewidth", lw, "marker", m, "markerfacecolor", fc, + "edgecolor", ec); + endfor +endfunction + +function update_data (h, d) + x1 = get (h, "xdata"); + y1 = get (h, "ydata"); + z1 = get (h, "zdata"); + c1 = get (h, "cdata"); + if (!ischar (c1) && rows (c1) == 1) + c1 = repmat (c1, numel (x1), 1); + endif + size1 = get (h, "sizedata"); + if (numel (size1) == 1) + size1 = repmat (size1, numel (x1), 1); + endif + hlist = get (h, "children"); + if (ischar (c1)) + if (isempty (z1)) + for i = 1 : length (hlist) + set (hlist(i), "vertices", [x1(i), y1(i)], "cdata", c1, + "markersize", size1(i)); + endfor + else + for i = 1 : length (hlist) + set (hlist(i), "vertices", [x1(i), y1(i), z1(i)], "cdata", c1, + "markersize", size1(i)); + endfor + endif + else + if (isempty (z1)) + for i = 1 : length (hlist) + set (hlist(i), "vertices", [x1(i), y1(i)], "cdata", + reshape(c1(i,:),[1, size(c1)(2:end)]), + "facevertexcdata", c1(i,:), + "markersize", size1(i)); + endfor + else + for i = 1 : length (hlist) + set (hlist(i), "vertices", [x1(i), y1(i), z1(i)], "cdata", + reshape(c1(i,:),[1, size(c1)(2:end)]), + "facevertexcdata", c1(i,:), + "markersize", size1(i)); + endfor + endif + endif +endfunction diff --git a/octave_packages/m/plot/private/__stem__.m b/octave_packages/m/plot/private/__stem__.m new file mode 100644 index 0000000..97fa205 --- /dev/null +++ b/octave_packages/m/plot/private/__stem__.m @@ -0,0 +1,557 @@ +## Copyright (C) 2006-2012 Michel D. Schmid +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} __stem__ (@var{have_z}, @var{varargin}) +## Undocumented internal function. +## @end deftypefn + +## Author: Michel D. Schmid +## Adapted-by: jwe + +function h = __stem__ (have_z, varargin) + + if (have_z) + caller = "stem3"; + else + caller = "stem"; + endif + + [ax, varargin, nargin] = __plt_get_axis_arg__ (caller, varargin{:}); + + [x, y, z, dofill, llc, ls, mmc, ms, varargin] = ... + check_stem_arg (have_z, varargin{:}); + + oldax = gca (); + unwind_protect + axes (ax); + hold_state = get (ax, "nextplot"); + newplot (); + h = []; + + nx = rows (x); + for i = 1: columns (x) + if (have_z) + xt = x(:)'; + xt = [xt; xt; NaN(1, nx)](:); + yt = y(:)'; + yt = [yt; yt; NaN(1, nx)](:); + zt = z(:)'; + zt = [zeros(1, nx); zt; NaN(1, nx)](:); + else + xt = x(:, i)'; + xt = [xt; xt; NaN(1, nx)](:); + yt = y(:, i)'; + yt = [zeros(1, nx); yt; NaN(1, nx)](:); + endif + + hg = hggroup (); + h = [h; hg]; + args = __add_datasource__ (caller, hg, {"x", "y", "z"}, varargin{:}); + + if (i == 1) + set (ax, "nextplot", "add"); + endif + + if (isempty (llc)) + lc = __next_line_color__ (); + else + lc = llc; + endif + + if (isempty (mmc)) + mc = lc; + else + mc = mmc; + endif + + if (dofill) + fc = mc; + else + fc = "none"; + endif + + if (have_z) + h_stems = plot3 (xt, yt, zt, "color", lc, "linestyle", ls, + "parent", hg, x, y, z, "color", mc, + "marker", ms, "linestyle", "none", + "markerfacecolor", fc, "parent", hg); + + h_baseline = []; + else + h_stems = plot (xt, yt, "color", lc, "linestyle", ls, + "parent", hg, x(:,i), y(:, i), "color", mc, "marker", + ms, "linestyle", "none", "markerfacecolor", + fc, "parent", hg); + + x_axis_range = get (ax, "xlim"); + h_baseline = line (x_axis_range, [0, 0], "color", [0, 0, 0]); + set (h_baseline, "handlevisibility", "off"); + set (h_baseline, "xliminclude", "off"); + addlistener (ax, "xlim", @update_xlim); + addlistener (h_baseline, "ydata", @update_baseline); + addlistener (h_baseline, "visible", @update_baseline); + endif + + ## Setup the hggroup and listeners. + addproperty ("showbaseline", hg, "radio", "{on}|off"); + addproperty ("basevalue", hg, "data", 0); + addproperty ("baseline", hg, "data", h_baseline); + + if (!have_z) + addlistener (hg, "showbaseline", @show_baseline); + addlistener (hg, "basevalue", @move_baseline); + endif + + addproperty ("color", hg, "linecolor", lc); + addproperty ("linewidth", hg, "linelinewidth", 0.5); + addproperty ("linestyle", hg, "linelinestyle", ls); + addproperty ("marker", hg, "linemarker", ms); + addproperty ("markerfacecolor", hg, "linemarkerfacecolor", fc); + addproperty ("markersize", hg, "linemarkersize", 6); + + addlistener (hg, "color", @update_props); + addlistener (hg, "linewidth", @update_props); + addlistener (hg, "linestyle", @update_props); + addlistener (hg, "marker", @update_props); + addlistener (hg, "markerfacecolor", @update_props); + addlistener (hg, "markersize", @update_props); + + addproperty ("xdata", hg, "data", x(:, i)); + addproperty ("ydata", hg, "data", y(:, i)); + if (have_z) + addproperty ("zdata", hg, "data", z(:, i)); + else + addproperty ("zdata", hg, "data", []); + endif + + addlistener (hg, "xdata", @update_data); + addlistener (hg, "ydata", @update_data); + addlistener (hg, "zdata", @update_data); + + if (! isempty (args)) + set (hg, args{:}); + endif + if (i == 1 && !isempty(h_baseline)) + set (h_baseline, "parent", get (hg, "parent")); + endif + endfor + + unwind_protect_cleanup + set (ax, "nextplot", hold_state); + axes (oldax); + end_unwind_protect +endfunction + +function [x, y, z, dofill, lc, ls, mc, ms, newargs] = check_stem_arg (have_z, varargin) + + ## FIXME -- there seems to be a lot of duplicated code in this + ## function. It seems like it should be possible to simplify things + ## by combining some of the nearly identical code sections into + ## additional subfunctions. + + if (have_z) + caller = "stem3"; + else + caller = "stem"; + endif + + ## Remove prop/val pairs from data to consider. + i = 2; + newargs = {}; + while (i < length (varargin)) + if (ischar (varargin{i}) && !(strcmpi ("fill", varargin{i}) + || strcmpi ("filled", varargin{i}))) + newargs{end + 1} = varargin{i}; + newargs{end + 1} = varargin{i + 1}; + nargin = nargin - 2; + varargin(i:i+1) = []; + else + i++; + endif + endwhile + + ## set specifiers to default values. + [lc, ls, mc, ms] = set_default_values (); + dofill = 0; + fill_2 = 0; + linespec_2 = 0; + z = []; + + ## Check input arguments. + if (nargin == 2) + if (have_z) + z = varargin{1}; + x = 1:rows (z); + y = 1:columns (z); + else + y = varargin{1}; + if (isvector (y)) + x = 1:length (y); + elseif (ismatrix (y)) + x = 1:rows (y); + else + error ("stem: Y must be a matrix"); + endif # in each case, x & y will be defined + endif + elseif (nargin == 3) + ## Several possibilities + ## + ## 1. the real y data + ## 2. 'filled' + ## 3. line spec + if (ischar (varargin{2})) + ## Only 2. or 3. possible. + if (strcmpi ("fill", varargin{2}) || strcmpi ("filled", varargin{2})) + dofill = 1; + else + ## Parse the linespec. + [lc, ls, mc, ms] = stem_line_spec (caller, varargin{2}); + endif + if (have_z) + z = varargin{1}; + x = 1:rows (z); + y = 1:columns (z); + else + y = varargin{1}; + if (isvector (y)) + x = 1:length (y); + elseif (ismatrix (y)) + x = 1:rows (y); + else + error ("stem: Y must be a matrix"); + endif # in each case, x & y will be defined + endif + else + if (have_z) + error ("stem3: must define X, Y and Z"); + else + ## Must be the real y data. + x = varargin{1}; + y = varargin{2}; + if (! (ismatrix (x) && ismatrix (y))) + error ("stem: X and Y must be matrices"); + endif + endif + endif + elseif (nargin == 4) + ## Again, several possibilities: + ## + ## arg2 1. real y + ## arg2 2. 'filled' or linespec + ## arg3 1. real z + ## arg3 2. 'filled' or linespec + if (ischar (varargin{2})) + ## Only arg2 2. / arg3 1. & arg3 3. are possible. + if (strcmpi ("fill", varargin{2}) || strcmpi ("filled", varargin{2})) + dofill = 1; + fill_2 = 1; # Be sure, no second "fill" is in the arguments. + else + ## Must be a linespec. + [lc, ls, mc, ms] = stem_line_spec (caller, varargin{2}); + linespec_2 = 1; + endif + if (have_z) + z = varargin{1}; + x = 1:rows (z); + y = 1:columns (z); + else + y = varargin{1}; + if (isvector (y)) + x = 1:length (y); + elseif (ismatrix (y)) + x = 1:rows (y); + else + error ("stem: Y must be a matrix"); + endif # in each case, x & y will be defined + endif + else + if (have_z) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + if (! (ismatrix (x) && ismatrix (y) && ismatrix (z))) + error ("stem3: X, Y and Z must be matrices"); + endif + else + ## must be the real y data. + x = varargin{1}; + y = varargin{2}; + if (! (ismatrix (x) && ismatrix (y))) + error ("stem: X and Y must be matrices"); + endif + endif + endif # if ischar(varargin{2}) + if (! have_z) + ## varargin{3} must be char. + ## Check for "fill. + if ((strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled")) + && fill_2) + error ("stem: duplicate fill argument"); + elseif (strcmpi ("fill", varargin{3}) && linespec_2) + ## Must be "fill". + dofill = 1; + fill_2 = 1; + elseif ((strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled")) + && !linespec_2) + ## Must be "fill". + dofill = 1; + fill_2 = 1; + elseif (! linespec_2) + ## Must be linespec. + [lc, ls, mc, ms] = stem_line_spec (caller, varargin{3}); + linespec_2 = 1; + endif + endif + elseif (nargin == 5) + if (have_z) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + if (! (ismatrix (x) && ismatrix (y) && ismatrix (z))) + error ("stem3: X, Y and Z must be matrices"); + endif + else + x = varargin{1}; + y = varargin{2}; + if (! (ismatrix (x) && ismatrix (y))) + error ("stem: X and Y must be matrices"); + endif + endif + + if (! have_z) + if (strcmpi (varargin{3}, "fill") || strcmpi (varargin{3}, "filled")) + dofill = 1; + fill_2 = 1; # Be sure, no second "fill" is in the arguments. + else + ## Must be a linespec. + [lc, ls, mc, ms] = stem_line_spec (caller, varargin{3}); + linespec_2 = 1; + endif + endif + + ## Check for "fill". + if ((strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled")) + && fill_2) + error ("%s: duplicate fill argument", caller); + elseif ((strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled")) + && linespec_2) + ## Must be "fill". + dofill = 1; + fill_2 = 1; + elseif (!strcmpi (varargin{4}, "fill") && !strcmpi (varargin{4}, "filled") + && !linespec_2) + ## Must be linespec. + [lc, ls, mc, ms] = stem_line_spec (caller, varargin{4}); + linespec_2 = 1; + endif + elseif (nargin == 6 && have_z) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + if (! (ismatrix (x) && ismatrix (y) && ismatrix (z))) + error ("stem3: X, Y and Z must be matrices"); + endif + + if (strcmpi (varargin{4}, "fill") || strcmpi (varargin{4}, "filled")) + dofill = 1; + fill_2 = 1; # be sure, no second "fill" is in the arguments + else + ## Must be a linespec. + [lc, ls, mc, ms] = stem_line_spec (caller, varargin{4}); + linespec_2 = 1; + endif + + ## check for "fill" .. + if ((strcmpi (varargin{5}, "fill") || strcmpi (varargin{5}, "filled")) + && fill_2) + error ("stem3: duplicate fill argument"); + elseif ((strcmpi (varargin{5}, "fill") || strcmpi (varargin{5}, "filled")) + && linespec_2) + ## Must be "fill". + dofill = 1; + fill_2 = 1; + elseif (!strcmpi (varargin{5}, "fill") && !strcmpi (varargin{5}, "filled") + && !linespec_2) + ## Must be linespec. + [lc, ls, mc, ms] = stem_line_spec (caller, varargin{5}); + linespec_2 = 1; + endif + else + error ("%s: incorrect number of arguments", caller); + endif + + ## Check sizes of x, y and z. + if (have_z) + if (!size_equal (x, y, z)) + error ("stem3: inconsistent size of x, y and z"); + else + x = x(:); + y = y(:); + z = z(:); + endif + else + if (isvector (x)) + x = x(:); + if (isvector (y)) + if (length (x) != length (y)) + error ("stem: inconsistent size of x and y"); + else + y = y(:); + endif + else + if (length (x) == rows (y)) + x = repmat (x(:), 1, columns (y)); + else + error ("stem: inconsistent size of x and y"); + endif + endif + elseif (!size_equal (x, y)) + error ("stem: inconsistent size of x and y"); + endif + endif + +endfunction + +function [lc, ls, mc, ms] = stem_line_spec (caller, str) + if (! ischar (str)) + error ("%s: expecting argument to be \"fill\" or a string of specifiers", + caller); + endif + [lc, ls, mc, ms] = set_default_values (); + ## Parse the line specifier string. + cur_props = __pltopt__ ("stem", str, false); + for i = 1:length(cur_props) + if (isfield (cur_props(i), "color") && ! isempty (cur_props(i).color)); # means line color + mc = lc = cur_props(i).color; + elseif (isfield (cur_props(i), "linestyle")) + ls = cur_props(i).linestyle; + if (isempty (ls)) + ls = __next_line_style__ (); + endif + elseif (isfield (cur_props(i), "marker") && ! strcmpi (cur_props(i).marker, "none")) + ms = cur_props(i).marker; + if (isempty (ms)) + [dummy, ms] = __next_line_style__ (); + endif + endif + endfor +endfunction + +function [lc, ls, mc, ms] = set_default_values () + ## set default values + mc = []; + lc = []; + ls = "-"; + ms = "o"; +endfunction + +function update_xlim (h, d) + kids = get (h, "children"); + xlim = get (h, "xlim"); + + for i = 1 : length (kids) + obj = get (kids (i)); + if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline")) + if (any (get (obj.baseline, "xdata") != xlim)) + set (obj.baseline, "xdata", xlim); + endif + endif + endfor +endfunction + +function update_baseline (h, d) + visible = get (h, "visible"); + ydata = get (h, "ydata")(1); + + kids = get (get (h, "parent"), "children"); + for i = 1 : length (kids) + obj = get (kids (i)); + if (strcmp (obj.type, "hggroup") && isfield (obj, "baseline") + && obj.baseline == h) + ## Only alter if changed to avoid recursion of the listener functions + if (! strcmpi (get (kids(i), "showbaseline"), visible)) + set (kids (i), "showbaseline", visible); + endif + if (! strcmpi (get (kids(i), "basevalue"), visible)) + set (kids (i), "basevalue", ydata); + endif + endif + endfor +endfunction + +function show_baseline (h, d) + set (get (h, "baseline"), "visible", get (h, "showbaseline")); +endfunction + +function move_baseline (h, d) + b0 = get (h, "basevalue"); + bl = get (h, "baseline"); + + if (get (bl, "ydata") != [b0, b0]) + set (bl, "ydata", [b0, b0]); + endif + + kids = get (h, "children"); + yt = get(h, "ydata")(:)'; + ny = length (yt); + yt = [b0 * ones(1, ny); yt; NaN(1, ny)](:); + set (kids(2), "ydata", yt); +endfunction + +function update_props (h, d) + kids = get (h, "children"); + set (kids(2), "color", get (h, "color"), + "linewidth", get (h, "linewidth"), + "linestyle", get (h, "linestyle")); + set (kids(1), "color", get (h, "color"), + "marker", get (h, "marker"), + "markerfacecolor", get (h, "markerfacecolor"), + "markersize", get (h, "markersize")); +endfunction + +function update_data (h, d) + x = get (h, "xdata"); + y = get (h, "ydata"); + z = get (h, "zdata"); + + if (!isempty (z) && size_equal (x, y, z)) + error ("stem3: inconsistent size of x, y and z"); + elseif (numel(x) != numel (y)) + error ("stem: inconsistent size of x and y"); + else + bl = get (h, "basevalue"); + nx = numel (x); + x = x(:)'; + xt = [x; x; NaN(1, nx)](:); + if (! isempty (z)) + y = y(:)'; + yt = [y; y; NaN(1, nx)](:); + z = z(:)'; + zt = [bl * ones(1, nx); z; NaN(1, nx)](:); + else + y = y(:)'; + yt = [bl * ones(1, nx); y; NaN(1, nx)](:); + zt = []; + endif + + kids = get (h, "children"); + set (kids(2), "xdata", xt, "ydata", yt, "zdata", zt); + set (kids(1), "xdata", x, "ydata", y, "zdata", z); + endif +endfunction diff --git a/octave_packages/m/plot/private/__tight_eps_bbox__.m b/octave_packages/m/plot/private/__tight_eps_bbox__.m new file mode 100644 index 0000000..e93f21a --- /dev/null +++ b/octave_packages/m/plot/private/__tight_eps_bbox__.m @@ -0,0 +1,124 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{bbox} =} __tight_eps_bbox__ (@var{@dots{}}) +## Undocumented internal function. +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-07-26 + +function bb = __tight_eps_bbox__ (opts, eps_file_name) + + box_string = "%%BoundingBox:"; + + cmd = sprintf ("\"%s\" \"%s\" 2>&1", "head", eps_file_name); + [status, output] = system (cmd); + + if (status == 0) + orig_bbox_line = get_bbox (output); + else + error ("print:noboundingbox", + "print.m: no bounding box found in '%s'", eps_file_name); + endif + + ghostscript_options = "-q -dBATCH -dSAFER -dNOPAUSE -dTextAlphaBits=4 -sDEVICE=bbox"; + cmd = sprintf ("\"%s\" %s \"%s\" 2>&1", opts.ghostscript.binary, + ghostscript_options, eps_file_name); + [status, output] = system (cmd); + + if (status == 0) + tight_bbox_line = get_bbox (output); + else + warning ("print:nogsboundingbox", + "print.m: ghostscript failed to determine the bounding for '%s'", + eps_file_name); + endif + + ## Attempt to fix the bbox in place. + fid = fopen (eps_file_name, "r+"); + unwind_protect + bbox_replaced = false; + looking_for_bbox = true; + while (looking_for_bbox) + current_line = fgetl (fid); + if (strncmpi (current_line, box_string, numel(box_string))) + line_length = numel (current_line); + num_spaces = line_length - numel (tight_bbox_line); + if (numel (current_line) >= numel (tight_bbox_line)) + new_line = tight_bbox_line; + new_line(end+1:numel(current_line)) = " "; + bbox_replaced = true; + ## Back up to the beginning of the line (include EOL characters). + if (ispc ()) + fseek (fid, -line_length-2, "cof"); + else + fseek (fid, -line_length-1, "cof"); + endif + count = fprintf (fid, "%s", new_line); + endif + looking_for_bbox = false; + elseif (! ischar (current_line)) + looking_for_bbox = false; + endif + endwhile + unwind_protect_cleanup + fclose (fid); + end_unwind_protect + + ## If necessary load the eps-file and replace the bbox (can be slow). + if (! bbox_replaced) + fid = fopen (eps_file_name, "r"); + unwind_protect + data = char (fread (fid, Inf)).'; + unwind_protect_cleanup + fclose (fid); + end_unwind_protect + n = strfind (data, box_string); + if (numel (n) > 1) + ## Only replace one instance. + n = n(1); + elseif (isempty (n)) + error ("print:noboundingbox", ... + "print.m: no bounding box found in '%s'.", eps_file_name); + endif + m = numel (orig_bbox_line); + data = horzcat (data(1:(n-1)), tight_bbox_line, data((n+m):end)); + fid = fopen (eps_file_name, "w"); + unwind_protect + fprintf (fid, "%s", data); + unwind_protect_cleanup + fclose (fid); + end_unwind_protect + endif + +endfunction + +function bbox_line = get_bbox (lines) + box_string = "%%BoundingBox:"; + pattern = strcat (box_string, "[^%]*"); + pattern = pattern(1:find(double(pattern)>32, 1, "last")); + bbox_line = regexp (lines, pattern, "match"); + if (iscell (bbox_line)) + bbox_line = bbox_line{1}; + endif + ## Remove the EOL characters. + bbox_line(double(bbox_line)<32) = ""; +endfunction + diff --git a/octave_packages/m/plot/private/__uigetdir_fltk__.m b/octave_packages/m/plot/private/__uigetdir_fltk__.m new file mode 100644 index 0000000..a46ff99 --- /dev/null +++ b/octave_packages/m/plot/private/__uigetdir_fltk__.m @@ -0,0 +1,34 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dirname} =} __uigetdir_fltk__ (@var{start_path}, @var{dialog_title}) +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function dirname = __uigetdir_fltk__ (start_path, dialog_title) + + if (exist("__fltk_uigetfile__") != 3) + error ("uigetdir: fltk graphics toolkit required"); + endif + + dirname = __fltk_uigetfile__ ("", dialog_title, start_path, [240, 120], "dir"); + +endfunction diff --git a/octave_packages/m/plot/private/__uigetfile_fltk__.m b/octave_packages/m/plot/private/__uigetfile_fltk__.m new file mode 100644 index 0000000..ecc2f9e --- /dev/null +++ b/octave_packages/m/plot/private/__uigetfile_fltk__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} __uigetfile_fltk__ () +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function [retval, retpath, retindex] = __uigetfile_fltk__ (filters, title, defval, position, multiselect, defdir) + + if (exist("__fltk_uigetfile__") != 3) + error ("uigetfile: fltk graphics toolkit required"); + endif + + filters = __fltk_file_filter__ (filters); + if (length (defdir) > 0) + defval = fullfile (defdir, defval); + endif + [retval, retpath, retindex] = __fltk_uigetfile__ (filters, title, defval, position, multiselect); + +endfunction diff --git a/octave_packages/m/plot/private/__uiobject_split_args__.m b/octave_packages/m/plot/private/__uiobject_split_args__.m new file mode 100644 index 0000000..f553541 --- /dev/null +++ b/octave_packages/m/plot/private/__uiobject_split_args__.m @@ -0,0 +1,66 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{args}] =} __uiobject_split_args__ (@var{who}, @var{args}, @var{parent_type}, @var{use_gcf}) +## @end deftypefn + +## Author: goffioul + +function [parent, args] = __uiobject_split_args__ (who, in_args, parent_type = {}, use_gcf = 1) + + parent = []; + args = {}; + offset = 1; + + if (! isempty (in_args)) + if (ishandle (in_args{1})) + parent = in_args{1}; + offset = 2; + elseif (! ischar (in_args{1})) + error ("%s: invalid parent handle.", who); + endif + + args = in_args(offset:end); + endif + + if (rem (length (args), 2)) + error ("%s: expecting PROPERTY/VALUE pairs", who); + endif + + if (! isempty (args)) + i = find (strcmpi (args(1:2:end), "parent"), 1, "first"); + if (! isempty (i) && length (args) >= 2*i) + parent = args{2*i}; + if (! ishandle (parent)) + error ("%s: invalid parent handle.", who); + endif + args([2*i-1, 2*i]) = []; + endif + endif + + if (! isempty (parent)) + if (! isempty (parent_type) && isempty (find (strcmpi (get (parent, "type"), parent_type)))) + error ("%s: invalid parent, the parent type must be: %s", ... + who, sprintf ("%s, ", parent_type{:})(1:end-2)); + endif + elseif (use_gcf) + parent = gcf (); + endif + +endfunction diff --git a/octave_packages/m/plot/private/__uiputfile_fltk__.m b/octave_packages/m/plot/private/__uiputfile_fltk__.m new file mode 100644 index 0000000..688eae3 --- /dev/null +++ b/octave_packages/m/plot/private/__uiputfile_fltk__.m @@ -0,0 +1,38 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} __uiputfile_fltk__ () +## Undocumented internal function. +## @end deftypefn + +## Author: Michael Goffioul + +function [retval, retpath, retindex] = __uiputfile_fltk__ (filters, title, defval, position, tag, defdir) + + if (exist("__fltk_uigetfile__") != 3) + error ("uiputfile: fltk graphics toolkit required"); + endif + + filters = __fltk_file_filter__ (filters); + if (length (defdir) > 0) + defval = fullfile (defdir, defval); + endif + [retval, retpath, retindex] = __fltk_uigetfile__ (filters, title, defval, position, tag); + +endfunction diff --git a/octave_packages/m/plot/quiver.m b/octave_packages/m/plot/quiver.m new file mode 100644 index 0000000..c0257aa --- /dev/null +++ b/octave_packages/m/plot/quiver.m @@ -0,0 +1,99 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} quiver (@var{u}, @var{v}) +## @deftypefnx {Function File} {} quiver (@var{x}, @var{y}, @var{u}, @var{v}) +## @deftypefnx {Function File} {} quiver (@dots{}, @var{s}) +## @deftypefnx {Function File} {} quiver (@dots{}, @var{style}) +## @deftypefnx {Function File} {} quiver (@dots{}, 'filled') +## @deftypefnx {Function File} {} quiver (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} quiver (@dots{}) +## +## Plot the @code{(@var{u}, @var{v})} components of a vector field in +## an @code{(@var{x}, @var{y})} meshgrid. If the grid is uniform, you can +## specify @var{x} and @var{y} as vectors. +## +## If @var{x} and @var{y} are undefined they are assumed to be +## @code{(1:@var{m}, 1:@var{n})} where @code{[@var{m}, @var{n}] = +## size(@var{u})}. +## +## The variable @var{s} is a scalar defining a scaling factor to use for +## the arrows of the field relative to the mesh spacing. A value of 0 +## disables all scaling. The default value is 1. +## +## The style to use for the plot can be defined with a line style @var{style} +## in a similar manner to the line styles used with the @code{plot} command. +## If a marker is specified then markers at the grid points of the vectors are +## printed rather than arrows. If the argument 'filled' is given then the +## markers as filled. +## +## The optional return value @var{h} is a graphics handle to a quiver object. +## A quiver object regroups the components of the quiver plot (body, arrow, +## and marker), and allows them to be changed together. +## +## @example +## @group +## [x, y] = meshgrid (1:2:20); +## h = quiver (x, y, sin (2*pi*x/10), sin (2*pi*y/10)); +## set (h, "maxheadsize", 0.33); +## @end group +## @end example +## +## @seealso{plot} +## @end deftypefn + +function retval = quiver (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("quiver", varargin{:}); + + if (nargin < 2) + print_usage (); + else + oldh = gca (); + unwind_protect + axes (h); + newplot (); + tmp = __quiver__ (h, 0, varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!demo +%! clf +%! [x,y] = meshgrid (1:2:20); +%! h = quiver (x,y, sin (2*pi*x/10), sin (2*pi*y/10)); +%! set (h, "maxheadsize", 0.33); + +%!demo +%! clf +%! axis ("equal"); +%! x = linspace (0,3,80); +%! y = sin (2*pi*x); +%! theta = 2*pi*x + pi/2; +%! quiver (x, y, sin (theta)/10, cos (theta)/10); +%! hold on; plot(x,y,"r"); hold off; + diff --git a/octave_packages/m/plot/quiver3.m b/octave_packages/m/plot/quiver3.m new file mode 100644 index 0000000..3073c41 --- /dev/null +++ b/octave_packages/m/plot/quiver3.m @@ -0,0 +1,118 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} quiver3 (@var{u}, @var{v}, @var{w}) +## @deftypefnx {Function File} {} quiver3 (@var{x}, @var{y}, @var{z}, @var{u}, @var{v}, @var{w}) +## @deftypefnx {Function File} {} quiver3 (@dots{}, @var{s}) +## @deftypefnx {Function File} {} quiver3 (@dots{}, @var{style}) +## @deftypefnx {Function File} {} quiver3 (@dots{}, 'filled') +## @deftypefnx {Function File} {} quiver3 (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} quiver3 (@dots{}) +## +## Plot the @code{(@var{u}, @var{v}, @var{w})} components of a vector field in +## an @code{(@var{x}, @var{y}), @var{z}} meshgrid. If the grid is uniform, you +## can specify @var{x}, @var{y} @var{z} as vectors. +## +## If @var{x}, @var{y} and @var{z} are undefined they are assumed to be +## @code{(1:@var{m}, 1:@var{n}, 1:@var{p})} where @code{[@var{m}, @var{n}] = +## size(@var{u})} and @code{@var{p} = max (size (@var{w}))}. +## +## The variable @var{s} is a scalar defining a scaling factor to use for +## the arrows of the field relative to the mesh spacing. A value of 0 +## disables all scaling. The default value is 1. +## +## The style to use for the plot can be defined with a line style @var{style} +## in a similar manner to the line styles used with the @code{plot} command. +## If a marker is specified then markers at the grid points of the vectors are +## printed rather than arrows. If the argument 'filled' is given then the +## markers as filled. +## +## The optional return value @var{h} is a graphics handle to a quiver object. +## A quiver object regroups the components of the quiver plot (body, arrow, +## and marker), and allows them to be changed together. +## +## @example +## @group +## [x, y, z] = peaks (25); +## surf (x, y, z); +## hold on; +## [u, v, w] = surfnorm (x, y, z / 10); +## h = quiver3 (x, y, z, u, v, w); +## set (h, "maxheadsize", 0.33); +## @end group +## @end example +## +## @seealso{plot} +## @end deftypefn + +function retval = quiver3 (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("quiver3", varargin{:}); + + if (nargin < 2) + print_usage (); + else + oldh = gca (); + unwind_protect + axes (h); + newplot (); + tmp = __quiver__ (h, 1, varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + +%!demo +%! clf +%! colormap (jet (64)); +%! [x,y] = meshgrid (-1:0.1:1); +%! z = sin (2*pi * sqrt (x.^2+y.^2)); +%! theta = 2*pi * sqrt (x.^2+y.^2) + pi/2; +%! quiver3 (x, y, z, sin (theta), cos (theta), ones (size (z))); +%! hold on; +%! mesh (x,y,z); +%! hold off; + +%!demo +%! clf +%! [x, y, z] = peaks (25); +%! surf (x, y, z); +%! hold on; +%! [u, v, w] = surfnorm (x, y, z / 10); +%! h = quiver3 (x, y, z, u, v, w); +%! set (h, "maxheadsize", 0.33); +%! hold off; + +%!demo +%! clf +%! [x, y, z] = peaks (25); +%! surf (x, y, z); +%! hold on; +%! [u, v, w] = surfnorm (x, y, z / 10); +%! h = quiver3 (x, y, z, u, v, w); +%! set (h, "maxheadsize", 0.33); +%! hold off; +%! shading interp + diff --git a/octave_packages/m/plot/rectangle.m b/octave_packages/m/plot/rectangle.m new file mode 100644 index 0000000..152a7f0 --- /dev/null +++ b/octave_packages/m/plot/rectangle.m @@ -0,0 +1,222 @@ +## Copyright (C) 2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rectangle () +## @deftypefnx {Function File} {} rectangle (@dots{}, "Position", @var{pos}) +## @deftypefnx {Function File} {} rectangle (@dots{}, "Curvature", @var{curv}) +## @deftypefnx {Function File} {} rectangle (@dots{}, "EdgeColor", @var{ec}) +## @deftypefnx {Function File} {} rectangle (@dots{}, "FaceColor", @var{fc}) +## @deftypefnx {Function File} {@var{h} =} rectangle (@dots{}) +## +## Draw rectangular patch defined by @var{pos} and @var{curv}. The variable +## @code{@var{pos}(1:2)} defines the lower left-hand corner of the patch +## and @code{@var{pos}(3:4)} defines its width and height. By default, the +## value of @var{pos} is @code{[0, 0, 1, 1]}. +## +## The variable @var{curv} defines the curvature of the sides of the rectangle +## and may be a scalar or two-element vector with values between 0 and 1. +## A value of 0 represents no curvature of the side, whereas a value of 1 +## means that the side is entirely curved into the arc of a circle. +## If @var{curv} is a two-element vector, then the first element is the +## curvature along the x-axis of the patch and the second along y-axis. +## +## If @var{curv} is a scalar, it represents the curvature of the shorter of the +## two sides of the rectangle and the curvature of the other side is defined +## by +## +## @example +## min (pos (1:2)) / max (pos (1:2)) * curv +## @end example +## +## Other properties are passed to the underlying patch command. +## +## The optional return value @var{h} is a graphics handle to the created +## rectangle object. +## @end deftypefn +## @seealso{patch} + +function h = rectangle (varargin) + + [hax, varargin] = __plt_get_axis_arg__ ("rectangle", varargin{:}); + + tmp = __rectangle__ (hax, varargin{:}); + + if (nargout > 0) + h = tmp; + endif +endfunction + +function hg = __rectangle__ (hax, varargin) + + iarg = 1; + pos = [0, 0, 1, 1]; + curv2 = [0, 0]; + ec = [0, 0, 0]; + fc = "none"; + + while (iarg < length (varargin)) + arg = varargin{iarg}; + if (ischar(arg)) + if (strcmpi (arg, "position")) + pos = varargin{iarg+1}; + varargin(iarg:iarg+1) = []; + if (!isvector (pos) || numel (pos) != 4) + error ("rectangle: position must be a 4 element vector"); + endif + elseif (strcmpi (arg, "curvature")) + curv2 = varargin{iarg+1}; + varargin(iarg:iarg+1) = []; + if (!isnumeric (curv2) || (numel (curv2) != 1 && numel (curv2) != 2)) + error ("rectangle: curvature must be a 2 element vector or a scalar"); + endif + if (any (curv2 < 0) || any (curv2 > 1)) + error ("rectangle: curvature values must be between 0 and 1"); + endif + elseif (strcmpi (arg, "edgecolor")) + ec = varargin{iarg+1}; + varargin(iarg:iarg+1) = []; + elseif (strcmpi (arg, "facecolor")) + fc = varargin{iarg+1}; + varargin(iarg:iarg+1) = []; + else + iarg ++; + endif + else + iarg ++; + endif + endwhile + + if (numel (curv2) == 1) + [a, ai] = min (pos (3 : 4)); + [b, bi] = max (pos (3 : 4)); + if (ai < bi) + curv = [curv2, curv2 .* a ./ b]; + else + curv = [curv2 .* a ./ b, curv2]; + endif + else + curv = curv2; + endif + + if (all (curv) < 0.01) + ## Special case : no curvature + x = [pos(1), pos(1) + pos(3), pos(1) + pos(3), pos(1), pos(1)]; + y = [pos(2), pos(2), pos(2) + pos(4), pos(2) + pos(4), pos(2)]; + else + p = pi / 2 * [0 : 15] / 15; + c = curv .* pos(3 : 4) / 2; + cx = c(1) * sin (p) - c(1); + cy = c(2) * cos (p) - c(2); + x = [pos(1) - fliplr(cx), pos(1) + pos(3) + cx, ... + pos(1) + pos(3) + fliplr(cx), pos(1) - cx, pos(1)]; + y = [pos(2) - fliplr(cy), pos(2) - cy, pos(2) + pos(4) + fliplr(cy), ... + pos(2) + pos(4) + cy, pos(2) + c(2)]; + endif + + hg = hggroup (); + + h = patch ("xdata", x(:), "ydata", y(:), "facecolor", fc, "edgecolor", ec, ... + "parent", hg, varargin{:}); + + addproperty ("curvature", hg, "data", curv2); + addproperty ("position", hg, "data", pos); + addproperty ("edgecolor", hg, "patchedgecolor", get (h, "edgecolor")); + addproperty ("linewidth", hg, "patchlinewidth", get (h, "linewidth")); + addproperty ("linestyle", hg, "patchlinestyle", get (h, "linestyle")); + addproperty ("facecolor", hg, "patchfacecolor", get (h, "facecolor")); + + addlistener (hg, "curvature", @update_data); + addlistener (hg, "position", @update_data); + addlistener (hg, "edgecolor", @update_props); + addlistener (hg, "linewidth", @update_props); + addlistener (hg, "linestyle", @update_props); + addlistener (hg, "facecolor", @update_props); +endfunction + +function update_data (h, d) + persistent recursion = false; + + ## Don't allow recursion + if (!recursion) + unwind_protect + recursion = true; + + kids = get (h, "children"); + pos = get (h, "position"); + curv2 = get (h, "curvature"); + + if (numel (curv2) == 1) + [a, ai] = min (pos (3 : 4)); + [b, bi] = max (pos (3 : 4)); + if (ai < bi) + curv = [curv2, curv2 .* a ./ b]; + else + curv = [curv2 .* a ./ b, curv2]; + endif + else + curv = curv2; + endif + + if (all (curv) < 0.01) + ## Special case : no curvature + x = [pos(1), pos(1) + pos(3), pos(1) + pos(3), pos(1), pos(1)]; + y = [pos(2), pos(2), pos(2) + pos(4), pos(2) + pos(4), pos(2)]; + else + p = pi / 2 * [0 : 15] / 15; + c = curv .* pos(3 : 4) / 2; + cx = c(1) * sin (p) - c(1); + cy = c(2) * cos (p) - c(2); + x = [pos(1) - fliplr(cx), pos(1) + pos(3) + cx, ... + pos(1) + pos(3) + fliplr(cx), pos(1) - cx, pos(1)]; + y = [pos(2) - fliplr(cy), pos(2) - cy, pos(2) + pos(4) + fliplr(cy), ... + pos(2) + pos(4) + cy, pos(2) + c(2)]; + endif + + set (kids, "xdata", x, "ydata", y); + unwind_protect_cleanup + recursion = false; + end_unwind_protect + endif +endfunction + +function update_props (h, d) + kids = get (h, "children"); + set (kids, "edgecolor", get (h, "edgecolor"), + "linewidth", get (h, "linewidth"), + "linestyle", get (h, "linestyle"), + "facecolor", get (h, "facecolor")); +endfunction + + +%!demo +%! clf +%! axis equal +%! rectangle ("Position", [0.05, 0.05, 0.9, 0.9], "Curvature", [0.5, 0.5]); + +%!demo +%! clf +%! axis equal +%! rectangle ("Position", [0.05, 0.05, 0.9, 0.4], "Curvature", 1.0); + +%!demo +%! clf +%! axis equal +%! h = rectangle ("Position", [0.05, 0.05, 0.9, 0.4], "Curvature", 1.0); +%! set (h, "FaceColor", [0, 1, 0]); + diff --git a/octave_packages/m/plot/refresh.m b/octave_packages/m/plot/refresh.m new file mode 100644 index 0000000..adb5173 --- /dev/null +++ b/octave_packages/m/plot/refresh.m @@ -0,0 +1,42 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} refresh () +## @deftypefnx {Function File} {} refresh (@var{h}) +## Refresh a figure, forcing it to be redrawn. Called without an +## argument the current figure is redrawn, otherwise the figure pointed +## to by @var{h} is redrawn. +## @seealso{drawnow} +## @end deftypefn + +function refresh (h) + + if (nargin == 1) + if (!ishandle (h) || !strcmp (get (h, "type"), "figure")) + error ("refresh: expecting argument to be a valid figure handle"); + endif + elseif (nargin > 1) + print_usage (); + else + h = gcf (); + endif + + set(h,"__modified__", "on"); + drawnow (); +endfunction diff --git a/octave_packages/m/plot/refreshdata.m b/octave_packages/m/plot/refreshdata.m new file mode 100644 index 0000000..241037a --- /dev/null +++ b/octave_packages/m/plot/refreshdata.m @@ -0,0 +1,117 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} refreshdata () +## @deftypefnx {Function File} {} refreshdata (@var{h}) +## @deftypefnx {Function File} {} refreshdata (@var{h}, @var{workspace}) +## Evaluate any @samp{datasource} properties of the current figure and update +## the plot if the corresponding data has changed. If called with one or more +## arguments @var{h} is a scalar or array of figure handles to refresh. The +## optional second argument @var{workspace} can take the following values. +## +## @table @asis +## @item "base" +## Evaluate the datasource properties in the base workspace. (default). +## +## @item "caller" +## Evaluate the datasource properties in the workspace of the function +## that called @code{refreshdata}. +## @end table +## +## An example of the use of @code{refreshdata} is: +## +## @example +## @group +## x = 0:0.1:10; +## y = sin (x); +## plot (x, y, "ydatasource", "y"); +## for i = 1 : 100 +## pause (0.1); +## y = sin (x + 0.1*i); +## refreshdata (); +## endfor +## @end group +## @end example +## @end deftypefn + +function refreshdata (h, workspace) + + if (nargin == 0) + h = gcf (); + workspace = "base"; + else + if (iscell (h)) + h = [h{:}]; + endif + if (!all (ishandle (h)) || !all (strcmp (get (h, "type"), "figure"))) + error ("refreshdata: expecting a list of figure handles"); + endif + if (nargin < 2) + workspace = "base"; + else + if ( !ischar (workspace) + || !(strcmpi (workspace, "base") + || strcmpi (workspace, "caller"))) + error ("refreshdata: expecting WORKSPACE to be \"base\" or ""caller\""); + else + workspace = tolower (workspace); + endif + endif + endif + + h = findall (h); + objs = []; + props = {}; + + for i = 1 : numel (h) + obj = get (h (i)); + fldnames = fieldnames (obj); + m = regexpi (fieldnames(obj), '^.+datasource$', "match"); + idx = ! cellfun ("isempty", m); + if (any (idx)) + tmp = m(idx); + props = [props; {vertcat(tmp{:})}]; + objs = [objs ; h(i)]; + endif + endfor + + for i = 1 : length (objs) + for j = 1 : length (props {i}) + expr = get (objs(i), props{i}{j}); + if (!isempty (expr)) + val = evalin (workspace, expr); + prop = props{i}{j}(1:end-6); + if (! isequal (get (objs(i), prop), val)) + set (objs(i), props{i}{j}(1:end-6), val); + endif + endif + endfor + endfor +endfunction + +%!demo +%! clf +%! x = 0:0.1:10; +%! y = sin (x); +%! plot (x, y, "ydatasource", "y"); +%! for i = 1 : 100 +%! pause(0.1) +%! y = sin (x + 0.1 * i); +%! refreshdata(gcf(), "caller"); +%! endfor diff --git a/octave_packages/m/plot/ribbon.m b/octave_packages/m/plot/ribbon.m new file mode 100644 index 0000000..2d61474 --- /dev/null +++ b/octave_packages/m/plot/ribbon.m @@ -0,0 +1,95 @@ +## Copyright (C) 2007-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ribbon (@var{x}, @var{y}, @var{width}) +## @deftypefnx {Function File} {} ribbon (@var{y}) +## @deftypefnx {Function File} {@var{h} =} ribbon (@dots{}) +## Plot a ribbon plot for the columns of @var{y} vs. @var{x}. The +## optional parameter @var{width} specifies the width of a single ribbon +## (default is 0.75). If @var{x} is omitted, a vector containing the +## row numbers is assumed (1:rows(Y)). +## +## The optional return value @var{h} is a vector of graphics handles to +## the surface objects representing each ribbon. +## @end deftypefn + +## Author: Kai Habel + +function h = ribbon (x, y, width) + + newplot (); + + if (nargin == 1) + y = x; + if (isvector (y)) + y = y(:); + endif + [nr, nc] = size (y); + x = repmat ((1:nr)', 1, nc); + width = 0.75; + elseif (nargin == 2) + width = 0.75; + elseif (nargin != 3) + print_usage (); + endif + + if (isvector (x) && isvector (y)) + if (length (x) != length (y)) + error ("ribbon: in case of vectors, X and Y must have same length"); + else + [x, y] = meshgrid (x, y); + endif + else + if (! size_equal(x, y)) + error ("ribbon: in case of matrices, X and Y must have same size"); + endif + endif + + [nr, nc] = size (y); + tmp = zeros (1, nc); + + for c = nc:-1:1 + zz = [y(:,c), y(:,c)]; + yy = x(:,c); + xx = [c - width / 2, c + width / 2]; + [xx, yy] = meshgrid (xx, yy); + cc = ones (size (zz)) * c; + tmp(c) = surface (xx, yy, zz, cc); + endfor + + ax = get (tmp(c), "parent"); + + if (! ishold ()) + set (ax, "view", [-37.5, 30], "box", "off", "xgrid", "on", + "ygrid", "on", "zgrid", "on"); + endif + + if (nargout > 0) + h = tmp; + endif + +endfunction + + +%!demo +%! clf +%! [x, y, z] = sombrero (); +%! [x, y] = meshgrid (x, y); +%! ribbon (y, z); + diff --git a/octave_packages/m/plot/rose.m b/octave_packages/m/plot/rose.m new file mode 100644 index 0000000..ef8faf3 --- /dev/null +++ b/octave_packages/m/plot/rose.m @@ -0,0 +1,111 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rose (@var{th}, @var{r}) +## @deftypefnx {Function File} {} rose (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} rose (@dots{}) +## @deftypefnx {Function File} {[@var{r}, @var{th}] =} rose (@dots{}) +## +## Plot an angular histogram. With one vector argument @var{th}, plots the +## histogram with 20 angular bins. If @var{th} is a matrix, then each column +## of @var{th} produces a separate histogram. +## +## If @var{r} is given and is a scalar, then the histogram is produced with +## @var{r} bins. If @var{r} is a vector, then the center of each bin are +## defined by the values of @var{r}. +## +## The optional return value @var{h} is a vector of graphics handles to the +## line objects representing each histogram. +## +## If two output arguments are requested then, rather than plotting the +## histogram, the polar vectors necessary to plot the histogram are +## returned. +## +## @example +## @group +## [r, t] = rose ([2*randn(1e5,1), pi + 2*randn(1e5,1)]); +## polar (r, t); +## @end group +## @end example +## +## @seealso{polar, compass, hist} +## @end deftypefn + +function [thout, rout] = rose (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ((nargout > 1), "rose", + varargin{:}); + + if (nargin < 1) + print_usage (); + endif + + ## Force theta to [0,2*pi] range + th = varargin {1}; + th = atan2 (sin (th), cos (th)) + pi; + + if (nargin > 1) + x = varargin {2}; + if (isscalar (x)) + x = [0.5/x : 1/x : 1] * 2 * pi; + else + ## Force theta to [0,2*pi] range + x = atan2 (sin (x), cos (x)) + pi; + endif + else + x = [1/40 : 1/20 : 1] * 2 * pi; + endif + + [nn, xx] = hist (th, x); + xx = xx(:).'; + if (isvector (nn)) + nn = nn (:); + endif + x1 = xx(1:end-1) + diff (xx, 1) / 2; + x1 = [x1 ; x1; x1; x1](:); + th = [0; 0; x1; 2*pi ; 2*pi]; + r = zeros (4 * size (nn, 1), size (nn, 2)); + r(2:4:end, :) = nn; + r(3:4:end, :) = nn; + + if (nargout < 2) + oldh = gca (); + unwind_protect + axes (h); + newplot (); + hlist = polar (h, th, r); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + thout = hlist; + endif + else + thout = th; + rout = r; + endif + +endfunction + + +%!demo +%! clf +%! rose ([2*randn(1e5, 1), pi + 2*randn(1e5, 1)]); + diff --git a/octave_packages/m/plot/saveas.m b/octave_packages/m/plot/saveas.m new file mode 100644 index 0000000..0b10775 --- /dev/null +++ b/octave_packages/m/plot/saveas.m @@ -0,0 +1,107 @@ +## Copyright (C) 2010-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} saveas (@var{h}, @var{filename}) +## @deftypefnx {Function File} {} saveas (@var{h}, @var{filename}, @var{fmt}) +## Save graphic object @var{h} to the file @var{filename} in graphic +## format @var{fmt}. +## +## @var{fmt} should be one of the following formats: +## +## @table @code +## @item ps +## Postscript +## +## @item eps +## Encapsulated Postscript +## +## @item jpg +## JPEG Image +## +## @item png +## PNG Image +## +## @item emf +## Enhanced Meta File +## +## @item pdf +## Portable Document Format +## @end table +## +## All device formats specified in @code{print} may also be used. If +## @var{fmt} is omitted it is extracted from the extension of @var{filename}. +## The default format is @code{"pdf"}. +## +## @example +## @group +## clf (); +## surf (peaks); +## saveas (1, "figure1.png"); +## @end group +## @end example +## +## @seealso{print} +## @end deftypefn + +## Author: Kai Habel + +function saveas (h, filename, fmt = "pdf") + + if ((nargin != 2) && (nargin != 3)) + print_usage (); + endif + + if (ishandle (h)) + if (isfigure (h)) + fig = h; + else + fig = ancestor (h, "figure"); + endif + else + error ("saveas: first argument H must be a graphics handle"); + endif + + if (!ischar (filename)) + error ("saveas: FILENAME must be a string"); + endif + + if (nargin == 2) + [~, ~, ext] = fileparts (filename); + if (!isempty (ext)) + fmt = ext(2:end); + endif + endif + + if (nargin == 3) + if (!ischar (filename)) + error ("saveas: EXT must be a string"); + endif + + [~, ~, ext] = fileparts (filename); + + if (isempty (ext)) + filename = strcat (filename, ".", fmt); + endif + endif + + prt_opt = strcat ("-d", tolower (fmt)); + + print (filename, prt_opt); + +endfunction diff --git a/octave_packages/m/plot/scatter.m b/octave_packages/m/plot/scatter.m new file mode 100644 index 0000000..bd794f7 --- /dev/null +++ b/octave_packages/m/plot/scatter.m @@ -0,0 +1,183 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} scatter (@var{x}, @var{y}) +## @deftypefnx {Function File} {} scatter (@var{x}, @var{y}, @var{s}) +## @deftypefnx {Function File} {} scatter (@var{x}, @var{y}, @var{c}) +## @deftypefnx {Function File} {} scatter (@var{x}, @var{y}, @var{s}, @var{c}) +## @deftypefnx {Function File} {} scatter (@var{x}, @var{y}, @var{s}, @var{c}, @var{style}) +## @deftypefnx {Function File} {} scatter (@var{x}, @var{y}, @var{s}, @var{c}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {} scatter (@dots{}, "filled") +## @deftypefnx {Function File} {} scatter (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} scatter (@dots{}) +## +## Plot a scatter plot of the data. A marker is plotted at each point +## defined by the points in the vectors @var{x} and @var{y}. The size of +## the markers used is determined by the @var{s}, which can be a scalar, +## a vector of the same length of @var{x} and @var{y}. If @var{s} is not +## given or is an empty matrix, then the default value of 8 points is used. +## +## The color of the markers is determined by @var{c}, which can be a string +## defining a fixed color; a 3-element vector giving the red, green,and blue +## components of the color; a vector of the same length as @var{x} that gives +## a scaled index into the current colormap; or a @var{n}-by-3 matrix defining +## the colors of each of the markers individually. +## +## The marker to use can be changed with the @var{style} argument, that is a +## string defining a marker in the same manner as the @code{plot} command. +## If the argument @code{"filled"} is given then the markers as filled. All +## additional arguments are passed to the underlying patch command. +## +## The optional return value @var{h} provides a handle to the patch object +## +## @example +## @group +## x = randn (100, 1); +## y = randn (100, 1); +## scatter (x, y, [], sqrt(x.^2 + y.^2)); +## @end group +## @end example +## +## @seealso{plot, patch, scatter3} +## @end deftypefn + +function retval = scatter (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("scatter", varargin{:}); + + if (nargin < 2) + print_usage (); + else + oldh = gca (); + unwind_protect + axes (h); + newplot (); + tmp = __scatter__ (h, 2, "scatter", varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!demo +%! clf +%! x = randn (100, 1); +%! y = randn (100, 1); +%! scatter (x, y, "r"); + +%!demo +%! clf +%! x = randn (100, 1); +%! y = randn (100, 1); +%! scatter (x, y, [], sqrt (x.^2 + y.^2)); + +%!demo +%! clf +%! rand_10x1_data1 = [0.171577, 0.404796, 0.025469, 0.335309, 0.047814, 0.898480, 0.639599, 0.700247, 0.497798, 0.737940]; +%! rand_10x1_data2 = [0.75495, 0.83991, 0.80850, 0.73603, 0.19360, 0.72573, 0.69371, 0.74388, 0.13837, 0.54143]; +%! x = rand_10x1_data1; +%! y = rand_10x1_data2; +%! s = 10 - 10*log (x.^2 + y.^2); +%! h = scatter (x, y, s, s, "s", "filled"); + +%!demo +%! clf +%! rand_10x1_data3 = [0.42262, 0.51623, 0.65992, 0.14999, 0.68385, 0.55929, 0.52251, 0.92204, 0.19762, 0.93726]; +%! rand_10x1_data4 = [0.020207, 0.527193, 0.443472, 0.061683, 0.370277, 0.947349, 0.249591, 0.666304, 0.134247, 0.920356]; +%! x = rand_10x1_data3; +%! y = rand_10x1_data4; +%! s = 10 - 10*log (x.^2 + y.^2); +%! h = scatter (x, y, [], "r", "s", "filled"); + +%!demo +%! clf +%! rand_10x1_data5 = [0.777753, 0.093848, 0.183162, 0.399499, 0.337997, 0.686724, 0.073906, 0.651808, 0.869273, 0.137949]; +%! rand_10x1_data6 = [0.37460, 0.25027, 0.19510, 0.51182, 0.54704, 0.56087, 0.24853, 0.75443, 0.42712, 0.44273]; +%! x = rand_10x1_data5; +%! y = rand_10x1_data6; +%! s = 10 - 10*log (x.^2 + y.^2); +%! h = scatter (x, y, [], "r", "s"); + +%!demo +%! k = 1; +%! clf +%! for m = [1, 3] +%! for n = [101, 50, 1] +%! x = rand (n, 1); +%! y = rand (n, 1); +%! if (m > 1) +%! str = "Three Colors"; +%! idx = ceil (rand (n, 1) * 3); +%! colors = eye(3); +%! colors = colors(idx, :); +%! else +%! str = "Random Colors"; +%! colors = rand (n, m); +%! endif +%! if (n == 1) +%! str = sprintf ("%s: 1 point", str); +%! elseif (n < 100) +%! str = sprintf ("%s: < 100 points", str); +%! else +%! str = sprintf ("%s: > 100 points", str); +%! endif +%! subplot (2, 3, k) +%! k = k + 1; +%! scatter (x, y, 15, colors, "filled") +%! axis ([0 1 0 1]) +%! title (str) +%! endfor +%! endfor + +%!demo +%! k = 1; +%! clf +%! for m = [1, 3] +%! for n = [101, 50, 1] +%! x = rand (n, 1); +%! y = rand (n, 1); +%! if (m > 1) +%! str = "Three Colors"; +%! idx = ceil (rand (n, 1) * 3); +%! colors = eye(3); +%! colors = colors(idx, :); +%! else +%! str = "Random Colors"; +%! colors = rand (n, m); +%! endif +%! if (n == 1) +%! str = sprintf ("%s: 1 point", str); +%! elseif (n < 100) +%! str = sprintf ("%s: < 100 points", str); +%! else +%! str = sprintf ("%s: > 100 points", str); +%! endif +%! subplot (2, 3, k) +%! k = k + 1; +%! scatter (x, y, 15, colors) +%! axis ([0 1 0 1]) +%! title (str) +%! endfor +%! endfor diff --git a/octave_packages/m/plot/scatter3.m b/octave_packages/m/plot/scatter3.m new file mode 100644 index 0000000..f166f80 --- /dev/null +++ b/octave_packages/m/plot/scatter3.m @@ -0,0 +1,111 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} scatter3 (@var{x}, @var{y}, @var{z}, @var{s}, @var{c}) +## @deftypefnx {Function File} {} scatter3 (@dots{}, 'filled') +## @deftypefnx {Function File} {} scatter3 (@dots{}, @var{style}) +## @deftypefnx {Function File} {} scatter3 (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {} scatter3 (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} scatter3 (@dots{}) +## +## Plot a scatter plot of the data in 3D@. A marker is plotted at each point +## defined by the points in the vectors @var{x}, @var{y} and @var{z}. The size +## of the markers used is determined by @var{s}, which can be a scalar or +## a vector of the same length of @var{x}, @var{y} and @var{z}. If @var{s} is +## not given or is an empty matrix, then the default value of 8 points is used. +## +## The color of the markers is determined by @var{c}, which can be a string +## defining a fixed color; a 3-element vector giving the red, green, and blue +## components of the color; a vector of the same length as @var{x} that gives +## a scaled index into the current colormap; or a @var{n}-by-3 matrix defining +## the colors of each of the markers individually. +## +## The marker to use can be changed with the @var{style} argument, that is a +## string defining a marker in the same manner as the @code{plot} command. +## If the argument 'filled' is given then the markers as filled. All +## additional arguments are passed to the underlying patch command. +## +## The optional return value @var{h} is a graphics handle to the hggroup +## object representing the points. +## +## @example +## @group +## [x, y, z] = peaks (20); +## scatter3 (x(:), y(:), z(:), [], z(:)); +## @end group +## @end example +## +## @seealso{plot, patch, scatter} +## @end deftypefn + +function retval = scatter3 (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("scatter3", varargin{:}); + + if (nargin < 2) + print_usage (); + else + oldh = gca (); + unwind_protect + axes (h); + newplot (); + tmp = __scatter__ (h, 3, "scatter3", varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + endif + + if (! ishold ()) + set (h, "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!demo +%! clf +%! [x, y, z] = peaks (20); +%! scatter3 (x(:), y(:), z(:), [], z(:)); + +%!demo +%! clf +%! x = rand (20,1); +%! y = rand (20,1); +%! z = rand (20,1); +%! scatter3 (x(:), y(:), z(:), 10, z(:), "s"); + +%!demo +%! clf +%! x = rand (20,1); +%! y = rand (20,1); +%! z = rand (20,1); +%! scatter3 (x(:), y(:), z(:), 20*z(:), z(:), "s"); + +%!demo +%! clf +%! x = rand (20,1); +%! y = rand (20,1); +%! z = rand (20,1); +%! scatter3 (x(:), y(:), z(:), 20*z(:), [], "s"); + diff --git a/octave_packages/m/plot/semilogx.m b/octave_packages/m/plot/semilogx.m new file mode 100644 index 0000000..830e145 --- /dev/null +++ b/octave_packages/m/plot/semilogx.m @@ -0,0 +1,123 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} semilogx (@var{y}) +## @deftypefnx {Function File} {} semilogx (@var{x}, @var{y}) +## @deftypefnx {Function File} {} semilogx (@var{x}, @var{y}, @var{property}, @var{value}, @dots{}) +## @deftypefnx {Function File} {} semilogx (@var{x}, @var{y}, @var{fmt}) +## @deftypefnx {Function File} {} semilogx (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} semilogx (@dots{}) +## Produce a two-dimensional plot using a logarithmic scale for the @var{x} +## axis. See the documentation of @code{plot} for a description of the +## arguments that @code{semilogx} will accept. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## @seealso{plot, semilogy, loglog} +## @end deftypefn + +## Author: jwe + +function retval = semilogx (varargin) + + [h, varargin, nargs] = __plt_get_axis_arg__ ("semilogx", varargin{:}); + + if (nargs < 1) + print_usage(); + endif + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + set (h, "xscale", "log"); + if (any( strcmp (get (gca, "nextplot"), {"new", "replace"}))) + set (h, "xminortick", "on"); + endif + + tmp = __plt__ ("semilogx", h, varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + + +%!demo +%! clf (); +%! x = 1:0.01:10; +%! y = (x .* (1 + rand (size (x)))) .^ 2; +%! semilogx (y, x); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1); +%! semilogx (x, y); +%! xlabel ("semilogx (x, y)"); +%! +%! subplot (1, 2, 2); +%! semilogx (-x, y); +%! xlabel ("semilogx (-x, y)"); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (1, 2, 1); +%! semilogx (x, y); +%! set (gca, "xdir", "reverse", "activepositionproperty", "outerposition") +%! xlabel ({"semilogx (x, y)", "xdir = reversed"}) +%! +%! subplot (1, 2, 2); +%! semilogx (-x, y); +%! set (gca, "xdir", "reverse", "activepositionproperty", "outerposition"); +%! xlabel ({"semilogx (-x, y)", "xdir = reversed"}); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! semilogx (a, b) +%! assert (get (gca, "xscale"), "log"); +%! assert (get (gca, "yscale"), "linear"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a =-logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! semilogx (a, b); +%! axis tight; +%! assert (all (get (gca, "xtick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/semilogxerr.m b/octave_packages/m/plot/semilogxerr.m new file mode 100644 index 0000000..f9d6a6c --- /dev/null +++ b/octave_packages/m/plot/semilogxerr.m @@ -0,0 +1,69 @@ +## Copyright (C) 2000-2012 Teemu Ikonen +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} semilogxerr (@var{args}) +## Produce two-dimensional plots using a logarithmic scale for the @var{x} +## axis and errorbars at each data point. Many different combinations of +## arguments are possible. The most used form is +## +## @example +## semilogxerr (@var{x}, @var{y}, @var{ey}, @var{fmt}) +## @end example +## +## @noindent +## which produces a semi-logarithmic plot of @var{y} versus @var{x} +## with errors in the @var{y}-scale defined by @var{ey} and the plot +## format defined by @var{fmt}. See @code{errorbar} for available formats and +## additional information. +## @seealso{errorbar, loglogerr, semilogyerr} +## @end deftypefn + +## Created: 20.2.2001 +## Author: Teemu Ikonen +## Keywords: errorbar, plotting + +function retval = semilogxerr (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("semilogxerr", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + set (h, "xscale", "log"); + + tmp = __errcomm__ ("semilogxerr", h, varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +%!demo +%! clf +%! x = exp (log(0.01):0.2:log(10)); +%! y = wblpdf (x, 2, 2); +%! ey = 0.5*rand (size (y)) .* y; +%! semilogxerr (x, y, ey, "#~x-") +%! xlim (x([1, end])) diff --git a/octave_packages/m/plot/semilogy.m b/octave_packages/m/plot/semilogy.m new file mode 100644 index 0000000..38db655 --- /dev/null +++ b/octave_packages/m/plot/semilogy.m @@ -0,0 +1,123 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} semilogy (@var{y}) +## @deftypefnx {Function File} {} semilogy (@var{x}, @var{y}) +## @deftypefnx {Function File} {} semilogy (@var{x}, @var{y}, @var{property}, @var{value}, @dots{}) +## @deftypefnx {Function File} {} semilogy (@var{x}, @var{y}, @var{fmt}) +## @deftypefnx {Function File} {} semilogy (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} semilogy (@dots{}) +## Produce a two-dimensional plot using a logarithmic scale for the @var{y} +## axis. See the documentation of @code{plot} for a description of the +## arguments that @code{semilogy} will accept. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## @seealso{plot, semilogx, loglog} +## @end deftypefn + +## Author: jwe + +function retval = semilogy (varargin) + + [h, varargin, nargs] = __plt_get_axis_arg__ ("semilogy", varargin{:}); + + if (nargs < 1) + print_usage(); + endif + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + set (h, "yscale", "log"); + if (any( strcmp (get (gca, "nextplot"), {"new", "replace"}))) + set (h, "yminortick", "on"); + endif + + tmp = __plt__ ("semilogy", h, varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +%!demo +%! clf (); +%! x = 1:0.01:10; +%! y = (x .* (1 + rand (size (x)))) .^ 2; +%! semilogy (x, y); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (2, 1, 1); +%! semilogy (x, y); +%! ylabel ("semilogy (x, y)"); +%! +%! subplot (2, 1, 2); +%! semilogy (x, -y); +%! ylabel ("semilogy (x, -y)"); + +%!demo +%! clf (); +%! x = logspace (-5, 1, 10); +%! y = logspace (-5, 1, 10); +%! +%! subplot (2, 1, 1); +%! semilogy (x, y); +%! set (gca, "ydir", "reverse", "activepositionproperty", "outerposition"); +%! ylabel ({"semilogy (x, y)", "ydir = reversed"}); +%! +%! subplot (2, 1, 2); +%! semilogy (x, -y); +%! set (gca, "ydir", "reverse", "activepositionproperty", "outerposition"); +%! ylabel ({"semilogy (x, -y)", "ydir = reversed"}); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b = logspace (-5, 1, 10); +%! semilogy (a, b); +%! assert (get (gca, "yscale"), "log"); +%! assert (get (gca, "xscale"), "linear"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! a = logspace (-5, 1, 10); +%! b =-logspace (-5, 1, 10); +%! semilogy (a, b); +%! axis tight; +%! assert (all (get (gca, "ytick") < 0)); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/semilogyerr.m b/octave_packages/m/plot/semilogyerr.m new file mode 100644 index 0000000..c89fdb4 --- /dev/null +++ b/octave_packages/m/plot/semilogyerr.m @@ -0,0 +1,71 @@ +## Copyright (C) 2000-2012 Teemu Ikonen +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} semilogyerr (@var{args}) +## Produce two-dimensional plots using a logarithmic scale for the @var{y} +## axis and errorbars at each data point. Many different combinations of +## arguments are possible. The most used form is +## +## @example +## semilogyerr (@var{x}, @var{y}, @var{ey}, @var{fmt}) +## @end example +## +## @noindent +## which produces a semi-logarithmic plot of @var{y} versus @var{x} +## with errors in the @var{y}-scale defined by @var{ey} and the plot +## format defined by @var{fmt}. See @code{errorbar} for available formats and +## additional information. +## @seealso{errorbar, loglogerr, semilogxerr} +## @end deftypefn + +## Created: 20.2.2001 +## Author: Teemu Ikonen +## Keywords: errorbar, plotting + +function retval = semilogyerr (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("semilogyerr", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + set (h, "yscale", "log"); + + tmp = __errcomm__ ("semilogyerr", h, varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +%!demo +%! clf +%! x = 0.25:0.25:10; +%! y = wblpdf (x, 4, 2); +%! eyu = rand (size (y)); +%! eyl = 1.0 - 1./(1+eyu); +%! semilogyerr (x, y, eyl.*y, eyu.*y, "~-d") +%! xlim ([0 10]) + diff --git a/octave_packages/m/plot/shading.m b/octave_packages/m/plot/shading.m new file mode 100644 index 0000000..e396227 --- /dev/null +++ b/octave_packages/m/plot/shading.m @@ -0,0 +1,113 @@ +## Copyright (C) 2006-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} shading (@var{type}) +## @deftypefnx {Function File} {} shading (@var{ax}, @dots{}) +## Set the shading of surface or patch graphic objects. Valid arguments +## for @var{type} are +## +## @table @asis +## @item "flat" +## Single colored patches with invisible edges. +## +## @item "faceted" +## Single colored patches with visible edges. +## +## @item "interp" +## Color between patch vertices are interpolated and the patch edges are +## invisible. +## @end table +## +## If @var{ax} is given the shading is applied to axis @var{ax} instead +## of the current axis. +## @end deftypefn + +## Author: Kai Habel + +function shading (varargin) + + [ax, varargin] = __plt_get_axis_arg__ ("shading", varargin{:}); + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + mode = varargin{1}; + + h1 = findobj (ax, "type", "patch"); + h2 = findobj (ax, "type", "surface"); + + obj = [h1(:); h2(:)]; + + for n = 1:numel(obj) + h = obj(n); + if (strcmpi (mode, "flat")) + set (h, "facecolor", "flat"); + set (h, "edgecolor", "none"); + elseif (strcmpi (mode, "interp")) + set (h, "facecolor", "interp"); + set (h, "edgecolor", "none"); + elseif (strcmpi (mode, "faceted")) + set (h, "facecolor", "flat"); + set (h, "edgecolor", [0 0 0]); + else + error ("shading: unknown argument"); + endif + endfor + +endfunction + + +%!demo +%! clf +%! colormap (jet) +%! sombrero +%! shading faceted +%! title ('shading "faceted"') + +%!demo +%! clf +%! sombrero +%! shading flat +%! title ('shading "flat"') + +%!demo +%! clf +%! sombrero +%! shading interp +%! title ('shading "interp"') + +%!demo +%! clf +%! pcolor (peaks ()) +%! shading faceted +%! title ('shading "faceted"') + +%!demo +%! clf +%! pcolor (peaks ()) +%! shading flat +%! title ('shading "flat"') + +%!demo +%! clf +%! pcolor (peaks ()) +%! shading interp +%! title ('shading "interp"') + diff --git a/octave_packages/m/plot/shg.m b/octave_packages/m/plot/shg.m new file mode 100644 index 0000000..9754534 --- /dev/null +++ b/octave_packages/m/plot/shg.m @@ -0,0 +1,36 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} shg +## Show the graph window. Currently, this is the same as executing +## @code{drawnow}. +## @seealso{drawnow, figure} +## @end deftypefn + +## Author: jwe + +function shg () + + if (nargin != 0) + warning ("shg: ignoring extra arguments"); + endif + + drawnow (); + +endfunction diff --git a/octave_packages/m/plot/slice.m b/octave_packages/m/plot/slice.m new file mode 100644 index 0000000..e130194 --- /dev/null +++ b/octave_packages/m/plot/slice.m @@ -0,0 +1,197 @@ +## Copyright (C) 2007-2012 Kai Habel, David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} slice (@var{x}, @var{y}, @var{z}, @var{v}, @var{sx}, @var{sy}, @var{sz}) +## @deftypefnx {Function File} {} slice (@var{x}, @var{y}, @var{z}, @var{v}, @var{xi}, @var{yi}, @var{zi}) +## @deftypefnx {Function File} {} slice (@var{v}, @var{sx}, @var{sy}, @var{sz}) +## @deftypefnx {Function File} {} slice (@var{v}, @var{xi}, @var{yi}, @var{zi}) +## @deftypefnx {Function File} {@var{h} =} slice (@dots{}) +## @deftypefnx {Function File} {@var{h} =} slice (@dots{}, @var{method}) +## Plot slices of 3-D data/scalar fields. Each element of the 3-dimensional +## array @var{v} represents a scalar value at a location given by the +## parameters @var{x}, @var{y}, and @var{z}. The parameters @var{x}, +## @var{x}, and @var{z} are either 3-dimensional arrays of the same size +## as the array @var{v} in the "meshgrid" format or vectors. The +## parameters @var{xi}, etc. respect a similar format to @var{x}, etc., +## and they represent the points at which the array @var{vi} is +## interpolated using interp3. The vectors @var{sx}, @var{sy}, and +## @var{sz} contain points of orthogonal slices of the respective axes. +## +## If @var{x}, @var{y}, @var{z} are omitted, they are assumed to be +## @code{x = 1:size (@var{v}, 2)}, @code{y = 1:size (@var{v}, 1)} and +## @code{z = 1:size (@var{v}, 3)}. +## +## @var{Method} is one of: +## +## @table @asis +## @item "nearest" +## Return the nearest neighbor. +## +## @item "linear" +## Linear interpolation from nearest neighbors. +## +## @item "cubic" +## Cubic interpolation from four nearest neighbors (not implemented yet). +## +## @item "spline" +## Cubic spline interpolation---smooth first and second derivatives +## throughout the curve. +## @end table +## +## The default method is @code{"linear"}. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. +## +## Examples: +## +## @example +## @group +## [x, y, z] = meshgrid (linspace (-8, 8, 32)); +## v = sin (sqrt (x.^2 + y.^2 + z.^2)) ./ (sqrt (x.^2 + y.^2 + z.^2)); +## slice (x, y, z, v, [], 0, []); +## [xi, yi] = meshgrid (linspace (-7, 7)); +## zi = xi + yi; +## slice (x, y, z, v, xi, yi, zi); +## @end group +## @end example +## @seealso{interp3, surface, pcolor} +## @end deftypefn + +## Author: Kai Habel + +function h = slice (varargin) + + method = "linear"; + nargs = nargin; + + if (ischar (varargin{end})) + method = varargin{end}; + nargs -= 1; + endif + + if (nargs == 4) + v = varargin{1}; + if (ndims (v) != 3) + error ("slice: expect 3-dimensional array of values"); + endif + [nx, ny, nz] = size (v); + [x, y, z] = meshgrid (1:nx, 1:ny, 1:nz); + sx = varargin{2}; + sy = varargin{3}; + sz = varargin{4}; + elseif (nargs == 7) + v = varargin{4}; + if (ndims (v) != 3) + error ("slice: expect 3-dimensional array of values"); + endif + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + if (all ([isvector(x), isvector(y), isvector(z)])) + [x, y, z] = meshgrid (x, y, z); + elseif (ndims (x) == 3 && size_equal (x, y, z)) + ## Do nothing. + else + error ("slice: X, Y, Z size mismatch"); + endif + sx = varargin{5}; + sy = varargin{6}; + sz = varargin{7}; + else + print_usage (); + endif + + if (any ([isvector(sx), isvector(sy), isvector(sz)])) + have_sval = true; + elseif (ndims(sx) == 2 && size_equal (sx, sy, sz)) + have_sval = false; + else + error ("slice: dimensional mismatch for (XI, YI, ZI) or (SX, SY, SZ)"); + endif + + newplot (); + ax = gca (); + sidx = 1; + maxv = max (v(:)); + minv = min (v(:)); + set (ax, "clim", [minv, maxv]); + + if (have_sval) + ns = length (sx) + length (sy) + length (sz); + hs = zeros(ns,1); + [ny, nx, nz] = size (v); + if (length(sz) > 0) + for i = 1:length(sz) + [xi, yi, zi] = meshgrid (squeeze (x(1,:,1)), + squeeze (y(:,1,1)), sz(i)); + vz = squeeze (interp3 (x, y, z, v, xi, yi, zi, method)); + tmp(sidx++) = surface (xi, yi, sz(i) * ones (size (yi)), vz); + endfor + endif + + if (length (sy) > 0) + for i = length(sy):-1:1 + [xi, yi, zi] = meshgrid (squeeze (x(1,:,1)), sy(i), squeeze (z(1,1,:))); + vy = squeeze (interp3 (x, y, z, v, xi, yi, zi, method)); + tmp(sidx++) = surface (squeeze (xi), + squeeze (sy(i) * ones (size (zi))), + squeeze (zi), vy); + endfor + endif + + if (length (sx) > 0) + for i = length(sx):-1:1 + [xi, yi, zi] = meshgrid (sx(i), squeeze (y(:,1,1)), squeeze (z(1,1,:))); + vx = squeeze (interp3 (x, y, z, v, xi, yi, zi, method)); + tmp(sidx++) = surface (squeeze (sx(i) * ones (size (zi))), + squeeze (yi), squeeze(zi), vx); + endfor + endif + else + vi = interp3 (x, y, z, v, sx, sy, sz); + tmp = surface (sx, sy, sz, vi); + endif + + if (! ishold ()) + set (ax, "view", [-37.5, 30.0], "box", "off", "xgrid", "on", + "ygrid", "on", "zgrid", "on"); + endif + + if (nargout > 0) + h = tmp; + endif + +endfunction + + +%!demo +%! clf +%! [x, y, z] = meshgrid (linspace (-8, 8, 32)); +%! v = sin (sqrt (x.^2 + y.^2 + z.^2)) ./ (sqrt (x.^2 + y.^2 + z.^2)); +%! slice (x, y, z, v, [], 0, []); + +%!demo +%! clf +%! [x, y, z] = meshgrid (linspace (-8, 8, 32)); +%! v = sin (sqrt (x.^2 + y.^2 + z.^2)) ./ (sqrt (x.^2 + y.^2 + z.^2)); +%! [xi, yi] = meshgrid (linspace (-7, 7)); +%! zi = xi + yi; +%! slice (x, y, z, v, xi, yi, zi); + diff --git a/octave_packages/m/plot/sombrero.m b/octave_packages/m/plot/sombrero.m new file mode 100644 index 0000000..4836314 --- /dev/null +++ b/octave_packages/m/plot/sombrero.m @@ -0,0 +1,66 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} sombrero (@var{n}) +## Produce the familiar three-dimensional sombrero plot using @var{n} +## grid lines. If @var{n} is omitted, a value of 41 is assumed. +## +## The function plotted is +## +## @example +## z = sin (sqrt (x^2 + y^2)) / (sqrt (x^2 + y^2)) +## @end example +## @seealso{surf, meshgrid, mesh} +## @end deftypefn + +## Author: jwe + +function [x, y, z] = sombrero (n) + + if (nargin == 0) + n = 41; + endif + + if (nargin < 2) + if (n > 1) + tx = linspace (-8, 8, n)'; + ty = tx; + [xx, yy] = meshgrid (tx, ty); + r = sqrt (xx .^ 2 + yy .^ 2) + eps; + tz = sin (r) ./ r; + if (nargout == 0) + surf (tx, ty, tz); + box ("off"); + else + x = tx; + y = ty; + z = tz; + endif + else + error ("sombrero: number of grid lines must be greater than 1"); + endif + else + print_usage (); + endif + +endfunction + +%!demo +%! clf +%! sombrero (); diff --git a/octave_packages/m/plot/specular.m b/octave_packages/m/plot/specular.m new file mode 100644 index 0000000..d85de08 --- /dev/null +++ b/octave_packages/m/plot/specular.m @@ -0,0 +1,92 @@ +## Copyright (C) 2009-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} specular (@var{sx}, @var{sy}, @var{sz}, @var{lv}, @var{vv}) +## @deftypefnx {Function File} {} specular (@var{sx}, @var{sy}, @var{sz}, @var{lv}, @var{vv}, @var{se}) +## Calculate specular reflection strength of a surface defined by the normal +## vector elements @var{sx}, @var{sy}, @var{sz} using Phong's approximation. +## The light and view vectors can be specified using parameter @var{lv} and +## @var{vv} respectively. +## Both can be given as 2-element vectors [azimuth, elevation] in degrees or as +## 3-element +## vector [x, y, z]. An optional 6th argument describes the specular exponent +## (spread) @var{se}. +## @seealso{surfl, diffuse} +## @end deftypefn + +## Author: Kai Habel + +function retval = specular (sx, sy, sz, lv, vv, se) + + if (nargin < 5 || nargin > 6) + print_usage (); + endif + + ## Checks for specular exponent (se). + if (nargin < 6) + se = 10; + else + if (!isnumeric (se) || numel (se) != 1 || se <= 0) + error ("specular: exponent must be positive scalar"); + endif + endif + + ## Checks for normal vector. + if (!size_equal (sx, sy, sz)) + error ("specular: SX, SY, and SZ must have same size"); + endif + + ## Check for light vector (lv) argument. + if (length (lv) < 2 || length (lv) > 3) + error ("specular: light vector LV must be a 2- or 3-element vector"); + elseif (length (lv) == 2) + [lv(1), lv(2), lv(3)] = sph2cart (lv(1) * pi/180, lv(2) * pi/180, 1.0); + endif + + ## Check for view vector (vv) argument. + if (length (vv) < 2 || length (lv) > 3) + error ("specular: view vector VV must be a 2- or 3-element vector"); + elseif (length (vv) == 2) + [vv(1), vv(2), vv(3)] = sph2cart (vv(1) * pi / 180, vv(2) * pi / 180, 1.0); + endif + + ## Normalize view and light vector. + if (sum (abs (lv)) > 0) + lv /= norm (lv); + endif + if (sum (abs (vv)) > 0) + vv /= norm (vv); + endif + + ## Calculate normal vector lengths and dot-products. + ns = sqrt (sx.^2 + sy.^2 + sz.^2); + l_dot_n = (sx * lv(1) + sy * lv(2) + sz * lv(3)) ./ ns; + v_dot_n = (sx * vv(1) + sy * vv(2) + sz * vv(3)) ./ ns; + + ## Calculate specular reflection using Phong's approximation. + retval = 2 * l_dot_n .* v_dot_n - dot (lv, vv); + + ## Set zero if light is on the other side. + retval(l_dot_n < 0) = 0; + + ## Allow postive values only. + retval(retval < 0) = 0; + retval = retval .^ se; + +endfunction diff --git a/octave_packages/m/plot/sphere.m b/octave_packages/m/plot/sphere.m new file mode 100644 index 0000000..60c286d --- /dev/null +++ b/octave_packages/m/plot/sphere.m @@ -0,0 +1,61 @@ +## Copyright (C) 2007-2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{y}, @var{z}] =} sphere (@var{n}) +## @deftypefnx {Function File} {} sphere (@var{h}, @dots{}) +## Generate three matrices in @code{meshgrid} format, such that +## @code{surf (@var{x}, @var{y}, @var{z})} generates a unit sphere. +## The matrices of @code{@var{n}+1}-by-@code{@var{n}+1}. If @var{n} is +## omitted then a default value of 20 is assumed. +## +## Called with no return arguments, @code{sphere} call directly +## @code{surf (@var{x}, @var{y}, @var{z})}. If an axes handle is passed +## as the first argument, the surface is plotted to this set of axes. +## @seealso{peaks} +## @end deftypefn + +function [xx, yy, zz] = sphere (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ((nargout > 0), "sphere", + varargin{:}); + if (nargin > 1) + print_usage (); + elseif (nargin == 1) + n = varargin{1}; + else + n = 20; + endif + + theta = linspace (0, 2*pi, n+1); + phi = linspace (-pi/2, pi/2, n+1); + [theta,phi] = meshgrid (theta, phi); + + x = cos (phi) .* cos (theta); + y = cos (phi) .* sin (theta); + z = sin (phi); + + if (nargout > 0) + xx = x; + yy = y; + zz = z; + else + surf (h, x, y, z); + endif + +endfunction diff --git a/octave_packages/m/plot/spinmap.m b/octave_packages/m/plot/spinmap.m new file mode 100644 index 0000000..00c612c --- /dev/null +++ b/octave_packages/m/plot/spinmap.m @@ -0,0 +1,57 @@ +## Copyright (C) 2007-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} spinmap (@var{t}, @var{inc}) +## Cycle the colormap for @var{t} seconds with an increment +## of @var{inc}. Both parameters are optional. The default cycle time +## is 5 seconds and the default increment is 2. +## +## A higher value of @var{inc} causes a faster cycle through the +## colormap. +## @seealso{gca, colorbar} +## @end deftypefn + +## Author: Kai Habel + +function spinmap (t, inc) + + if (nargin == 0) + inc = 2; + t = 5; + elseif (nargin == 1) + inc = 2; + endif + + cmap = get (gcf (), "colormap"); + clen = rows (cmap); + + t0 = clock; + + while (etime (clock, t0) < t) + for n = 1:inc:clen + newmap = shift (cmap, n, 1); + set (gcf (), "colormap", newmap); + drawnow (); + endfor + endwhile + + set (gcf (), "colormap", cmap); + +endfunction + diff --git a/octave_packages/m/plot/stairs.m b/octave_packages/m/plot/stairs.m new file mode 100644 index 0000000..64d6e7b --- /dev/null +++ b/octave_packages/m/plot/stairs.m @@ -0,0 +1,268 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} stairs (@var{y}) +## @deftypefnx {Function File} {} stairs (@var{x}, @var{y}) +## @deftypefnx {Function File} {} stairs (@dots{}, @var{style}) +## @deftypefnx {Function File} {} stairs (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {} stairs (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} stairs (@dots{}) +## @deftypefnx {Function File} {[@var{xstep}, @var{ystep}] =} stairs (@dots{}) +## Produce a stairstep plot. The arguments may be vectors or matrices. +## +## If only one argument is given, it is taken as a vector of y-values +## and the x coordinates are taken to be the indices of the elements. +## +## If one output argument is requested, return a graphics handle to the plot. +## If two output arguments are specified, the data are generated but +## not plotted. For example, +## +## @example +## stairs (x, y); +## @end example +## +## @noindent +## and +## +## @example +## @group +## [xs, ys] = stairs (x, y); +## plot (xs, ys); +## @end group +## @end example +## +## @noindent +## are equivalent. +## @seealso{plot, semilogx, semilogy, loglog, polar, mesh, contour, +## bar, xlabel, ylabel, title} +## @end deftypefn + +## Author: jwe + +function [xs, ys] = stairs (varargin) + + [ax, varargin, nargin] = __plt_get_axis_arg__ ("stairs", varargin{:}); + + if (nargin < 1) + print_usage (); + else + if (nargout > 1) + [h, xs, ys] = __stairs__ (false, varargin{:}); + else + oldax = gca (); + unwind_protect + axes (ax); + newplot (); + [h, xxs, yys] = __stairs__ (true, varargin{:}); + unwind_protect_cleanup + axes (oldax); + end_unwind_protect + endif + if (nargout == 1) + xs = h; + endif + endif +endfunction + +function [h, xs, ys] = __stairs__ (doplot, varargin) + + if (nargin == 2 || ischar (varargin{2})) + y = varargin {1}; + varargin(1) = []; + if (ismatrix (y)) + if (isvector (y)) + y = y(:); + endif + x = 1:rows (y); + endif + else + x = varargin{1}; + y = varargin{2}; + varargin(1:2) = []; + endif + + if (ndims (x) > 2 || ndims (y) > 2) + error ("stairs: expecting 2-d arguments"); + endif + + vec_x = isvector (x); + + if (vec_x) + x = x(:); + endif + + if (isvector (y)) + y = y(:); + endif + + if (ismatrix (y)) + [nr, nc] = size (y); + if (vec_x) + x = repmat (x, [1, nc]); + else + [x_nr, x_nc] = size (x); + if (x_nr != nr || x_nc != nc) + error ("stairs: argument size mismatch"); + endif + endif + endif + + len = 2*nr - 1; + + xs = ys = zeros (len, nc); + + xs(1,:) = x(1,:); + ys(1,:) = y(1,:); + + xtmp = x(2:nr,:); + ridx = 2:2:len-1; + xs(ridx,:) = xtmp; + ys(ridx,:) = y(1:nr-1,:); + + ridx = 3:2:len; + xs(ridx,:) = xtmp; + ys(ridx,:) = y(2:nr,:); + + have_line_spec = false; + for i = 1 : length (varargin) + arg = varargin {i}; + if ((ischar (arg) || iscell (arg)) && ! have_line_spec) + [linespec, valid] = __pltopt__ ("stairs", arg, false); + if (valid) + have_line_spec = true; + varargin(i) = []; + break; + endif + endif + endfor + + if (doplot) + h = []; + unwind_protect + hold_state = get (gca (), "nextplot"); + for i = 1 : size(y, 2) + hg = hggroup (); + h = [h; hg]; + args = __add_datasource__ ("stairs", hg, {"x", "y"}, varargin{:}); + + addproperty ("xdata", hg, "data", x(:,i).'); + addproperty ("ydata", hg, "data", y(:,i).'); + + addlistener (hg, "xdata", @update_data); + addlistener (hg, "ydata", @update_data); + + if (have_line_spec) + tmp = line (xs(:,i).', ys(:,i).', "color", linespec.color, + "parent", hg); + else + tmp = line (xs(:,i).', ys(:,i).', "color", __next_line_color__ (), + "parent", hg); + endif + + addproperty ("color", hg, "linecolor", get (tmp, "color")); + addproperty ("linewidth", hg, "linelinewidth", get (tmp, "linewidth")); + addproperty ("linestyle", hg, "linelinestyle", get (tmp, "linestyle")); + + addproperty ("marker", hg, "linemarker", get (tmp, "marker")); + addproperty ("markerfacecolor", hg, "linemarkerfacecolor", + get (tmp, "markerfacecolor")); + addproperty ("markeredgecolor", hg, "linemarkeredgecolor", + get (tmp, "markeredgecolor")); + addproperty ("markersize", hg, "linemarkersize", + get (tmp, "markersize")); + + addlistener (hg, "color", @update_props); + addlistener (hg, "linewidth", @update_props); + addlistener (hg, "linestyle", @update_props); + addlistener (hg, "marker", @update_props); + addlistener (hg, "markerfacecolor", @update_props); + addlistener (hg, "markeredgecolor", @update_props); + addlistener (hg, "markersize", @update_props); + + if (! isempty (args)) + set (hg, args{:}); + endif + endfor + unwind_protect_cleanup + set (gca (), "nextplot", hold_state); + end_unwind_protect + else + h = 0; + endif + +endfunction + + +%!demo +%! clf +%! x = 1:10; +%! rand_1x10_data1 = [0.073, 0.455, 0.837, 0.124, 0.426, 0.781, 0.004, 0.024, 0.519, 0.698]; +%! y = rand_1x10_data1; +%! stairs (x, y); + +%!demo +%! clf +%! x = 1:10; +%! rand_1x10_data2 = [0.014, 0.460, 0.622, 0.394, 0.531, 0.378, 0.466, 0.788, 0.342, 0.893]; +%! y = rand_1x10_data2; +%! [xs, ys] = stairs (x, y); +%! plot (xs, ys); + +%!demo +%! clf +%! stairs (1:9); + +%!demo +%! clf +%! [xs, ys] = stairs (9:-1:1); +%! plot (xs, ys); + + +function update_props (h, d) + set (get (h, "children"), "color", get (h, "color"), + "linewidth", get (h, "linewidth"), + "linestyle", get (h, "linestyle"), + "marker", get (h, "marker"), + "markerfacecolor", get (h, "markerfacecolor"), + "markeredgecolor", get (h, "markeredgecolor"), + "markersize", get (h, "markersize")); +endfunction + +function update_data (h, d) + x = get (h, "xdata"); + y = get (h, "ydata"); + + nr = length (x); + len = 2 * nr - 1; + xs = ys = zeros (1, len); + + xs(1) = x(1); + ys(1) = y(1); + + xtmp = x(2:nr); + ridx = 2:2:len-1; + xs(ridx) = xtmp; + ys(ridx) = y(1:nr-1); + + ridx = 3:2:len; + xs(ridx) = xtmp; + ys(ridx) = y(2:nr); + + set (get (h, "children"), "xdata", xs, "ydata", ys); +endfunction diff --git a/octave_packages/m/plot/stem.m b/octave_packages/m/plot/stem.m new file mode 100644 index 0000000..21de862 --- /dev/null +++ b/octave_packages/m/plot/stem.m @@ -0,0 +1,132 @@ +## Copyright (C) 2006-2012 Michel D. Schmid +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} stem (@var{x}) +## @deftypefnx {Function File} {} stem (@var{x}, @var{y}) +## @deftypefnx {Function File} {} stem (@var{x}, @var{y}, @var{linespec}) +## @deftypefnx {Function File} {} stem (@dots{}, "filled") +## @deftypefnx {Function File} {@var{h} =} stem (@dots{}) +## Plot a stem graph from two vectors of x-y data. If only one argument +## is given, it is taken as the y-values and the x coordinates are taken +## from the indices of the elements. +## +## If @var{y} is a matrix, then each column of the matrix is plotted as +## a separate stem graph. In this case @var{x} can either be a vector, +## the same length as the number of rows in @var{y}, or it can be a +## matrix of the same size as @var{y}. +## +## The default color is @code{"b"} (blue). The default line style is +## @code{"-"} and the default marker is @code{"o"}. The line style can +## be altered by the @code{linespec} argument in the same manner as the +## @code{plot} command. For example, +## +## @example +## @group +## x = 1:10; +## y = 2*x; +## stem (x, y, "r"); +## @end group +## @end example +## +## @noindent +## plots 10 stems with heights from 2 to 20 in red; +## +## The optional return value @var{h} is a vector of "stem series" graphics +## handles with one handle per column of the variable @var{y}. The +## handle regroups the elements of the stem graph together as the +## children of the "stem series" handle, allowing them to be altered +## together. For example, +## +## @example +## @group +## x = [0:10]'; +## y = [sin(x), cos(x)] +## h = stem (x, y); +## set (h(2), "color", "g"); +## set (h(1), "basevalue", -1) +## @end group +## @end example +## +## @noindent +## changes the color of the second "stem series" and moves the base line +## of the first. +## @seealso{bar, barh, plot} +## @end deftypefn + +## Author: Michel D. Schmid +## Adapted-by: jwe + +function h = stem (varargin) + + if (nargin < 1) + print_usage (); + endif + + tmp = __stem__ (false, varargin{:}); + + if (nargout > 0) + h = tmp; + endif + +endfunction + + +%!demo +%! clf +%! x = 1:10; +%! stem (x); + +%!demo +%! clf +%! x = 1:10; +%! y = 2*x; +%! stem (x, y); + +%!demo +%! clf +%! x = 1:10; +%! y = 2*x; +%! h = stem (x, y, "r"); + +%!demo +%! clf +%! x = 1:10; +%! y = 2*x; +%! h = stem (x, y, "-.k"); + +%!demo +%! clf +%! x = 1:10; +%! y = 2*x; +%! h = stem (x, y, "-.k."); + +%!demo +%! clf +%! x = 1:10; +%! y = 2*x; +%! h = stem (x, y, "filled"); + +%!demo +%! clf +%! x = [0 : 10]'; +%! y = [sin(x), cos(x)]; +%! h = stem (x, y); +%! set (h(2), "color", "g"); +%! set (h(1), "basevalue", -1) + diff --git a/octave_packages/m/plot/stem3.m b/octave_packages/m/plot/stem3.m new file mode 100644 index 0000000..7616168 --- /dev/null +++ b/octave_packages/m/plot/stem3.m @@ -0,0 +1,58 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} stem3 (@var{x}, @var{y}, @var{z}, @var{linespec}) +## Plot a three-dimensional stem graph and return the handles of the line +## and marker objects used to draw the stems as "stem series" object. +## The default color is @code{"r"} (red). The default line style is +## @code{"-"} and the default marker is @code{"o"}. +## +## For example, +## +## @example +## @group +## theta = 0:0.2:6; +## stem3 (cos (theta), sin (theta), theta) +## @end group +## @end example +## +## @noindent +## plots 31 stems with heights from 0 to 6 lying on a circle. Color +## definitions with RGB-triples are not valid! +## @seealso{bar, barh, stem, plot} +## @end deftypefn + +function h = stem3 (varargin) + + if (nargin < 1 || nargin > 4) + print_usage (); + endif + + tmp = __stem__ (true, varargin{:}); + + if (nargout > 0) + h = tmp; + endif + +endfunction + +%!demo +%! clf +%! theta = 0:0.2:6; +%! stem3 (cos (theta), sin (theta), theta) diff --git a/octave_packages/m/plot/subplot.m b/octave_packages/m/plot/subplot.m new file mode 100644 index 0000000..5f56734 --- /dev/null +++ b/octave_packages/m/plot/subplot.m @@ -0,0 +1,365 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} subplot (@var{rows}, @var{cols}, @var{index}) +## @deftypefnx {Function File} {} subplot (@var{rcn}) +## Set up a plot grid with @var{rows} by @var{cols} subwindows and plot +## in location given by @var{index}. +## +## If only one argument is supplied, then it must be a three digit value +## specifying the location in digits 1 (rows) and 2 (columns) and the plot +## index in digit 3. +## +## The plot index runs row-wise. First all the columns in a row are filled +## and then the next row is filled. +## +## For example, a plot with 2 by 3 grid will have plot indices running as +## follows: +## @tex +## \vskip 10pt +## \hfil\vbox{\offinterlineskip\hrule +## \halign{\vrule#&&\qquad\hfil#\hfil\qquad\vrule\cr +## height13pt&1&2&3\cr height12pt&&&\cr\noalign{\hrule} +## height13pt&4&5&6\cr height12pt&&&\cr\noalign{\hrule}}} +## \hfil +## \vskip 10pt +## @end tex +## @ifnottex +## +## @example +## @group +## +-----+-----+-----+ +## | 1 | 2 | 3 | +## +-----+-----+-----+ +## | 4 | 5 | 6 | +## +-----+-----+-----+ +## @end group +## @end example +## +## @var{index} may be a vector. In which case, the new axis will enclose +## the grid locations specified. The first demo illustrates an example: +## +## @example +## demo ("subplot", 1) +## @end example +## +## @end ifnottex +## @seealso{axes, plot} +## @end deftypefn + +## Author: Vinayak Dutt +## Adapted-By: jwe + +function h = subplot (varargin) + + align_axes = false; + replace_axes = false; + have_position = false; + initial_args_decoded = false; + + if (nargin > 2) + ## R, C, N? + arg1 = varargin{1}; + arg2 = varargin{2}; + arg3 = varargin{3}; + if (isnumeric (arg1) && isscalar (arg1) && isnumeric (arg2) + && isscalar (arg2) && isnumeric (arg3)) + rows = arg1; + cols = arg2; + index = arg3; + varargin(1:3)= []; + initial_args_decoded = true; + endif + endif + + if (! initial_args_decoded && nargin > 1) + ## check for 'position', pos, ... + if (strcmpi (varargin{1}, "position")) + arg = varargin{2}; + if (isnumeric (arg) && numel (arg) == 4) + pos = arg; + varargin(1:2) = []; + have_position = true; + initial_args_decoded = true; + else + error ("expecting position to be a 4-element numeric array"); + endif + endif + endif + + if (! initial_args_decoded && nargin > 0) + arg = varargin{1}; + if (nargin == 1 && ishandle (arg)) + ## Axes handle? + axes (arg); + cf = get (0, "currentfigure"); + set (cf, "nextplot", "add"); + return; + elseif (isscalar (arg) && arg >= 0) + ## RCN? + index = rem (arg, 10); + arg = (arg - index) / 10; + cols = rem (arg, 10); + arg = (arg - cols) / 10; + rows = rem (arg, 10); + varargin(1) = []; + initial_args_decoded = true; + else + error ("subplot: expecting axes handle or RCN argument"); + endif + endif + + if (! initial_args_decoded) + print_usage (); + endif + + if (! have_position) + cols = round (cols); + rows = round (rows); + index = round (index); + + if (any (index < 1) || any (index > rows*cols)) + error ("subplot: INDEX value must be greater than 1 and less than ROWS*COLS"); + endif + + if (cols < 1 || rows < 1 || index < 1) + error ("subplot: COLS, ROWS, and INDEX must be be positive"); + endif + endif + + nargs = numel (varargin); + while (nargs > 0) + arg = varargin{1}; + if (strcmpi (arg, "align")) + align_axes = true; + elseif (strcmpi (arg, "replace")) + replace_axes = true; + else + break; + endif + varargin(1) = []; + nargs--; + endwhile + + axesunits = get (0, "defaultaxesunits"); + cf = gcf (); + figureunits = get (cf, "units"); + unwind_protect + units = "normalized"; + set (0, "defaultaxesunits", units); + set (cf, "units", "pixels"); + + ## FIXME: At the moment we force gnuplot to use the aligned mode + ## which will set "activepositionproperty" to "position". + ## Τhis can yield to text overlap between labels and titles + ## see bug #31610 + if (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + align_axes = true; + endif + + if (! have_position) + if (align_axes) + pos = subplot_position (rows, cols, index, "position"); + elseif (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + pos = subplot_position (rows, cols, index, "outerpositiontight"); + else + pos = subplot_position (rows, cols, index, "outerposition"); + endif + endif + + set (cf, "nextplot", "add"); + + found = false; + kids = get (cf, "children"); + for child = reshape (kids, 1, numel (kids)) + ## Check whether this child is still valid; this might not be the + ## case anymore due to the deletion of previous children (due to + ## "deletefcn" callback or for legends/colorbars that are deleted + ## with their corresponding axes). + if (! ishandle (child)) + continue; + endif + if (strcmp (get (child, "type"), "axes")) + ## Skip legend and colorbar objects. + if (strcmp (get (child, "tag"), "legend") + || strcmp (get (child, "tag"), "colorbar")) + continue; + endif + if (align_axes) + objpos = get (child, "position"); + else + objpos = get (child, "outerposition"); + endif + if (all (objpos == pos) && ! replace_axes) + ## If the new axes are in exactly the same position as an + ## existing axes object, use the existing axes. + found = true; + tmp = child; + else + ## If the new axes overlap an old axes object, delete the old + ## axes. + x0 = pos(1); + x1 = x0 + pos(3); + y0 = pos(2); + y1 = y0 + pos(4); + objx0 = objpos(1); + objx1 = objx0 + objpos(3); + objy0 = objpos(2); + objy1 = objy0 + objpos(4); + if (! (x0 >= objx1 || x1 <= objx0 || y0 >= objy1 || y1 <= objy0)) + delete (child); + endif + endif + endif + endfor + + if (found) + set (cf, "currentaxes", tmp); + elseif (align_axes) + tmp = axes ("box", "off", "position", pos, varargin{:}); + elseif (strcmp (get (cf, "__graphics_toolkit__"), "gnuplot")) + tmp = axes ("box", "off", "outerposition", pos, varargin{:}); + else + tmp = axes ("looseinset", [0 0 0 0], "box", "off", "outerposition", pos, + "autopos_tag", "subplot", varargin{:}); + endif + + unwind_protect_cleanup + set (0, "defaultaxesunits", axesunits); + set (cf, "units", figureunits); + end_unwind_protect + + if (nargout > 0) + h = tmp; + endif + +endfunction + +function pos = subplot_position (rows, cols, index, position_property) + + if (rows == 1 && cols == 1) + ## Trivial result for subplot (1,1,1) + if (strcmpi (position_property, "position")) + pos = get (0, "defaultaxesposition"); + else + pos = get (0, "defaultaxesouterposition"); + endif + return + endif + + if (strcmp (position_property, "outerposition") + || strcmp (position_property, "outerpositiontight")) + margins.left = 0.05; + margins.bottom = 0.05; + margins.right = 0.05; + margins.top = 0.05; + if (strcmp (position_property, "outerpositiontight")) + margins.column = 0.; + margins.row = 0.; + else + margins.column = 0.04 / cols; + margins.row = 0.04 / rows; + endif + width = 1 - margins.left - margins.right - (cols-1)*margins.column; + width = width / cols; + height = 1 - margins.top - margins.bottom - (rows-1)*margins.row; + height = height / rows; + else + defaultaxesposition = get (0, "defaultaxesposition"); + + ## The outer margins surrounding all subplot "positions" are independent + ## of the number of rows and/or columns + margins.left = defaultaxesposition(1); + margins.bottom = defaultaxesposition(2); + margins.right = 1.0 - margins.left - defaultaxesposition(3); + margins.top = 1.0 - margins.bottom - defaultaxesposition(4); + + ## Fit from Matlab experiments + pc = 1 ./ [0.1860, (margins.left + margins.right - 1)]; + margins.column = 1 ./ polyval (pc , cols); + pr = 1 ./ [0.2282, (margins.top + margins.bottom - 1)]; + margins.row = 1 ./ polyval (pr , rows); + + ## Calculate the width/height of the subplot axes "position". + ## This is also consistent with Matlab + width = 1 - margins.left - margins.right - (cols-1)*margins.column; + width = width / cols; + height = 1 - margins.top - margins.bottom - (rows-1)*margins.row; + height = height / rows; + endif + + ## Index offsets from the lower left subplot + yi = fix ((index(:)-1)/cols); + xi = index(:) - yi*cols - 1; + yi = (rows - 1) - yi; + + ## Lower left corner of the subplot, i.e. position(1:2) + x0 = xi .* (width + margins.column) + margins.left; + y0 = yi .* (height + margins.row) + margins.bottom; + + if (numel(x0) > 1) + ## subplot (row, col, m:n) + x1 = max (x0(:)) + width; + y1 = max (y0(:)) + height; + x0 = min (x0(:)); + y0 = min (y0(:)); + pos = [x0, y0, x1-x0, y1-y0]; + else + ## subplot (row, col, num) + pos = [x0, y0, width, height]; + endif + +endfunction + +%!demo +%! clf +%! r = 3; +%! c = 3; +%! fmt = {'horizontalalignment', 'center', 'verticalalignment', 'middle'}; +%! for n = 1:(r*c) +%! subplot (r, c, n) +%! xlabel (sprintf ("xlabel #%d", n)) +%! ylabel (sprintf ("ylabel #%d", n)) +%! title (sprintf ("title #%d", n)) +%! text (0.5, 0.5, sprintf('subplot(%d,%d,%d)', r, c, n), fmt{:}) +%! axis ([0 1 0 1]) +%! endfor +%! subplot (r, c, 1:3) +%! xlabel (sprintf ("xlabel #%d:%d", 1, 3)) +%! ylabel (sprintf ("ylabel #%d:%d", 1, 3)) +%! title (sprintf ("title #%d:%d", 1, 3)) +%! text (0.5, 0.5, sprintf('subplot(%d,%d,%d:%d)', r, c, 1, 3), fmt{:}) +%! axis ([0 1 0 1]) + +%!demo +%! clf +%! x = 0:1; +%! for n = 1:4 +%! subplot (2, 2, n, "align") +%! plot (x, x) +%! xlabel (sprintf ("xlabel (2,2,%d)", n)) +%! ylabel (sprintf ("ylabel (2,2,%d)", n)) +%! title (sprintf ("title (2,2,%d)", n)) +%! endfor +%! subplot (1, 2, 1, "align") +%! plot (x, x) +%! xlabel ("xlabel (1,2,1)") +%! ylabel ("ylabel (1,2,1)") +%! title ("title (1,2,1)") + diff --git a/octave_packages/m/plot/surf.m b/octave_packages/m/plot/surf.m new file mode 100644 index 0000000..e136d43 --- /dev/null +++ b/octave_packages/m/plot/surf.m @@ -0,0 +1,86 @@ +## Copyright (C) 2007-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} surf (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {} surf (@var{z}) +## @deftypefnx {Function File} {} surf (@dots{}, @var{c}) +## @deftypefnx {Function File} {} surf (@var{hax}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} surf (@dots{}) +## Plot a surface given matrices @var{x}, and @var{y} from @code{meshgrid} and +## a matrix @var{z} corresponding to the @var{x} and @var{y} coordinates of +## the mesh. If @var{x} and @var{y} are vectors, then a typical vertex +## is (@var{x}(j), @var{y}(i), @var{z}(i,j)). Thus, columns of @var{z} +## correspond to different @var{x} values and rows of @var{z} correspond +## to different @var{y} values. +## +## The color of the surface is derived from the @code{colormap} and +## the value of @var{z}. Optionally the color of the surface can be +## specified independent of @var{z}, by adding a fourth matrix, @var{c}. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. +## @seealso{colormap, contour, meshgrid, mesh} +## @end deftypefn + +## Author: Kai Habel + +function retval = surf (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("surf", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + tmp = surface (varargin{:}); + + if (! ishold ()) + set (h, "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!demo +%! clf +%! [~,~,Z] = peaks; +%! surf (Z); + +%!demo +%! clf +%! [~,~,Z] = sombrero; +%! [Fx,Fy] = gradient (Z); +%! surf (Z, Fx+Fy); +%! shading interp; + +%!demo +%! clf +%! [X,Y,Z] = sombrero; +%! [~,Fy] = gradient (Z); +%! surf (X, Y, Z, Fy); +%! shading interp; + diff --git a/octave_packages/m/plot/surface.m b/octave_packages/m/plot/surface.m new file mode 100644 index 0000000..fc1d236 --- /dev/null +++ b/octave_packages/m/plot/surface.m @@ -0,0 +1,188 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} surface (@var{x}, @var{y}, @var{z}, @var{c}) +## @deftypefnx {Function File} {} surface (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {} surface (@var{z}, @var{c}) +## @deftypefnx {Function File} {} surface (@var{z}) +## @deftypefnx {Function File} {} surface (@dots{}, @var{prop}, @var{val}) +## @deftypefnx {Function File} {} surface (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} surface (@dots{}) +## Plot a surface graphic object given matrices @var{x}, and @var{y} from +## @code{meshgrid} and a matrix @var{z} corresponding to the @var{x} and +## @var{y} coordinates of the surface. If @var{x} and @var{y} are vectors, +## then a typical vertex is (@var{x}(j), @var{y}(i), @var{z}(i,j)). Thus, +## columns of @var{z} correspond to different @var{x} values and rows of +## @var{z} correspond to different @var{y} values. If @var{x} and @var{y} +## are missing, they are constructed from size of the matrix @var{z}. +## +## Any additional properties passed are assigned to the surface. +## +## The optional return value @var{h} is a graphics handle to the created +## surface object. +## @seealso{surf, mesh, patch, line} +## @end deftypefn + +## Author: jwe + +function retval = surface (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("surface", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + [tmp, bad_usage] = __surface__ (h, varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (bad_usage) + print_usage (); + endif + + if (nargout > 0) + retval = tmp; + endif + +endfunction + +function [h, bad_usage] = __surface__ (ax, varargin) + + bad_usage = false; + h = 0; + firststring = nargin; + for i = 2 : nargin + if (ischar (varargin{i - 1})) + firststring = i - 1; + break; + endif + endfor + + if (firststring > 5) + bad_usage = true; + elseif (firststring == 5) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + c = varargin{4}; + + [z_nr, z_nc] = size (z); + [c_nr, c_nc, c_np] = size (c); + if (! (z_nr == c_nr && z_nc == c_nc && (c_np == 1 || c_np == 3))) + error ("surface: Z and C must have the same size"); + endif + + if (isvector (x) && isvector (y) && ismatrix (z)) + if (rows (z) == length (y) && columns (z) == length (x)) + x = x(:)'; + y = y(:); + else + error ("surface: rows (Z) must be the same as length (Y) and columns (Z) must be the same as length (X)"); + endif + elseif (ismatrix (x) && ismatrix (y) && ismatrix (z)) + if (! size_equal (x, y, z)) + error ("surface: X, Y, and Z must have the same dimensions"); + endif + else + error ("surface: X and Y must be vectors and Z must be a matrix"); + endif + elseif (firststring == 4) + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + c = z; + if (isvector (x) && isvector (y) && ismatrix (z)) + if (rows (z) == length (y) && columns (z) == length (x)) + x = x(:)'; + y = y(:); + else + error ("surface: rows (Z) must be the same as length (Y) and columns (Z) must be the same as length (X)"); + endif + elseif (ismatrix (x) && ismatrix (y) && ismatrix (z)) + if (! size_equal (x, y, z)) + error ("surface: X, Y, and Z must have the same dimensions"); + endif + else + error ("surface: X and Y must be vectors and Z must be a matrix"); + endif + elseif (firststring == 3) + z = varargin{1}; + c = varargin{2}; + if (ismatrix (z) && !isvector (z) && !isscalar (z)) + [nr, nc] = size (z); + x = 1:nc; + y = (1:nr)'; + else + error ("surface: Z argument must be a matrix"); + endif + elseif (firststring == 2) + z = varargin{1}; + c = z; + if (ismatrix (z) && !isvector (z) && !isscalar (z)) + [nr, nc] = size (z); + x = 1:nc; + y = (1:nr)'; + else + error ("surface: Z argument must be a matrix"); + endif + elseif (firststring == 1) + x = 1:3; + y = (x).'; + c = z = eye(3); + else + bad_usage = true; + endif + + if (! bad_usage) + ## Make a default surface object. + other_args = {}; + if (firststring < nargin) + other_args = varargin(firststring:end); + endif + h = __go_surface__ (ax, "xdata", x, "ydata", y, "zdata", z, "cdata", c, + other_args{:}); + + if (! ishold ()) + set (ax, "view", [0, 90], "box", "off"); + endif + endif + +endfunction + +## Functional tests for surface() are in surf.m, surfc.m, surfl.m, and pcolor.m + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = surface; +%! assert (findobj (hf, "type", "surface"), h); +%! assert (get (h, "xdata"), 1:3, eps); +%! assert (get (h, "ydata"), (1:3)', eps); +%! assert (get (h, "zdata"), eye(3)); +%! assert (get (h, "cdata"), eye(3)); +%! assert (get (h, "type"), "surface"); +%! assert (get (h, "linestyle"), get (0, "defaultsurfacelinestyle")); +%! assert (get (h, "linewidth"), get (0, "defaultsurfacelinewidth"), eps); +%! assert (get (h, "marker"), get (0, "defaultsurfacemarker")); +%! assert (get (h, "markersize"), get (0, "defaultsurfacemarkersize")); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/surfc.m b/octave_packages/m/plot/surfc.m new file mode 100644 index 0000000..6812c36 --- /dev/null +++ b/octave_packages/m/plot/surfc.m @@ -0,0 +1,94 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} surfc (@var{x}, @var{y}, @var{z}) +## Plot a surface and contour given matrices @var{x}, and @var{y} from +## @code{meshgrid} and a matrix @var{z} corresponding to the @var{x} and +## @var{y} coordinates of the mesh. If @var{x} and @var{y} are vectors, +## then a typical vertex is (@var{x}(j), @var{y}(i), @var{z}(i,j)). Thus, +## columns of @var{z} correspond to different @var{x} values and rows of +## @var{z} correspond to different @var{y} values. +## @seealso{meshgrid, surf, contour} +## @end deftypefn + +function h = surfc (varargin) + + newplot (); + + tmp = surface (varargin{:}); + + ax = get (tmp, "parent"); + + set (tmp, "facecolor", "flat"); + + if (! ishold ()) + set (ax, "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + + drawnow (); + zmin = get (ax, "zlim")(1); + + # don't pass axis handle and/or string arguments to __contour__() + stop_idx = nargin; + for i = 2 : nargin + if (ischar (varargin{i})) + stop_idx = i - 1; + break; + endif + endfor + + start_idx = 1; + if (ishandle (varargin{1})) + start_idx = 2; + endif + + if (stop_idx - start_idx == 1 || stop_idx - start_idx == 3) + #don't pass a color matrix c to __contour__ + stop_idx -= 1; + endif + + [c, tmp2] = __contour__ (ax, zmin, varargin{start_idx:stop_idx}); + + tmp = [tmp; tmp2]; + + if (nargout > 0) + h = tmp; + endif + +endfunction + +%!demo +%! clf +%! [~,~,Z]=peaks; +%! surfc(Z); + +%!demo +%! clf +%! [~,~,Z]=sombrero; +%! [Fx,Fy] = gradient(Z); +%! surfc(Z,Fx+Fy); +%! shading interp; + +%!demo +%! clf +%! [X,Y,Z]=sombrero; +%! [~,Fy] = gradient(Z); +%! surfc(X,Y,Z,Fy); +%! shading interp; diff --git a/octave_packages/m/plot/surfl.m b/octave_packages/m/plot/surfl.m new file mode 100644 index 0000000..60ea5ce --- /dev/null +++ b/octave_packages/m/plot/surfl.m @@ -0,0 +1,188 @@ +## Copyright (C) 2009-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} surfl (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {} surfl (@var{z}) +## @deftypefnx {Function File} {} surfl (@var{x}, @var{y}, @var{z}, @var{L}) +## @deftypefnx {Function File} {} surfl (@var{x}, @var{y}, @var{z}, @var{L}, @var{P}) +## @deftypefnx {Function File} {} surfl (@dots{}, "light") +## Plot a lighted surface given matrices @var{x}, and @var{y} from +## @code{meshgrid} and +## a matrix @var{z} corresponding to the @var{x} and @var{y} coordinates of +## the mesh. If @var{x} and @var{y} are vectors, then a typical vertex +## is (@var{x}(j), @var{y}(i), @var{z}(i,j)). Thus, columns of @var{z} +## correspond to different @var{x} values and rows of @var{z} correspond +## to different @var{y} values. +## +## The light direction can be specified using @var{L}. It can be +## given as 2-element vector [azimuth, elevation] in degrees or as 3-element +## vector [lx, ly, lz]. +## The default value is rotated 45° counter-clockwise from the current view. +## +## The material properties of the surface can specified using a 4-element vector +## @var{P} = [@var{AM} @var{D} @var{SP} @var{exp}] which defaults to +## @var{p} = [0.55 0.6 0.4 10]. +## @table @asis +## @item "AM" strength of ambient light +## +## @item "D" strength of diffuse reflection +## +## @item "SP" strength of specular reflection +## +## @item "EXP" specular exponent +## @end table +## +## The default lighting mode "cdata", changes the cdata property to give the +## impression +## of a lighted surface. Please note: the alternative "light" mode, which +## creates a light +## object to illuminate the surface is not implemented (yet). +## +## Example: +## +## @example +## @group +## colormap (bone (64)); +## surfl (peaks); +## shading interp; +## @end group +## @end example +## @seealso{surf, diffuse, specular, surface} +## @end deftypefn + +## Author: Kai Habel + +function retval = surfl (varargin) + + [h, varargin] = __plt_get_axis_arg__ ("surfl", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + newplot (); + + ## Check for lighting type. + use_cdata = true; + if (ischar (varargin{end})) + lstr = varargin{end}; + if (strncmp (tolower (lstr), "light", 5)) + warning ("light method not supported (yet), using cdata method instead"); + ## This can be implemented when light objects are supported. + use_cdata = false; + elseif (strncmp (tolower (lstr), "cdata", 5)) + use_cdata = true; + else + error ("surfl: unknown lighting method"); + endif + varargin(end) = []; + endif + + ## Check for reflection properties argument. + ## + ## r = [ambient light strength, + ## diffuse reflection strength, + ## specular reflection strength, + ## specular shine] + if (length (varargin{end}) == 4 && isnumeric (varargin{end})) + r = varargin{end}; + varargin(end) = []; + else + ## Default values. + r = [0.55, 0.6, 0.4, 10]; + endif + + ## Check for light vector (lv) argument. + have_lv = false; + if (isnumeric (varargin{end})) + len = numel (varargin{end}); + lastarg = varargin{end}; + if (len == 3) + lv = lastarg; + varargin(end) = []; + have_lv = true; + elseif (len == 2) + [lv(1), lv(2), lv(3)] = sph2cart ((lastarg(1) - 90) * pi/180, lastarg(2) * pi/180, 1.0); + varargin(end) = []; + have_lv = true; + endif + endif + + tmp = surface (varargin{:}); + if (! ishold ()) + set (h, "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on", "clim", [0 1]); + endif + + ## Get view vector (vv). + a = axis; + [az, el] = view; + [vv(1), vv(2), vv(3)] = sph2cart ((az - 90) * pi/180.0, el * pi/180.0, 1.0); + vv /= norm (vv); + + if (!have_lv) + ## Calculate light vector (lv) from view vector. + Phi = 45.0 / 180.0 * pi; + R = [cos(Phi), -sin(Phi), 0; + sin(Phi), cos(Phi), 0; + 0, 0, 1]; + lv = (R * vv.').'; + endif + + vn = get (tmp, "vertexnormals"); + dar = get (h, "plotboxaspectratio"); + vn(:,:,1) *= dar(1); + vn(:,:,2) *= dar(2); + vn(:,:,3) *= dar(3); + + ## Normalize vn. + vn = vn ./ repmat (sqrt (sumsq (vn, 3)), [1, 1, 3]); + [nr, nc] = size(get(tmp, "zdata")); + + ## Ambient, diffuse, and specular term. + cdata = (r(1) * ones (nr, nc) + + r(2) * diffuse (vn(:,:,1), vn(:,:,2), vn(:,:,3), lv) + + r(3) * specular (vn(:,:,1), vn(:,:,2), vn(:,:,3), lv, vv, r(4))); + + set (tmp, "cdata", cdata ./ sum (r(1:3))); + + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + + if (nargout > 0) + retval = tmp; + endif + +endfunction + +%!demo +%! clf +%! [X,Y,Z]=sombrero; +%! colormap(copper); +%! surfl(X,Y,Z); +%! shading interp; + +%!demo +%! clf +%! [X,Y,Z]=sombrero; +%! colormap(copper); +%! [az, el] = view; +%! surfl(X,Y,Z,[az+225,el],[0.2 0.6 0.4 25]); +%! shading interp; + diff --git a/octave_packages/m/plot/surfnorm.m b/octave_packages/m/plot/surfnorm.m new file mode 100644 index 0000000..c06f331 --- /dev/null +++ b/octave_packages/m/plot/surfnorm.m @@ -0,0 +1,157 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} surfnorm (@var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {} surfnorm (@var{z}) +## @deftypefnx {Function File} {[@var{nx}, @var{ny}, @var{nz}] =} surfnorm (@dots{}) +## @deftypefnx {Function File} {} surfnorm (@var{h}, @dots{}) +## Find the vectors normal to a meshgridded surface. The meshed gridded +## surface is defined by @var{x}, @var{y}, and @var{z}. If @var{x} and +## @var{y} are not defined, then it is assumed that they are given by +## +## @example +## @group +## [@var{x}, @var{y}] = meshgrid (1:size (@var{z}, 1), +## 1:size (@var{z}, 2)); +## @end group +## @end example +## +## If no return arguments are requested, a surface plot with the normal +## vectors to the surface is plotted. Otherwise the components of the normal +## vectors at the mesh gridded points are returned in @var{nx}, @var{ny}, +## and @var{nz}. +## +## The normal vectors are calculated by taking the cross product of the +## diagonals of each of the quadrilaterals in the meshgrid to find the +## normal vectors of the centers of these quadrilaterals. The four nearest +## normal vectors to the meshgrid points are then averaged to obtain the +## normal to the surface at the meshgridded points. +## +## An example of the use of @code{surfnorm} is +## +## @example +## surfnorm (peaks (25)); +## @end example +## @seealso{surf, quiver3} +## @end deftypefn + +function [Nx, Ny, Nz] = surfnorm (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ((nargout != 0), "surfnorm", + varargin{:}); + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (nargin == 1) + z = varargin{1}; + [x, y] = meshgrid (1:size(z,1), 1:size(z,2)); + ioff = 2; + else + x = varargin{1}; + y = varargin{2}; + z = varargin{3}; + ioff = 4; + endif + + if (!ismatrix (z) || isvector (z) || isscalar (z)) + error ("surfnorm: Z argument must be a matrix"); + endif + if (! size_equal (x, y, z)) + error ("surfnorm: X, Y, and Z must have the same dimensions"); + endif + + ## Make life easier, and avoid having to do the extrapolation later, do + ## a simpler linear extrapolation here. This is approximative, and works + ## badly for closed surfaces like spheres. + xx = [2 .* x(:,1) - x(:,2), x, 2 .* x(:,end) - x(:,end-1)]; + xx = [2 .* xx(1,:) - xx(2,:); xx; 2 .* xx(end,:) - xx(end-1,:)]; + yy = [2 .* y(:,1) - y(:,2), y, 2 .* y(:,end) - y(:,end-1)]; + yy = [2 .* yy(1,:) - yy(2,:); yy; 2 .* yy(end,:) - yy(end-1,:)]; + zz = [2 .* z(:,1) - z(:,2), z, 2 .* z(:,end) - z(:,end-1)]; + zz = [2 .* zz(1,:) - zz(2,:); zz; 2 .* zz(end,:) - zz(end-1,:)]; + + u.x = xx(1:end-1,1:end-1) - xx(2:end,2:end); + u.y = yy(1:end-1,1:end-1) - yy(2:end,2:end); + u.z = zz(1:end-1,1:end-1) - zz(2:end,2:end); + v.x = xx(1:end-1,2:end) - xx(2:end,1:end-1); + v.y = yy(1:end-1,2:end) - yy(2:end,1:end-1); + v.z = zz(1:end-1,2:end) - zz(2:end,1:end-1); + + c = cross ([u.x(:), u.y(:), u.z(:)], [v.x(:), v.y(:), v.z(:)]); + w.x = reshape (c(:,1), size(u.x)); + w.y = reshape (c(:,2), size(u.y)); + w.z = reshape (c(:,3), size(u.z)); + + ## Create normal vectors as mesh vectices from normals at mesh centers + nx = (w.x(1:end-1,1:end-1) + w.x(1:end-1,2:end) + + w.x(2:end,1:end-1) + w.x(2:end,2:end)) ./ 4; + ny = (w.y(1:end-1,1:end-1) + w.y(1:end-1,2:end) + + w.y(2:end,1:end-1) + w.y(2:end,2:end)) ./ 4; + nz = (w.z(1:end-1,1:end-1) + w.z(1:end-1,2:end) + + w.z(2:end,1:end-1) + w.z(2:end,2:end)) ./ 4; + + ## Normalize the normal vectors + len = sqrt (nx.^2 + ny.^2 + nz.^2); + nx = nx ./ len; + ny = ny ./ len; + nz = nz ./ len; + + if (nargout == 0) + oldh = gca (); + unwind_protect + axes (h); + newplot (); + surf (x, y, z, varargin{ioff:end}); + old_hold_state = get (h, "nextplot"); + unwind_protect + set (h, "nextplot", "add"); + plot3 ([x(:)'; x(:).' + nx(:).' ; NaN(size(x(:).'))](:), + [y(:)'; y(:).' + ny(:).' ; NaN(size(y(:).'))](:), + [z(:)'; z(:).' + nz(:).' ; NaN(size(z(:).'))](:), + varargin{ioff:end}); + unwind_protect_cleanup + set (h, "nextplot", old_hold_state); + end_unwind_protect + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + else + Nx = nx; + Ny = ny; + Nz = nz; + endif + +endfunction + +%!demo +%! clf +%! colormap (jet (64)) +%! [x, y, z] = peaks(10); +%! surfnorm (x, y, z); + +%!demo +%! clf +%! surfnorm (peaks(10)); + +%!demo +%! clf +%! surfnorm (peaks(32)); +%! shading interp diff --git a/octave_packages/m/plot/text.m b/octave_packages/m/plot/text.m new file mode 100644 index 0000000..e1ea39b --- /dev/null +++ b/octave_packages/m/plot/text.m @@ -0,0 +1,254 @@ +## Copyright (C) 2007-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} text (@var{x}, @var{y}, @var{label}) +## @deftypefnx {Function File} {} text (@var{x}, @var{y}, @var{z}, @var{label}) +## @deftypefnx {Function File} {} text (@var{x}, @var{y}, @var{label}, @var{p1}, @var{v1}, @dots{}) +## @deftypefnx {Function File} {} text (@var{x}, @var{y}, @var{z}, @var{label}, @var{p1}, @var{v1}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} text (@dots{}) +## Create a text object with text @var{label} at position @var{x}, +## @var{y}, @var{z} on the current axes. Property-value pairs following +## @var{label} may be used to specify the appearance of the text. +## +## The optional return value @var{h} is a graphics handle to the created text +## object. +## @end deftypefn + +## Author: jwe + +function h = text (varargin) + + nargs = nargin; + offset = 0; + + if (nargs > 2 && isnumeric (varargin{1}) && isnumeric (varargin{2})) + x = varargin{1}; + y = varargin{2}; + offset = 3; + + if (nargin > 3 && isnumeric (varargin{3})) + z = varargin{3}; + offset = 4; + else + z = zeros (size (x)); + offset = 3; + endif + + label = varargin{offset}; + varargin(1:offset) = []; + + nx = numel (x); + ny = numel (y); + nz = numel (z); + if (ischar (label) || isnumeric (label)) + nt = size (label, 1); + if (nx > 1 && nt == 1) + ## Mutiple text objects with same string + label = repmat ({label}, [nx, 1]); + nt = nx; + elseif (nx > 1 && nt == nx) + ## Mutiple text objects with different strings + label = cellstr (label); + elseif (ischar (label)) + ## Single text object with one or more lines + label = {label}; + endif + elseif (iscell (label)) + nt = numel (label); + if (nx > 1 && nt == 1) + label = repmat ({label}, [nx, 1]); + nt = nx; + elseif (! (nx > 1 && nt == nx)) + label = {label}; + nt = 1; + endif + else + error ("text: expecting LABEL to be a character string or cell array of character strings"); + endif + else + x = y = z = 0; + nx = ny = nz = 1; + label = {""}; + nt = 1; + endif + + if (rem (numel (varargin), 2) == 0) + + if (nx == ny && nx == nz && (nt == nx || nt == 1 || nx == 1)) + pos = [x(:), y(:), z(:)]; + ca = gca (); + tmp = zeros (nt, 1); + if (nx == 1) + ## TODO - Modify __go_text__() to accept cell-strings + tmp = __go_text__ (ca, "string", "foobar", + varargin{:}, + "position", pos); + set (tmp, "string", label{1}); + elseif (nt == nx) + for n = 1:nt + tmp(n) = __go_text__ (ca, "string", label{n}, + varargin{:}, + "position", pos(n,:)); + endfor + __request_drawnow__ (); + else + error ("text: dimension mismatch for coordinates and LABEL"); + endif + elseif (nt == nx || nt == 1 || nx == 1) + error ("text: dimension mismatch for coordinates"); + else + error ("text: mismatch betwween coordinates and strings"); + endif + + if (nargout > 0) + h = tmp; + endif + + else + print_usage (); + endif + +endfunction + +%!demo +%! clf +%! ha = {"left", "center", "right"}; +%! va = {"bottom", "middle", "top"}; +%! x = [0.25 0.5 0.75]; +%! y = [0.25 0.5 0.75]; +%! for t = 0:30:359; +%! for nh = 1:numel(ha) +%! for nv = 1:numel(va) +%! text (x(nh), y(nv), "Hello World", ... +%! "rotation", t, ... +%! "horizontalalignment", ha{nh}, ... +%! "verticalalignment", va{nv}); +%! endfor +%! endfor +%! endfor +%! set (gca, "xtick", [0.25, 0.5, 0.75], ... +%! "xticklabel", ha, ... +%! "ytick", [0.25, 0.5, 0.75], ... +%! "yticklabel", va); +%! axis ([0 1 0 1]); +%! xlabel ("horizontal alignment"); +%! ylabel ("vertical alignment"); +%! title ("text alignment and rotation (0:30:360 degrees)") + +%!demo +%! clf +%! h = mesh (peaks, "edgecolor", 0.7 * [1 1 1], ... +%! "facecolor", "none", ... +%! "facealpha", 0); +%! for t = 0:45:359; +%! text (25, 25, 0, "Vertical Alignment = Bottom", ... +%! "rotation", t, ... +%! "horizontalalignment", "left", ... +%! "verticalalignment", "bottom"); +%! endfor +%! caxis ([-100 100]); +%! title ("Vertically Aligned at Bottom"); + +%!demo +%! clf +%! axis ([0 8 0 8]); +%! title (["1st title";"2nd title"]); +%! xlabel (["1st xlabel";"2nd xlabel"]); +%! ylabel (["1st ylabel";"2nd ylabel"]); +%! text (4, 4, {"Hello", "World"}, ... +%! "horizontalalignment", "center", ... +%! "verticalalignment", "middle"); +%! grid on + +%!demo +%! clf +%! h = mesh (peaks, "edgecolor", 0.7 * [1 1 1], ... +%! "facecolor", "none", ... +%! "facealpha", 0); +%! title (["1st title";"2nd title"]); +%! xlabel (["1st xlabel";"2nd xlabel"]); +%! ylabel (["1st ylabel";"2nd ylabel"]); +%! zlabel (["1st zlabel";"2nd zlabel"]); +%! text (0, 0, 5, {"Hello", "World"}, ... +%! "horizontalalignment", "center", ... +%! "verticalalignment", "middle"); +%! hold on; +%! plot3 (0, 0, 5, "+k"); + +%!demo +%! clf +%! h = text (0.5, 0.3, "char"); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.5, 0.4, ["char row 1"; "char row 2"]); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.5, 0.6, {"cell2str (1,1)", "cell2str (1,2)"; "cell2str (2,1)", "cell2str (2,2)"}); +%! assert ("cell", class (get (h, "string"))); +%! h = text (0.5, 0.8, "foobar"); +%! set (h, "string", 1:3); +%! h = text ([0.1, 0.1], [0.3, 0.4], "one string & two objects"); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.5, 0.6], {"one cellstr & two objects"}); +%! assert ("cell", class (get (h(1), "string"))); +%! assert ("cell", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.7, 0.8], {"cellstr 1 object 1", "cellstr 2 object 2"}); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.1, 0.2], ["1st string & 1st object"; "2nd string & 2nd object"]); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text (0.7, 0.6, "single string"); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.7, 0.5, {"single cell-string"}); +%! assert ("cell", class (get (h, "string"))); +%! xlabel (1:2); +%! ylabel (1:2); +%! title (1:2); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = text (0.5, 0.3, "char"); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.5, 0.4, ["char row 1"; "char row 2"]); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.5, 0.6, {"cell2str (1,1)", "cell2str (1,2)"; "cell2str (2,1)", "cell2str (2,2)"}); +%! assert ("cell", class (get (h, "string"))); +%! h = text (0.5, 0.8, "foobar"); +%! set (h, "string", 1:3); +%! h = text ([0.1, 0.1], [0.3, 0.4], "one string & two objects"); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.5, 0.6], {"one cellstr & two objects"}); +%! assert ("cell", class (get (h(1), "string"))); +%! assert ("cell", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.7, 0.8], {"cellstr 1 object 1", "cellstr 2 object 2"}); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text ([0.1, 0.1], [0.1, 0.2], ["1st string & 1st object"; "2nd string & 2nd object"]); +%! assert ("char", class (get (h(1), "string"))); +%! assert ("char", class (get (h(2), "string"))); +%! h = text (0.7, 0.6, "single string"); +%! assert ("char", class (get (h, "string"))); +%! h = text (0.7, 0.5, {"single cell-string"}); +%! assert ("cell", class (get (h, "string"))); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/title.m b/octave_packages/m/plot/title.m new file mode 100644 index 0000000..0a0a01c --- /dev/null +++ b/octave_packages/m/plot/title.m @@ -0,0 +1,83 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} title (@var{string}) +## @deftypefnx {Function File} {} title (@var{string}, @var{p1}, @var{v1}, @dots{}) +## @deftypefnx {Function File} {} title (@var{h}, @dots{}) +## @deftypefnx {Function File} {@var{h} =} title (@dots{}) +## Create a title object for a plot. +## +## The optional return value @var{h} is a graphics handle to the created object. +## @end deftypefn + +## Author: jwe + +function retval = title (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("title", varargin{:}); + + if (rem (nargin, 2) != 1) + print_usage (); + endif + + tmp = __axis_label__ (h, "title", varargin{:}); + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!demo +%! clf (); +%! ax = axes(); +%! xl = get (ax,"title"); +%! title ("Testing title"); +%! assert (get (xl,"string"), "Testing title"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xl = get(gca (), "title"); +%! title ("Testing title"); +%! assert (get (xl,"string"),"Testing title"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! ax = axes(); +%! xl = get (ax,"title"); +%! title ("Testing title"); +%! assert (get (xl,"string"), "Testing title"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! xl = get (gca (), "title"); +%! title("Testing title"); +%! assert (get (xl,"string"), "Testing title"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/trimesh.m b/octave_packages/m/plot/trimesh.m new file mode 100644 index 0000000..395fe36 --- /dev/null +++ b/octave_packages/m/plot/trimesh.m @@ -0,0 +1,69 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} trimesh (@var{tri}, @var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {@var{h} =} trimesh (@dots{}) +## Plot a triangular mesh in 3D@. The variable @var{tri} is the triangular +## meshing of the points @code{(@var{x}, @var{y})} which is returned +## from @code{delaunay}. The variable @var{z} is value at the point +## @code{(@var{x}, @var{y})}. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## @seealso{triplot, trisurf, delaunay3} +## @end deftypefn + +function h = trimesh (tri, x, y, z, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (nargin == 3) + triplot (tri, x, y); + elseif (ischar (z)) + triplot (tri, x, y, z, varargin{:}); + else + newplot (); + handle = patch ("Vertices", [x(:), y(:), z(:)], "Faces", tri, + "FaceColor", "none", "EdgeColor", __next_line_color__(), + varargin{:}); + if (! ishold ()) + set (gca(), "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + if (nargout > 0) + h = handle; + endif + endif + +endfunction + + +%!demo +%! clf +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 10); +%! N = 10; +%! x = 3 - 6 * rand (N, N); +%! y = 3 - 6 * rand (N, N); +%! z = peaks (x, y); +%! tri = delaunay (x(:), y(:)); +%! trimesh (tri, x(:), y(:), z(:)); + diff --git a/octave_packages/m/plot/triplot.m b/octave_packages/m/plot/triplot.m new file mode 100644 index 0000000..91564ed --- /dev/null +++ b/octave_packages/m/plot/triplot.m @@ -0,0 +1,60 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} triplot (@var{tri}, @var{x}, @var{y}) +## @deftypefnx {Function File} {} triplot (@var{tri}, @var{x}, @var{y}, @var{linespec}) +## @deftypefnx {Function File} {@var{h} =} triplot (@dots{}) +## Plot a triangular mesh in 2D@. The variable @var{tri} is the triangular +## meshing of the points @code{(@var{x}, @var{y})} which is returned from +## @code{delaunay}. If given, @var{linespec} determines the properties +## to use for the lines. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## @seealso{plot, trimesh, trisurf, delaunay} +## @end deftypefn + +function h = triplot (tri, x, y, varargin) + + if (nargin < 3) + print_usage (); + endif + + idx = tri(:, [1, 2, 3, 1]).'; + nt = rows (tri); + handle = plot ([x(idx); NaN(1, nt)](:), + [y(idx); NaN(1, nt)](:), varargin{:}); + + if (nargout > 0) + h = handle; + endif + +endfunction + + +%!demo +%! clf +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 2); +%! N = 20; +%! x = rand (N, 1); +%! y = rand (N, 1); +%! tri = delaunay (x, y); +%! triplot (tri, x, y); + diff --git a/octave_packages/m/plot/trisurf.m b/octave_packages/m/plot/trisurf.m new file mode 100644 index 0000000..ea20b73 --- /dev/null +++ b/octave_packages/m/plot/trisurf.m @@ -0,0 +1,131 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} trisurf (@var{tri}, @var{x}, @var{y}, @var{z}) +## @deftypefnx {Function File} {@var{h} =} trisurf (@dots{}) +## Plot a triangular surface in 3D@. The variable @var{tri} is the triangular +## meshing of the points @code{(@var{x}, @var{y})} which is returned +## from @code{delaunay}. The variable @var{z} is value at the point +## @code{(@var{x}, @var{y})}. +## +## The optional return value @var{h} is a graphics handle to the created plot. +## @seealso{triplot, trimesh, delaunay3} +## @end deftypefn + +function h = trisurf (tri, x, y, z, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (nargin == 3) + triplot (tri, x, y); + elseif (ischar (z)) + triplot (tri, x, y, z, varargin{:}); + else + if (nargin > 4 && isnumeric (varargin{1})) + c = varargin{1}; + varargin(1) = []; + else + c = z; + endif + if (! any (strcmpi (varargin, "FaceColor"))) + nfc = numel (varargin) + 1; + varargin(nfc+(0:1)) = {"FaceColor", "flat"}; + else + nfc = find (any (strcmpi (varargin, "FaceColor")), 1); + endif + if (! any (strcmpi (varargin, "EdgeColor")) + && strcmpi (varargin{nfc+1}, "interp")) + varargin(end+(1:2)) = {"EdgeColor", "none"}; + endif + newplot (); + handle = patch ("Faces", tri, "Vertices", [x(:), y(:), z(:)], + "FaceVertexCData", reshape (c, numel (c), 1), + varargin{:}); + if (nargout > 0) + h = handle; + endif + + if (! ishold ()) + set (gca(), "view", [-37.5, 30], + "xgrid", "on", "ygrid", "on", "zgrid", "on"); + endif + endif + +endfunction + +%!demo +%! clf +%! N = 31; +%! [x, y] = meshgrid (1:N); +%! tri = delaunay (x, y); +%! z = peaks (N); +%! h = trisurf (tri, x, y, z, "facecolor", "interp"); +%! axis tight +%! zlim auto +%! title (sprintf ("facecolor = %s", get (h, "facecolor"))) + +%!demo +%! clf +%! N = 31; +%! [x, y] = meshgrid (1:N); +%! tri = delaunay (x, y); +%! z = peaks (N); +%! h = trisurf (tri, x, y, z, "facecolor", "flat"); +%! axis tight +%! zlim auto +%! title (sprintf ("facecolor = %s", get (h, "facecolor"))) + +%!demo +%! clf +%! old_state = rand ("state"); +%! restore_state = onCleanup (@() rand ("state", old_state)); +%! rand ("state", 10); +%! N = 10; +%! x = 3 - 6 * rand (N, N); +%! y = 3 - 6 * rand (N, N); +%! z = peaks (x, y); +%! tri = delaunay (x(:), y(:)); +%! trisurf (tri, x(:), y(:), z(:)); + +%!demo +%! clf +%! x = rand (100, 1); +%! y = rand (100, 1); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); +%! trisurf (tri, x, y, z); + +%!demo +%! clf +%! x = rand (100, 1); +%! y = rand (100, 1); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); +%! trisurf (tri, x, y, z, "facecolor", "interp"); + +%!demo +%! clf +%! x = rand (100, 1); +%! y = rand (100, 1); +%! z = x.^2 + y.^2; +%! tri = delaunay (x, y); +%! trisurf (tri, x, y, z, "facecolor", "interp", "edgecolor", "k"); + diff --git a/octave_packages/m/plot/uicontextmenu.m b/octave_packages/m/plot/uicontextmenu.m new file mode 100644 index 0000000..9339de6 --- /dev/null +++ b/octave_packages/m/plot/uicontextmenu.m @@ -0,0 +1,30 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uicontextmenu ('Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uicontextmenu (varargin) + + [h, args] = __uiobject_split_args__ ("uicontextmenu", varargin, {"figure"}); + handle = __go_uicontextmenu__ (h, args{:}); + +endfunction diff --git a/octave_packages/m/plot/uicontrol.m b/octave_packages/m/plot/uicontrol.m new file mode 100644 index 0000000..3e6e674 --- /dev/null +++ b/octave_packages/m/plot/uicontrol.m @@ -0,0 +1,36 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uicontrol ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uicontrol (@var{parent}, 'Name', value, @dots{}) +## @deftypefnx {Function File} {} uicontrol (@var{handle}) +## @end deftypefn + +## Author: goffioul + +function handle = uicontrol (varargin) + + if (nargin == 1 && ishandle (varargin{1}) && strcmpi (get (varargin{1}, "type"), "uicontrol")) + error ("uicontrol focusing not implemented yet."); + else + [h, args] = __uiobject_split_args__ ("uicontrol", varargin, {"figure", "uipanel", "uibuttongroup"}); + handle = __go_uicontrol__ (h, args{:}); + endif + +endfunction diff --git a/octave_packages/m/plot/uigetdir.m b/octave_packages/m/plot/uigetdir.m new file mode 100644 index 0000000..d1fb9de --- /dev/null +++ b/octave_packages/m/plot/uigetdir.m @@ -0,0 +1,66 @@ +## Copyright (C) 2010-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{dirname} =} uigetdir () +## @deftypefnx {Function File} {@var{dirname} =} uigetdir (@var{init_path}) +## @deftypefnx {Function File} {@var{dirname} =} uigetdir (@var{init_path}, @var{dialog_name}) +## Open a GUI dialog for selecting a directory. If @var{init_path} is not +## given the current working directory is used. @var{dialog_name} may be +## used to customize the dialog title. +## @seealso{uigetfile} +## @end deftypefn + +## Author: Kai Habel + +function dirname = uigetdir (init_path = pwd, dialog_name = "Select Directory to Open") + + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uigetdir_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uigetdir_fltk__"; + if (! __is_function__ (funcname)) + error ("uigetdir: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uigetdir: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); + endif + endif + + if (nargin > 2) + print_usage (); + endif + + if (!ischar (init_path) || !ischar (dialog_name)) + error ("uigetdir: INIT_PATH and DIALOG_NAME must be string arguments"); + endif + + if (!isdir (init_path)) + init_path = fileparts (init_path); + endif + dirname = feval (funcname, init_path, dialog_name); + +endfunction + +%!demo +%! uigetdir(pwd, "Select Directory") + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1); diff --git a/octave_packages/m/plot/uigetfile.m b/octave_packages/m/plot/uigetfile.m new file mode 100644 index 0000000..67917e9 --- /dev/null +++ b/octave_packages/m/plot/uigetfile.m @@ -0,0 +1,193 @@ +## Copyright (C) 2010-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uigetfile () +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@var{flt}) +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@var{flt}, @var{dialog_name}) +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@var{flt}, @var{dialog_name}, @var{default_file}) +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@dots{}, "Position", [@var{px} @var{py}]) +## @deftypefnx {Function File} {[@dots{}] =} uigetfile (@dots{}, "MultiSelect", @var{mode}) +## +## Open a GUI dialog for selecting a file. It returns the filename @var{fname}, +## the path to this file @var{fpath}, and the filter index @var{fltidx}. +## @var{flt} contains a (list of) file filter string(s) in one of the following +## formats: +## +## @table @asis +## @item "/path/to/filename.ext" +## If a filename is given then the file extension is extracted and used as +## filter. In addition, the path is selected as current path and the filename +## is selected as default file. Example: @code{uigetfile ("myfun.m")} +## +## @item A single file extension "*.ext" +## Example: @code{uigetfile ("*.ext")} +## +## @item A 2-column cell array +## containing a file extension in the first column and a brief description +## in the second column. +## Example: @code{uigetfile (@{"*.ext", "My Description";"*.xyz", +## "XYZ-Format"@})} +## +## The filter string can also contain a semicolon separated list of filter +## extensions. +## Example: @code{uigetfile (@{"*.gif;*.png;*.jpg", "Supported Picture +## Formats"@})} +## @end table +## +## @var{dialog_name} can be used to customize the dialog title. +## If @var{default_file} is given then it will be selected in the GUI dialog. +## If, in addition, a path is given it is also used as current path. +## +## The screen position of the GUI dialog can be set using the "Position" key +## and a 2-element vector containing the pixel coordinates. +## Two or more files can be selected when setting the "MultiSelect" key to "on". +## In that case @var{fname} is a cell array containing the files. +## @end deftypefn + +## Author: Kai Habel + +function [retfile, retpath, retindex] = uigetfile (varargin) + + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uigetfile_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uigetfile_fltk__"; + if (! __is_function__ (funcname)) + error ("uigetfile: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uigetfile: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); + endif + endif + + if (nargin > 7) + error ("uigetfile: number of input arguments must be less than eight"); + endif + + defaultvals = {cell(0, 2), # File Filter + "Open File", # Dialog Title + "", # Default file name + [240, 120], # Dialog Position (pixel x/y) + "off", # MultiSelect on/off + pwd}; # Default directory + + outargs = cell (6, 1); + for i = 1 : 6 + outargs{i} = defaultvals{i}; + endfor + + idx1 = idx2 = []; + if (length (varargin) > 0) + for i = 1 : length (varargin) + val = varargin{i}; + if (ischar (val)) + if (strncmpi (val, "multiselect", 11)) + idx1 = i; + elseif (strncmpi (val, "position", 8)) + idx2 = i; + endif + endif + endfor + endif + + stridx = [idx1, idx2, 0]; + if (length (stridx) > 1) + stridx = min (stridx(1 : end - 1)); + endif + + args = varargin; + if (stridx) + args = varargin(1 : stridx - 1); + endif + + len = length (args); + if (len > 0) + file_filter = args{1}; + [outargs{1}, outargs{3}, defdir] = __file_filter__ (file_filter); + if (length (defdir) > 0) + outargs{6} = defdir; + endif + else + outargs{1} = __file_filter__ (outargs{1}); + endif + + if (len > 1) + if (ischar (args{2})) + if (length (args{2}) > 0) + outargs{2} = args{2}; + endif + elseif (! isempty (args{2})) + print_usage (); + endif + endif + + if (len > 2) + if (ischar (args{3})) + [fdir, fname, fext] = fileparts (args{3}); + if (length (fdir) > 0) + outargs{6} = fdir; + endif + if (length (fname) > 0 || length (fext) > 0) + outargs{3} = strcat (fname, fext); + endif + elseif (! isempty (args{3})) + print_usage (); + endif + endif + + if (stridx) + ## we have string arguments ("position" or "multiselect") + + ## check for even number of remaining arguments, prop/value pair(s) + if (rem (nargin - stridx + 1, 2)) + error ("uigetfile: expecting property/value pairs"); + endif + + for i = stridx : 2 : nargin + prop = varargin{i}; + val = varargin{i + 1}; + if (strncmp (tolower (prop), "position", 8)) + if (ismatrix (val) && length(val) == 2) + outargs{4} = val; + else + error ("uigetfile: expecting 2-element vector for position argument"); + endif + elseif (strncmp (tolower (prop), "multiselect", 11)) + if (ischar (val)) + outargs{5} = tolower (val); + else + error ("uigetfile: expecting string argument (on/off) for multiselect"); + endif + else + error ("uigetfile: unknown argument"); + endif + endfor + endif + + [retfile, retpath, retindex] = feval (funcname, outargs{:}); + +endfunction + +%!demo +%! uigetfile({"*.gif;*.png;*.jpg", "Supported Picture Formats"}) + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1); diff --git a/octave_packages/m/plot/uimenu.m b/octave_packages/m/plot/uimenu.m new file mode 100644 index 0000000..e25bea0 --- /dev/null +++ b/octave_packages/m/plot/uimenu.m @@ -0,0 +1,149 @@ +## Copyright (C) 2010-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} uimenu (@var{property}, @var{value}, @dots{}) +## @deftypefnx {Function File} {} uimenu (@var{h}, @var{property}, @var{value}, @dots{}) +## Create a uimenu object and return a handle to it. If @var{h} is ommited +## then a top-level menu for the current figure is created. If @var{h} +## is given then a submenu relative to @var{h} is created. +## +## uimenu objects have the following specific properties: +## +## @table @asis +## @item "accelerator" +## A string containing the key combination together with CTRL to execute this +## menu entry (e.g., "x" for CTRL+x). +## +## @item "callback" +## Is the function called when this menu entry is executed. It can be either a +## function string (e.g., "myfun"), a function handle (e.g., @@myfun) or a cell +## array containing the function handle and arguments for the callback +## function (e.g., @{@@myfun, arg1, arg2@}). +## +## @item "checked" +## Can be set "on" or "off". Sets a mark at this menu entry. +## +## @item "enable" +## Can be set "on" or "off". If disabled the menu entry cannot be selected +## and it is grayed out. +## +## @item "foregroundcolor" +## A color value setting the text color for this menu entry. +## +## @item "label" +## A string containing the label for this menu entry. A "&"-symbol can be +## used to mark the "accelerator" character (e.g., @nospell{"E&xit"}) +## +## @item "position" +## An scalar value containing the relative menu position. The entry with the +## lowest value is at the first position starting from left or top. +## +## @item "separator" +## Can be set "on" or "off". If enabled it draws a separator line above the +## current position. It is ignored for top level entries. +## +## @end table +## +## Examples: +## +## @example +## @group +## f = uimenu ("label", "&File", "accelerator", "f"); +## e = uimenu ("label", "&Edit", "accelerator", "e"); +## uimenu (f, "label", "Close", "accelerator", "q", ... +## "callback", "close (gcf)"); +## uimenu (e, "label", "Toggle &Grid", "accelerator", "g", ... +## "callback", "grid (gca)"); +## @end group +## @end example +## @seealso{figure} +## @end deftypefn + +## Author: Kai Habel + +function hui = uimenu (varargin) + + [h, args] = __uiobject_split_args__ ("uimenu", varargin, {"figure", "uicontextmenu", "uimenu"}); + + tmp = __go_uimenu__ (h, args{:}); + + if (nargout > 0) + hui = tmp; + endif + +endfunction + + +%!demo +%! clf +%! surfl (peaks); +%! colormap (copper); +%! shading ("interp"); +%! f = uimenu ("label", "&File", "accelerator", "f"); +%! e = uimenu ("label", "&Edit", "accelerator", "e"); +%! uimenu (f, "label", "Close", "accelerator", "q", "callback", "close (gcf)"); +%! uimenu (e, "label", "Toggle &Grid", "accelerator", "g", "callback", "grid (gca)"); + +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! ui = uimenu ("label", "mylabel"); +%! assert (findobj (hf, "type", "uimenu"), ui); +%! assert (get (ui, "label"), "mylabel"); +%! assert (get (ui, "checked"), "off"); +%! assert (get (ui, "separator"), "off"); +%! assert (get (ui, "enable"), "on"); +%! assert (get (ui, "position"), 9); +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect + +%% check for top level menus file, edit, and help +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! uif = findall (hf, "label", "&file"); +%! assert (ishghandle (uif)) +%! uie = findall (hf, "label", "&edit"); +%! assert (ishghandle (uie)) +%! uih = findall (hf, "label", "&help"); +%! assert (ishghandle (uih)) +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect + +%!testif HAVE_FLTK +%! toolkit = graphics_toolkit (); +%! graphics_toolkit ("fltk"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! uie = findall (hf, "label", "&edit"); +%! myui = uimenu (uie, "label", "mylabel"); +%! assert (ancestor (myui, "uimenu", "toplevel"), uie) +%! unwind_protect_cleanup +%! close (hf); +%! graphics_toolkit (toolkit); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/uipanel.m b/octave_packages/m/plot/uipanel.m new file mode 100644 index 0000000..5460911 --- /dev/null +++ b/octave_packages/m/plot/uipanel.m @@ -0,0 +1,31 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uipanel ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uipanel (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uipanel (varargin) + + [h, args] = __uiobject_split_args__ ("uipanel", varargin, {"figure", "uipanel", "uibuttongroup"}); + handle = __go_uipanel__ (h, args{:}); + +endfunction diff --git a/octave_packages/m/plot/uipushtool.m b/octave_packages/m/plot/uipushtool.m new file mode 100644 index 0000000..999d21f --- /dev/null +++ b/octave_packages/m/plot/uipushtool.m @@ -0,0 +1,39 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uipushtool ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uipushtool (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uipushtool (varargin) + + [h, args] = __uiobject_split_args__ ("uipushtool", varargin, {"uitoolbar"}, 0); + if (isempty (h)) + h = findobj (gcf, "-depth", 1, "type", "uitoolbar"); + if (isempty (h)) + h = uitoolbar (); + else + h = h(1); + endif + endif + handle = __go_uipushtool__ (h, args{:}); + +endfunction diff --git a/octave_packages/m/plot/uiputfile.m b/octave_packages/m/plot/uiputfile.m new file mode 100644 index 0000000..a019491 --- /dev/null +++ b/octave_packages/m/plot/uiputfile.m @@ -0,0 +1,128 @@ +## Copyright (C) 2010-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile () +## @deftypefnx {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile (@var{flt}) +## @deftypefnx {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile (@var{flt}, @var{dialog_name}) +## @deftypefnx {Function File} {[@var{fname}, @var{fpath}, @var{fltidx}] =} uiputfile (@var{flt}, @var{dialog_name}, @var{default_file}) +## Open a GUI dialog for selecting a file. @var{flt} contains a (list of) file +## filter string(s) in one of the following formats: +## +## @table @code +## @item "/path/to/filename.ext" +## If a filename is given the file extension is +## extracted and used as filter. +## In addition the path is selected as current path and the filename is selected +## as default file. +## Example: uiputfile("myfun.m"); +## +## @item "*.ext" +## A single file extension. +## Example: uiputfile("*.ext"); +## +## @item @{"*.ext","My Description"@} +## A 2-column cell array containing the file extension in the 1st column and +## a brief description in the 2nd column. +## Example: uiputfile(@{"*.ext","My Description";"*.xyz","XYZ-Format"@}); +## @end table +## +## The filter string can also contain a semicolon separated list of filter +## extensions. +## Example: uiputfile(@{"*.gif;*.png;*.jpg", "Supported Picture Formats"@}); +## +## @var{dialog_name} can be used to customize the dialog title. +## If @var{default_file} is given it is preselected in the GUI dialog. +## If, in addition, a path is given it is also used as current path. +## @end deftypefn + +## Author: Kai Habel + +function [retfile, retpath, retindex] = uiputfile (varargin) + + defaulttoolkit = get (0, "defaultfigure__graphics_toolkit__"); + funcname = ["__uiputfile_", defaulttoolkit, "__"]; + functype = exist (funcname); + if (! __is_function__ (funcname)) + funcname = "__uiputfile_fltk__"; + if (! __is_function__ (funcname)) + error ("uiputfile: fltk graphics toolkit required"); + elseif (! strcmp (defaulttoolkit, "gnuplot")) + warning ("uiputfile: no implementation for toolkit `%s', using `fltk' instead", + defaulttoolkit); + endif + endif + + if (nargin > 3) + print_usage (); + endif + + defaultvals = {cell(0, 2), # File Filter + "Save File", # Dialog Title + "", # Default file name + [240, 120], # Dialog Position (pixel x/y) + "create", + pwd}; # Default directory + + outargs = cell(6, 1); + for i = 1 : 6 + outargs{i} = defaultvals{i}; + endfor + + if (nargin > 0) + file_filter = varargin{1}; + [outargs{1}, outargs{3}, defdir] = __file_filter__ (file_filter); + if (length (defdir) > 0) + outargs{6} = defdir; + endif + else + outargs{1} = __file_filter__ (outargs{1}); + endif + + if (nargin > 1) + if (ischar (varargin{2})) + outargs{2} = varargin{2}; + elseif (! isempty (varargin{2})) + print_usage (); + endif + endif + + if (nargin > 2) + if (ischar (varargin{3})) + [fdir, fname, fext] = fileparts (varargin{3}); + if (! isempty (fdir)) + outargs{6} = fdir; + endif + if (! isempty (fname) || ! isempty (fext)) + outargs{3} = strcat (fname, fext); + endif + elseif (! isempty (varargin{3})) + print_usage (); + endif + endif + + [retfile, retpath, retindex] = feval (funcname, outargs{:}); + +endfunction + +%!demo +%! uiputfile({"*.gif;*.png;*.jpg", "Supported Picture Formats"}) + +## Remove from test statistics. No real tests possible. +%!test +%! assert (1); diff --git a/octave_packages/m/plot/uiresume.m b/octave_packages/m/plot/uiresume.m new file mode 100644 index 0000000..8666bb2 --- /dev/null +++ b/octave_packages/m/plot/uiresume.m @@ -0,0 +1,45 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} uiresume (@var{h}) +## Resume program execution suspended with @code{uiwait}. The handle @var{h} +## must be the same as the on specified in @code{uiwait}. If the handle +## is invalid or there is no @code{uiwait} call pending for the figure +## with handle @var{h}, this function does nothing. +## @seealso{uiwait} +## @end deftypefn + +## Author: goffioul + +function uiresume (h) + + if (! ishandle (h) || ! strcmp (get (h, "type"), "figure")) + error ("uiresume: invalid figure handle"); + endif + + try + uiwait_state = get (h, "__uiwait_state__"); + if (strcmp (uiwait_state, "active")) + set (h, "__uiwait_state__", "triggered"); + endif + catch + # Ignore exception + end_try_catch + +endfunction diff --git a/octave_packages/m/plot/uitoggletool.m b/octave_packages/m/plot/uitoggletool.m new file mode 100644 index 0000000..9547cc6 --- /dev/null +++ b/octave_packages/m/plot/uitoggletool.m @@ -0,0 +1,39 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uitoggletool ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uitoggletool (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uitoggletool (varargin) + + [h, args] = __uiobject_split_args__ ("uitoggletool", varargin, {"uitoolbar"}, 0); + if (isempty (h)) + h = findobj (gcf, "-depth", 1, "type", "uitoolbar"); + if (isempty (h)) + h = uitoolbar (); + else + h = h(1); + endif + endif + handle = __go_uitoggletool__ (h, args{:}); + +endfunction diff --git a/octave_packages/m/plot/uitoolbar.m b/octave_packages/m/plot/uitoolbar.m new file mode 100644 index 0000000..ed1d60d --- /dev/null +++ b/octave_packages/m/plot/uitoolbar.m @@ -0,0 +1,31 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{handle} =} uitoolbar ('Name', value, @dots{}) +## @deftypefnx {Function File} {@var{handle} =} uitoolbar (@var{parent}, 'Name', value, @dots{}) +## @end deftypefn + +## Author: goffioul + +function handle = uitoolbar (varargin) + + [h, args] = __uiobject_split_args__ ("uitoolbar", varargin, {"figure"}); + handle = __go_uitoolbar__ (h, args{:}); + +endfunction diff --git a/octave_packages/m/plot/uiwait.m b/octave_packages/m/plot/uiwait.m new file mode 100644 index 0000000..ca9a946 --- /dev/null +++ b/octave_packages/m/plot/uiwait.m @@ -0,0 +1,80 @@ +## Copyright (C) 2012 Michael Goffioul +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} uiwait +## @deftypefnx {Function File} {} uiwait (@var{h}) +## @deftypefnx {Function File} {} uiwait (@var{h}, @var{timeout}) +## Suspend program execution until the figure with handle @var{h} is +## deleted or @code{uiresume} is called. When no figure handle is specified, +## this function uses the current figure. +## +## If the figure handle is invalid or there is no current figure, this +## functions returns immediately. +## +## When specified, @var{timeout} defines the number of seconds to wait +## for the figure deletion or the @code{uiresume} call. The timeout value +## must be at least 1. If a smaller value is specified, a warning is issued +## and a timeout value of 1 is used instead. If a non-integer value is +## specified, it is truncated towards 0. If @var{timeout} is not specified, +## the program execution is suspended indefinitely. +## @seealso{uiresume, waitfor} +## @end deftypefn + +## Author: goffioul + +function uiwait (varargin) + + h = []; + timeout = []; + + if (nargin == 0) + h = get (0, "currentfigure"); + else + h = varargin{1}; + if (! ishandle (h) || ! strcmp (get (h, "type"), "figure")) + error ("uiwait: invalid figure handle"); + endif + if (nargin > 1) + timeout = varargin{2}; + endif + endif + + if (! isempty (h)) + unwind_protect + try + addproperty ("__uiwait_state__", h, "radio", "none|{active}|triggered"); + catch + if (! strcmp (get (h, "__uiwait_state__"), "none")) + error ("uiwait: an active uiwait call for this figure already exists"); + endif + set (h, "__uiwait_state__", "active"); + end_try_catch + waitfor_args = {h, "__uiwait_state__", "triggered"}; + if (! isempty (timeout)) + waitfor_args(end+1:end+2) = {"timeout", timeout}; + endif + waitfor (waitfor_args{:}); + unwind_protect_cleanup + if (ishandle (h) && isprop (h, "__uiwait_state__")) + set (h, "__uiwait_state__", "none"); + endif + end_unwind_protect + endif + +endfunction diff --git a/octave_packages/m/plot/view.m b/octave_packages/m/plot/view.m new file mode 100644 index 0000000..849a7c6 --- /dev/null +++ b/octave_packages/m/plot/view.m @@ -0,0 +1,124 @@ +## Copyright (C) 2007-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{azimuth}, @var{elevation}] =} view () +## @deftypefnx {Function File} {} view (@var{azimuth}, @var{elevation}) +## @deftypefnx {Function File} {} view ([@var{azimuth} @var{elevation}]) +## @deftypefnx {Function File} {} view ([@var{x} @var{y} @var{z}]) +## @deftypefnx {Function File} {} view (@var{dims}) +## @deftypefnx {Function File} {} view (@var{ax}, @dots{}) +## Query or set the viewpoint for the current axes. The parameters +## @var{azimuth} and @var{elevation} can be given as two arguments or as +## 2-element vector. +## The viewpoint can also be given with Cartesian coordinates @var{x}, +## @var{y}, and @var{z}. +## The call @code{view (2)} sets the viewpoint to @var{azimuth} = 0 +## and @var{elevation} = 90, which is the default for 2-D graphs. +## The call @code{view (3)} sets the viewpoint to @var{azimuth} = -37.5 +## and @var{elevation} = 30, which is the default for 3-D graphs. +## If @var{ax} is given, the viewpoint is set for this axes, otherwise +## it is set for the current axes. +## @end deftypefn + +## Author: jwe + +function [azimuth, elevation] = view (varargin) + + if (nargin < 4) + if (nargin == 0) + args = {get(gca (), "view")}; + else + ax = varargin{1}; + if (ishandle (ax) && strcmp (get (ax, "type"), "axes")) + args = varargin(2:end); + else + ax = gca; + args = varargin; + endif + endif + if (length (args) == 1) + x = args{1}; + if (length (x) == 2) + az = x(1); + el = x(2); + elseif (length (x) == 3) + [az, el] = cart2sph (x(1), x(2), x(3)); + az *= 180/pi; + az += 90; + el *= 180/pi; + elseif (x == 2) + az = 0; + el = 90; + elseif (x == 3) + az = -37.5; + el = 30; + else + print_usage (); + endif + elseif (length (args) == 2) + az = args{1}; + el = args{2}; + endif + + if (nargin > 0) + set (ax, "view", [az, el]); + endif + + if (nargout == 1) + error ("view: T = view () not implemented"); + endif + + if (nargout == 2) + azimuth = az; + elevation = el; + endif + else + print_usage (); + endif + +endfunction + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! [az, el] = view; +%! assert ([az, el], [-37.5, 30], eps); +%! view (2); +%! [az, el] = view; +%! assert ([az, el], [0, 90], eps); +%! view ([1 1 0]); +%! [az, el] = view; +%! assert ([az, el], [135, 0], eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! line; +%! [az, el] = view; +%! assert ([az, el], [0, 90], eps); +%! view (3); +%! [az, el] = view; +%! assert ([az, el], [-37.5, 30], eps); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/waitbar.m b/octave_packages/m/plot/waitbar.m new file mode 100644 index 0000000..aac87ef --- /dev/null +++ b/octave_packages/m/plot/waitbar.m @@ -0,0 +1,188 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{h} =} waitbar (@var{frac}) +## @deftypefnx {Function File} {@var{h} =} waitbar (@var{frac}, @var{msg}) +## @deftypefnx {Function File} {@var{h} =} waitbar (@dots{}, "FigureProperty", "Value", @dots{}) +## @deftypefnx {Function File} {} waitbar (@var{frac}) +## @deftypefnx {Function File} {} waitbar (@var{frac}, @var{hwbar}) +## @deftypefnx {Function File} {} waitbar (@var{frac}, @var{hwbar}, @var{msg}) +## Return a handle @var{h} to a new waitbar object. The waitbar is +## filled to fraction @var{frac} which must be in the range [0, 1]. The +## optional message @var{msg} is centered and displayed above the waitbar. +## The appearance of the waitbar figure window can be configured by passing +## property/value pairs to the function. +## +## When called with a single input the current waitbar, if it exists, is +## updated to the new value @var{frac}. If there are multiple outstanding +## waitbars they can be updated individually by passing the handle @var{hwbar} +## of the specific waitbar to modify. +## @end deftypefn + +## Author: jwe + +function retval = waitbar (varargin) + + persistent curr_waitbar; + + if (nargin < 1) + print_usage (); + endif + + frac = varargin{1}; + varargin(1) = []; + + if (! (isnumeric (frac) && isscalar (frac) && frac >= 0 && frac <= 1)) + error ("waitbar: FRAC must be between 0 and 1"); + endif + + ## Use existing waitbar if it still points to a valid graphics handle. + if (nargin == 1 && ishandle (curr_waitbar)) + h = curr_waitbar; + else + h = false; + endif + + if (! isempty (varargin) && isnumeric (varargin{1})) + if (! ishandle (varargin{1})) + error ("waitbar: H must be a handle to a waitbar object"); + else + h = varargin{1}; + varargin(1) = []; + if (! isfigure (h) || ! strcmp (get (h, "tag"), "waitbar")) + error ("waitbar: H must be a handle to a waitbar object"); + endif + endif + endif + + msg = false; + + if (! isempty (varargin)) + msg = varargin{1}; + varargin(1) = []; + if (! (ischar (msg) || iscellstr (msg))) + error ("waitbar: MSG must be a character string or cell array of strings"); + endif + endif + + if (rem (numel (varargin), 2) != 0) + error ("waitbar: invalid number of property-value pairs"); + endif + + if (h) + p = findobj (h, "type", "patch"); + set (p, "xdata", [0; frac; frac; 0]); + ax = findobj (h, "type", "axes"); + if (ischar (msg) || iscellstr (msg)) + th = get (ax, "title"); + curr_msg = get (th, "string"); + ## graphics handles always store data as column vectors + if (iscellstr (msg)) + msg = msg(:); + endif + cmp = strcmp (msg, curr_msg); + if (! all (cmp(:))) + set (th, "string", msg); + endif + endif + else + h = __go_figure__ (NaN, "position", [250, 500, 400, 100], + "numbertitle", "off", + "toolbar", "none", "menubar", "none", + "integerhandle", "off", + "handlevisibility", "callback", + "tag", "waitbar", + varargin{:}); + + ax = axes ("parent", h, "xtick", [], "ytick", [], + "xlim", [0, 1], "ylim", [0, 1], + "xlimmode", "manual", "ylimmode", "manual", + "position", [0.1, 0.3, 0.8, 0.2]); + + patch (ax, [0; frac; frac; 0], [0; 0; 1; 1], [0, 0.35, 0.75]); + + if (! (ischar (msg) || iscellstr (msg))) + msg = "Please wait..."; + endif + title (ax, msg); + endif + + drawnow (); + + if (nargout > 0) + retval = h; + endif + + ## If there were no errors, update current waitbar. + curr_waitbar = h; + +endfunction + + +%!demo +%! h = waitbar (0, "0.00%"); +%! for i = 0:0.01:1 +%! waitbar (i, h, sprintf ("%.2f%%", 100*i)); +%! endfor +%! close (h); + +%!demo +%! h = waitbar (0, "please wait..."); +%! for i = 0:0.01:0.6 +%! waitbar (i); +%! endfor +%! i = 0.3; +%! waitbar (i, h, "don't you hate taking a step backward?") +%! pause (0.5); +%! for i = i:0.005:0.7 +%! waitbar (i, h); +%! endfor +%! waitbar (i, h, "or stalling?") +%! pause (1); +%! for i = i:0.003:0.8 +%! waitbar (i, h, "just a little longer now") +%! endfor +%! for i = i:0.001:1 +%! waitbar (i, h, "please don't be impatient") +%! endfor +%! close (h); + +%!demo +%! h1 = waitbar (0, "Waitbar #1"); +%! h2 = waitbar (0, "Waitbar #2"); +%! h2pos = get (h2, "position"); +%! h2pos(1) += h2pos(3) + 50; +%! set (h2, "position", h2pos); +%! pause (0.5); +%! for i = 1:4 +%! waitbar (i/4, h1); +%! pause (0.5); +%! waitbar (i/4, h2); +%! pause (0.5); +%! endfor +%! pause (0.5); +%! close (h1); +%! close (h2); + +%% Test input validation +%!error waitbar (-0.5) +%!error waitbar (1.5) +%!error waitbar (0.5, struct ()) +%!error waitbar (0.5, "msg", "Name") + diff --git a/octave_packages/m/plot/waitforbuttonpress.m b/octave_packages/m/plot/waitforbuttonpress.m new file mode 100644 index 0000000..924329f --- /dev/null +++ b/octave_packages/m/plot/waitforbuttonpress.m @@ -0,0 +1,47 @@ +## Copyright (C) 2004-2012 Petr Mikulik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{b} =} waitforbuttonpress () +## Wait for button or mouse press.over a figure window. The value of +## @var{b} returns 0 if a mouse button was pressed or 1 is a key was +## pressed. +## @seealso{ginput} +## @end deftypefn + +## The original version of this code bore the copyright +## Author: Petr Mikulik +## License: public domain + +function a = waitforbuttonpress () + + if (nargin != 0 || nargout > 1) + print_usage (); + endif + + [x, y, k] = ginput (1); + + if (nargout == 1) + if (k <= 5) + a = 0; + else + a = 1; + endif + endif + +endfunction diff --git a/octave_packages/m/plot/whitebg.m b/octave_packages/m/plot/whitebg.m new file mode 100644 index 0000000..a0810ae --- /dev/null +++ b/octave_packages/m/plot/whitebg.m @@ -0,0 +1,164 @@ +## Copyright (C) 2010-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} whitebg () +## @deftypefnx {Function File} {} whitebg (@var{color}) +## @deftypefnx {Function File} {} whitebg ("none") +## @deftypefnx {Function File} {} whitebg (@var{fig}) +## @deftypefnx {Function File} {} whitebg (@var{fig}, @var{color}) +## @deftypefnx {Function File} {} whitebg (@var{fig}, "none") +## Invert the colors in the current color scheme. The root properties are +## also inverted such that all subsequent plot use the new color scheme. +## +## If defined, @var{fig} is the handle to the figure to be inverted. In +## this case only the specified figure has its color properties changed. +## +## If the optional argument @var{color} is present then the background color +## is set to @var{color} rather than inverted. @var{color} may be a string +## representing one of the eight known colors or an RGB triplet. The special +## string argument "none" restores the plot to the default colors. +## @seealso{reset} +## @end deftypefn + +function whitebg (varargin) + h = 0; + color = NaN; + + if (nargin > 0 && nargin < 3) + if (ishandle (varargin{1})) + h = varargin{1}; + if (nargin == 2) + color = varargin{2}; + endif + elseif (nargin == 1) + color = varargin{1}; + else + print_usage (); + endif + elseif (nargin != 0) + print_usage (); + endif + + typ = get (h, "type"); + + if (strcmp (typ, "root")) + isroot = true; + fig = gcf (); + elseif (strcmp (typ, "figure")) + isroot = false; + fig = h; + else + error ("expecting a figure handle"); + endif + + axes = findall (fig, "type", "axes"); + if (isnan (color)) + ## Root figure. Set the default axes and figure properties so that + ## subsequent plots have the new color scheme + if (isroot) + fac = get (0, "factory"); + fields = fieldnames (fac); + fieldindex = intersect (find (!cellfun ("isempty", regexp(fields, 'color'))), union (find (!cellfun ("isempty", regexp(fields, 'factoryaxes.*'))), find (!cellfun ("isempty", regexp(fields, 'factoryfigure.*'))))); + + ## Check whether the factory value has been replaced + for nf = 1 : numel (fieldindex); + defaultfield = strrep (fields {fieldindex (nf)}, "factory", "default"); + try + defaultvalue = 1 - get (0, defaultfield {n}); + catch + field = fields {fieldindex (nf)}; + defaultvalue = 1 - subsref (fac, struct ("type", ".", "subs", field)); + end_try_catch + set (0, defaultfield, defaultvalue); + endfor + endif + + ## Load all objects which qualify for being searched. + handles = fig; + h = fig; + while (numel (handles)) + children = []; + for n = 1 : numel (handles) + children = union (children, get(handles(n), "children")); + endfor + handles = children; + h = union (h, children); + endwhile + + for nh = 1 : numel(h) + p = get (h (nh)); + fields = fieldnames (p); + fieldindex = find (!cellfun ("isempty", regexp(fields, 'color'))); + if (numel (fieldindex)) + for nf = 1 : numel (fieldindex); + field = fields {fieldindex (nf)}; + c = subsref (p, struct ("type", ".", "subs", field)); + if (! ischar(c) && columns(c) == 3) + set (h (nh), field, 1 - c); + endif + endfor + endif + + ## If h(nh) is a figure or axes invert default color properties + typ = subsref (p, struct ("type", ".", "subs", "type")); + if (strcmp (typ, "axes") || strcmp (typ, "figure")) + def = get (h (nh), "default"); + fields = fieldnames (def); + if (! isempty (fields)) + fieldindex = find (!cellfun ("isempty", regexp(fields, 'color'))); + for nf = 1 : numel (fieldindex) + defaultfield = fields {fieldindex (nf)}; + defaultvalue = 1 - subsref (def, struct ("type", ".", "subs", defaultfield)); + set (h (nh), defaultfield, defaultvalue); + endfor + endif + endif + endfor + else + ## FIXME + ## Is this the right thing to do in this case? + set (findall (fig, "type", "axes"), "color", color); + if (isroot) + defs = get (0, "default"); + if (isfield (defs, "defaultaxescolor") + && strcmp (defs.defaultaxescolor, "none")) + set (0, "defaultaxescolor", color); + endif + endif + endif +endfunction + +%!test +%! dac = get (0, "defaultaxescolor"); +%! dfc = get (0, "defaultfigurecolor"); +%! hf = figure ("visible", "off"); +%! unwind_protect +%! l = line; +%! assert (get (hf, "color"), dfc); +%! assert (get (gca, "color"), dac); +%! whitebg (hf); +%! assert (get (hf, "color"), 1 - dfc); +%! assert (get (gca, "color"), 1 - dac); +%! c = [0.2 0.2 0.2]; +%! whitebg (hf, c); +%! assert (get (hf, "color"), 1 - dfc); +%! assert (get (gca, "color"), c); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/xlabel.m b/octave_packages/m/plot/xlabel.m new file mode 100644 index 0000000..9344e3d --- /dev/null +++ b/octave_packages/m/plot/xlabel.m @@ -0,0 +1,63 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} xlabel (@var{string}) +## @deftypefnx {Function File} {} xlabel (@var{h}, @var{string}) +## @deftypefnx {Function File} {@var{h} =} xlabel (@dots{}) +## @deftypefnx {Function File} {} ylabel (@dots{}) +## @deftypefnx {Function File} {} zlabel (@dots{}) +## Specify x-, y-, or z-axis labels for the current axis. If @var{h} is +## specified then label the axis defined by @var{h}. +## +## The optional return value @var{h} is a graphics handle to the created object. +## @seealso{title, text} +## @end deftypefn + +## Author: jwe + +function retval = xlabel (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("xlabel", varargin{:}); + + if (rem (nargin, 2) != 1) + print_usage (); + endif + + tmp = __axis_label__ (h, "xlabel", varargin{:}, + "color", get (h, "xcolor")); + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! x = xlabel ("xlabel_string"); +%! assert (get (gca, "xlabel"), x); +%! assert (get (x, "type"), "text"); +%! assert (get (x, "visible"), "on"); +%! assert (get (x, "string"), "xlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/xlim.m b/octave_packages/m/plot/xlim.m new file mode 100644 index 0000000..11fd018 --- /dev/null +++ b/octave_packages/m/plot/xlim.m @@ -0,0 +1,100 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @c List other forms of function in documentation index +## @findex ylim +## @findex zlim +## +## @deftypefn {Function File} {@var{xl} =} xlim () +## @deftypefnx {Function File} {} xlim (@var{xl}) +## @deftypefnx {Function File} {@var{m} =} xlim ('mode') +## @deftypefnx {Function File} {} xlim (@var{m}) +## @deftypefnx {Function File} {} xlim (@var{h}, @dots{}) +## Get or set the limits of the x-axis of the current plot. Called without +## arguments @code{xlim} returns the x-axis limits of the current plot. +## If passed a two element vector @var{xl}, the limits of the x-axis are set +## to this value. +## +## The current mode for calculation of the x-axis can be returned with a +## call @code{xlim ('mode')}, and can be either 'auto' or 'manual'. The +## current plotting mode can be set by passing either 'auto' or 'manual' +## as the argument. +## +## If passed a handle as the first argument, then operate on this handle +## rather than the current axes handle. +## @seealso{ylim, zlim, set, get, gca} +## @end deftypefn + +function retval = xlim (varargin) + ret = __axes_limits__ ("xlim", varargin{:}); + + if (! isempty (ret)) + retval = ret; + endif +endfunction + +%!demo +%! clf (); +%! line (); +%! xlim ([0.2, 0.8]); +%! title ("xlim is [0.2, 0.8]"); +%! assert (xlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! xlim ('auto'); +%! title ("xlim is auto"); +%! assert (xlim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ([0.2, 0.8]); +%! title ("xlim is [0.2, 0.8]"); +%! assert (xlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ('auto'); +%! title ("xlim is auto"); +%! assert (xlim ("mode"), "auto"); + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0,1]); +%! xlim ([0, 1.1]); +%! assert (get (gca, "xlim"), [0, 1.1], eps); +%! assert (xlim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! h = plot3 ([0,1.1], [0,1], [0, 1]); +%! assert (get (gca, "xlim"), [0, 1.4], eps); +%! assert (xlim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/ylabel.m b/octave_packages/m/plot/ylabel.m new file mode 100644 index 0000000..d8a484a --- /dev/null +++ b/octave_packages/m/plot/ylabel.m @@ -0,0 +1,57 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ylabel (@var{string}) +## @deftypefnx {Function File} {} ylabel (@var{h}, @var{string}) +## @deftypefnx {Function File} {@var{h} =} ylabel (@dots{}) +## @seealso{xlabel} +## @end deftypefn + +## Author: jwe + +function retval = ylabel (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("ylabel", varargin{:}); + + if (rem (nargin, 2) != 1) + print_usage (); + endif + + tmp = __axis_label__ (h, "ylabel", varargin{:}, + "color", get (h, "ycolor")); + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! y = ylabel ("ylabel_string"); +%! assert (get (gca, "ylabel"), y); +%! assert (get (y, "type"), "text"); +%! assert (get (y, "visible"), "on"); +%! assert (get (y, "string"), "ylabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/ylim.m b/octave_packages/m/plot/ylim.m new file mode 100644 index 0000000..faac19a --- /dev/null +++ b/octave_packages/m/plot/ylim.m @@ -0,0 +1,96 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{yl} =} ylim () +## @deftypefnx {Function File} {} ylim (@var{yl}) +## @deftypefnx {Function File} {@var{m} =} ylim ('mode') +## @deftypefnx {Function File} {} ylim (@var{m}) +## @deftypefnx {Function File} {} ylim (@var{h}, @dots{}) +## Get or set the limits of the y-axis of the current plot. Called without +## arguments @code{ylim} returns the y-axis limits of the current plot. +## If passed a two element vector @var{yl}, the limits of the y-axis are set +## to this value. +## +## The current mode for calculation of the y-axis can be returned with a +## call @code{ylim ('mode')}, and can be either 'auto' or 'manual'. The +## current plotting mode can be set by passing either 'auto' or 'manual' +## as the argument. +## +## If passed a handle as the first argument, then operate on this handle +## rather than the current axes handle. +## @seealso{xlim, zlim, set, get, gca} +## @end deftypefn + +function retval = ylim (varargin) + ret = __axes_limits__ ("ylim", varargin{:}); + + if (! isempty (ret)) + retval = ret; + endif +endfunction + +%!demo +%! clf (); +%! line (); +%! ylim ([0.2, 0.8]); +%! title ("ylim is [0.2, 0.8]"); +%! assert (ylim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! ylim ('auto'); +%! title ("ylim is auto"); +%! assert (ylim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim ([0.2, 0.8]); +%! title ("ylim is [0.2, 0.8]"); +%! assert (ylim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim ('auto'); +%! title ("ylim is auto"); +%! assert (ylim ("mode"), "auto"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! limy = [0, 1.1]; +%! plot3 ([0,1], [0,1], [0,1]); +%! ylim (limy); +%! assert (get (gca, "ylim"), limy, eps); +%! assert (ylim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1.1], [0, 1]); +%! assert (get (gca, "ylim"), [0, 1.4], eps); +%! assert (ylim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/plot/zlabel.m b/octave_packages/m/plot/zlabel.m new file mode 100644 index 0000000..3de33a1 --- /dev/null +++ b/octave_packages/m/plot/zlabel.m @@ -0,0 +1,70 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} zlabel (@var{string}) +## @deftypefnx {Function File} {} zlabel (@var{h}, @var{string}) +## @deftypefnx {Function File} {@var{h} =} zlabel (@dots{}) +## @seealso{xlabel} +## @end deftypefn + +## Author: jwe + +function retval = zlabel (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("zlabel", varargin{:}); + + if (rem (nargin, 2) != 1) + print_usage (); + endif + + tmp = __axis_label__ (h, "zlabel", varargin{:}, + "color", get (h, "zcolor")); + + if (nargout > 0) + retval = tmp; + endif + +endfunction + + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! z = zlabel ("zlabel_string"); +%! assert (get (gca, "zlabel"), z); +%! assert (get (z, "type"), "text"); +%! assert (get (z, "visible"), "off"); +%! assert (get (z, "string"), "zlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! plot3 (0, 0, 0); +%! unwind_protect +%! z = zlabel ("zlabel_string"); +%! assert (get (gca, "zlabel"), z); +%! assert (get (z, "type"), "text"); +%! assert (get (z, "visible"), "off"); +%! assert (get (z, "string"), "zlabel_string"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + diff --git a/octave_packages/m/plot/zlim.m b/octave_packages/m/plot/zlim.m new file mode 100644 index 0000000..3119910 --- /dev/null +++ b/octave_packages/m/plot/zlim.m @@ -0,0 +1,96 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{zl} =} zlim () +## @deftypefnx {Function File} {} zlim (@var{zl}) +## @deftypefnx {Function File} {@var{m} =} zlim ('mode') +## @deftypefnx {Function File} {} zlim (@var{m}) +## @deftypefnx {Function File} {} zlim (@var{h}, @dots{}) +## Get or set the limits of the z-axis of the current plot. Called without +## arguments @code{zlim} returns the z-axis limits of the current plot. +## If passed a two element vector @var{zl}, the limits of the z-axis are set +## to this value. +## +## The current mode for calculation of the z-axis can be returned with a +## call @code{zlim ('mode')}, and can be either 'auto' or 'manual'. The +## current plotting mode can be set by passing either 'auto' or 'manual' +## as the argument. +## +## If passed a handle as the first argument, then operate on this handle +## rather than the current axes handle. +## @seealso{xlim, ylim, set, get, gca} +## @end deftypefn + +function retval = zlim (varargin) + ret = __axes_limits__ ("zlim", varargin{:}); + + if (! isempty (ret)) + retval = ret; + endif +endfunction + +%!demo +%! clf (); +%! line (); +%! zlim ([0.2, 0.8]); +%! title ("zlim is [0.2, 0.8]"); +%! assert (zlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! line (); +%! zlim ('auto'); +%! title ("zlim is auto"); +%! assert (zlim ("mode"), "auto"); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim ([0.2, 0.8]); +%! title ("zlim is [0.2, 0.8]"); +%! assert (zlim (), [0.2, 0.8]); + +%!demo +%! clf (); +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim ('auto'); +%! title ("zlim is auto"); +%! assert (zlim ("mode"), "auto"); + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! limz = [0, 1.1]; +%! plot3 ([0,1], [0,1], [0,1]); +%! zlim (limz); +%! assert (get (gca, "zlim"), limz, eps); +%! assert (zlim ("mode"), "manual"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect + +%!test +%! hf = figure ("visible", "off"); +%! unwind_protect +%! plot3 ([0,1], [0,1], [0, 1.1]); +%! assert (get (gca, "zlim"), [0, 1.4], eps); +%! assert (zlim ("mode"), "auto"); +%! unwind_protect_cleanup +%! close (hf); +%! end_unwind_protect diff --git a/octave_packages/m/polynomial/compan.m b/octave_packages/m/polynomial/compan.m new file mode 100644 index 0000000..171ed33 --- /dev/null +++ b/octave_packages/m/polynomial/compan.m @@ -0,0 +1,93 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} compan (@var{c}) +## Compute the companion matrix corresponding to polynomial coefficient +## vector @var{c}. +## +## The companion matrix is +## @tex +## $$ +## A = \left[\matrix{ +## -c_2/c_1 & -c_3/c_1 & \cdots & -c_N/c_1 & -c_{N+1}/c_1\cr +## 1 & 0 & \cdots & 0 & 0 \cr +## 0 & 1 & \cdots & 0 & 0 \cr +## \vdots & \vdots & \ddots & \vdots & \vdots \cr +## 0 & 0 & \cdots & 1 & 0}\right]. +## $$ +## @end tex +## @ifnottex +## @c Set example in small font to prevent overfull line +## +## @smallexample +## @group +## _ _ +## | -c(2)/c(1) -c(3)/c(1) @dots{} -c(N)/c(1) -c(N+1)/c(1) | +## | 1 0 @dots{} 0 0 | +## | 0 1 @dots{} 0 0 | +## A = | . . . . . | +## | . . . . . | +## | . . . . . | +## |_ 0 0 @dots{} 1 0 _| +## @end group +## @end smallexample +## +## @end ifnottex +## The eigenvalues of the companion matrix are equal to the roots of the +## polynomial. +## @seealso{roots, poly, eig} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function A = compan (c) + + if (nargin != 1) + print_usage (); + endif + + if (! isvector (c)) + error ("compan: expecting a vector argument"); + endif + + n = length (c); + + if (n == 1) + A = []; + else + A = diag (ones (n-2, 1), -1); + A(1,:) = -c(2:n) / c(1); + endif + +endfunction + +%!assert(all (all (compan ([1, 2, 3]) == [-2, -3; 1, 0]))); + +%!assert(all (all (compan ([1; 2; 3]) == [-2, -3; 1, 0]))); + +%!assert(isempty (compan (4))); + +%!assert(all (all (compan ([3, 2, 1]) == [-2/3, -1/3; 1, 0]))); + +%!error compan ([1,2;3,4]); + +%!error compan ([]); + diff --git a/octave_packages/m/polynomial/conv.m b/octave_packages/m/polynomial/conv.m new file mode 100644 index 0000000..0d087e7 --- /dev/null +++ b/octave_packages/m/polynomial/conv.m @@ -0,0 +1,141 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} conv (@var{a}, @var{b}) +## @deftypefnx {Function File} {} conv (@var{a}, @var{b}, @var{shape}) +## Convolve two vectors @var{a} and @var{b}. +## +## The output convolution is a vector with length equal to +## @code{length (@var{a}) + length (@var{b}) - 1}. +## When @var{a} and @var{b} are the coefficient vectors of two polynomials, the +## convolution represents the coefficient vector of the product polynomial. +## +## The optional @var{shape} argument may be +## +## @table @asis +## @item @var{shape} = "full" +## Return the full convolution. (default) +## +## @item @var{shape} = "same" +## Return the central part of the convolution with the same size as @var{a}. +## @end table +## +## @seealso{deconv, conv2, convn, fftconv} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function y = conv (a, b, shape = "full") + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (! (isvector (a) && isvector (b))) + error ("conv: both arguments A and B must be vectors"); + elseif (nargin == 3 && ! any (strcmpi (shape, {"full", "same"}))) + error ('conv: SHAPE argument must be "full" or "same"'); + endif + + la = length (a); + lb = length (b); + + ly = la + lb - 1; + + if (ly == 0) + y = zeros (1, 0); + return; + endif + + ## Use shortest vector as the coefficent vector to filter. + if (la > lb) + [a, b] = deal (b, a); # Swap vectors + lb = la; + endif + x = b; + + ## Pad longer vector to convolution length. + if (ly > lb) + x(end+1:end+ly-lb) = 0; + endif + + y = filter (a, 1, x); + + if (strcmp (shape, "same")) + idx = ceil ((ly - la) / 2); + y = y(idx+1:idx+la); + endif + +endfunction + + +%!test +%! x = ones(3,1); +%! y = ones(1,3); +%! b = 2; +%! c = 3; +%! assert (conv (x, x), [1; 2; 3; 2; 1]); +%! assert (conv (y, y), [1, 2, 3, 2, 1]); +%! assert (conv (x, y), [1, 2, 3, 2, 1]); +%! assert (conv (y, x), [1; 2; 3; 2; 1]); +%! assert (conv (c, x), [3; 3; 3]); +%! assert (conv (c, y), [3, 3, 3]); +%! assert (conv (x, c), [3; 3; 3]); +%! assert (conv (y, c), [3, 3, 3]); +%! assert (conv (b, c), 6); + +%!test +%! a = 1:10; +%! b = 1:3; +%! assert (size (conv(a,b)), [1, numel(a)+numel(b)-1]); +%! assert (size (conv(b,a)), [1, numel(a)+numel(b)-1]); + +%!test +%! a = (1:10).'; +%! b = 1:3; +%! assert (size (conv(a,b)), [numel(a)+numel(b)-1, 1]); +%! assert (size (conv(b,a)), [numel(a)+numel(b)-1, 1]); + +%!test +%! a = 1:10; +%! b = (1:3).'; +%! assert (size (conv(a,b)), [1, numel(a)+numel(b)-1]); +%! assert (size (conv(b,a)), [1, numel(a)+numel(b)-1]); + +%!test +%! a = 1:10; +%! b = 1:3; +%! assert (conv (a,b,"full"), conv (a,b)); +%! assert (conv (b,a,"full"), conv (b,a)); + +%!test +%! a = 1:10; +%! b = 1:3; +%! assert (conv (a,b,"same"), [4, 10, 16, 22, 28, 34, 40, 46, 52, 47]); +%! assert (conv (b,a,"same"), [28, 34, 40]); + +%% Test input validation +%!error conv (1) +%!error conv (1,2,3,4) +%!error conv ([1, 2; 3, 4], 3) +%!error conv (3, [1, 2; 3, 4]) +%!error conv (2, 3, "XXXX") + diff --git a/octave_packages/m/polynomial/deconv.m b/octave_packages/m/polynomial/deconv.m new file mode 100644 index 0000000..db1c400 --- /dev/null +++ b/octave_packages/m/polynomial/deconv.m @@ -0,0 +1,110 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} deconv (@var{y}, @var{a}) +## Deconvolve two vectors. +## +## @code{[b, r] = deconv (y, a)} solves for @var{b} and @var{r} such that +## @code{y = conv (a, b) + r}. +## +## If @var{y} and @var{a} are polynomial coefficient vectors, @var{b} will +## contain the coefficients of the polynomial quotient and @var{r} will be +## a remainder polynomial of lowest order. +## @seealso{conv, residue} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function [b, r] = deconv (y, a) + + if (nargin != 2) + print_usage (); + endif + + if (! (isvector (y) && isvector (a))) + error("deconv: both arguments must be vectors"); + endif + + la = length (a); + ly = length (y); + + lb = ly - la + 1; + + ## Ensure A is oriented as Y. + if (diff (size (y)(1:2)) * diff (size (a)(1:2)) < 0) + a = permute (a, [2, 1]); + endif + + if (ly > la) + x = zeros (size (y) - size (a) + 1); + x (1) = 1; + b = filter (y, a, x); + elseif (ly == la) + b = filter (y, a, 1); + else + b = 0; + endif + + lc = la + length (b) - 1; + if (ly == lc) + r = y - conv (a, b); + else + ## Respect the orientation of Y" + if (size (y, 1) <= size (y, 2)) + r = [(zeros (1, lc - ly)), y] - conv (a, b); + else + r = [(zeros (lc - ly, 1)); y] - conv (a, b); + endif + if (ly < la) + ## Trim the remainder is equal to the length of Y. + r = r(end-(length(y)-1):end); + endif + endif + +endfunction + +%!test +%! [b, r] = deconv ([3, 6, 9, 9], [1, 2, 3]); +%! assert(all (all (b == [3, 0])) && all (all (r == [0, 0, 0, 9]))); + +%!test +%! [b, r] = deconv ([3, 6], [1, 2, 3]); +%! assert(b == 0 && all (all (r == [3, 6]))); + +%!test +%! [b, r] = deconv ([3, 6], [1; 2; 3]); +%! assert(b == 0 && all (all (r == [3, 6]))); + +%!test +%! [b,r] = deconv ([3; 6], [1; 2; 3]); +%! assert (b == 0 && all (all (r == [3; 6]))) + +%!test +%! [b, r] = deconv ([3; 6], [1, 2, 3]); +%! assert (b == 0 && all (all (r == [3; 6]))) + +%!test +%! assert (deconv ((1:3)',[1, 1]), [1; 1]) + +%!error [b, r] = deconv ([3, 6], [1, 2; 3, 4]); + +%!error [b, r] = deconv ([3, 6; 1, 2], [1, 2, 3]); + diff --git a/octave_packages/m/polynomial/mkpp.m b/octave_packages/m/polynomial/mkpp.m new file mode 100644 index 0000000..841c01c --- /dev/null +++ b/octave_packages/m/polynomial/mkpp.m @@ -0,0 +1,112 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{pp} =} mkpp (@var{breaks}, @var{coefs}) +## @deftypefnx {Function File} {@var{pp} =} mkpp (@var{breaks}, @var{coefs}, @var{d}) +## +## Construct a piecewise polynomial (pp) structure from sample points +## @var{breaks} and coefficients @var{coefs}. @var{breaks} must be a vector of +## strictly increasing values. The number of intervals is given by +## @code{@var{ni} = length (@var{breaks}) - 1}. +## When @var{m} is the polynomial order @var{coefs} must be of +## size: @var{ni} x @var{m} + 1. +## +## The i-th row of @var{coefs}, +## @code{@var{coefs} (@var{i},:)}, contains the coefficients for the polynomial +## over the @var{i}-th interval, ordered from highest (@var{m}) to +## lowest (@var{0}). +## +## @var{coefs} may also be a multi-dimensional array, specifying a vector-valued +## or array-valued polynomial. In that case the polynomial order is defined +## by the length of the last dimension of @var{coefs}. +## The size of first dimension(s) are given by the scalar or +## vector @var{d}. If @var{d} is not given it is set to @code{1}. +## In any case @var{coefs} is reshaped to a 2-D matrix of +## size @code{[@var{ni}*prod(@var{d} @var{m})] } +## +## @seealso{unmkpp, ppval, spline, pchip, ppder, ppint, ppjumps} +## @end deftypefn + +function pp = mkpp (x, P, d) + + # check number of arguments + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + # check x + if (length (x) < 2) + error ("mkpp: at least one interval is needed"); + endif + + if (!isvector (x)) + error ("mkpp: x must be a vector"); + endif + + len = length (x) - 1; + dP = length (size (P)); + + pp = struct ("form", "pp", + "breaks", x(:).', + "coefs", [], + "pieces", len, + "order", prod (size (P)) / len, + "dim", 1); + + if (nargin == 3) + pp.dim = d; + pp.order /= prod (d); + endif + + dim_vec = [pp.pieces * prod(pp.dim), pp.order]; + pp.coefs = reshape (P, dim_vec); + +endfunction + +%!demo # linear interpolation +%! x=linspace(0,pi,5)'; +%! t=[sin(x),cos(x)]; +%! m=diff(t)./(x(2)-x(1)); +%! b=t(1:4,:); +%! pp = mkpp(x, [m(:),b(:)]); +%! xi=linspace(0,pi,50); +%! plot(x,t,"x",xi,ppval(pp,xi)); +%! legend("control","interp"); + +%!shared b,c,pp +%! b = 1:3; c = 1:24; pp=mkpp(b,c); +%!assert (pp.pieces,2); +%!assert (pp.order,12); +%!assert (pp.dim,1); +%!assert (size(pp.coefs),[2,12]); +%! pp=mkpp(b,c,2); +%!assert (pp.pieces,2); +%!assert (pp.order,6); +%!assert (pp.dim,2); +%!assert (size(pp.coefs),[4,6]); +%! pp=mkpp(b,c,3); +%!assert (pp.pieces,2); +%!assert (pp.order,4); +%!assert (pp.dim,3); +%!assert (size(pp.coefs),[6,4]); +%! pp=mkpp(b,c,[2,3]); +%!assert (pp.pieces,2); +%!assert (pp.order,2); +%!assert (pp.dim,[2,3]); +%!assert (size(pp.coefs),[12,2]); diff --git a/octave_packages/m/polynomial/mpoles.m b/octave_packages/m/polynomial/mpoles.m new file mode 100644 index 0000000..fc6d5a2 --- /dev/null +++ b/octave_packages/m/polynomial/mpoles.m @@ -0,0 +1,122 @@ +## Copyright (C) 2007-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{multp}, @var{idxp}] =} mpoles (@var{p}) +## @deftypefnx {Function File} {[@var{multp}, @var{idxp}] =} mpoles (@var{p}, @var{tol}) +## @deftypefnx {Function File} {[@var{multp}, @var{idxp}] =} mpoles (@var{p}, @var{tol}, @var{reorder}) +## Identify unique poles in @var{p} and their associated multiplicity. The +## output is ordered from largest pole to smallest pole. +## +## If the relative difference of two poles is less than @var{tol} then +## they are considered to be multiples. The default value for @var{tol} +## is 0.001. +## +## If the optional parameter @var{reorder} is zero, poles are not sorted. +## +## The output @var{multp} is a vector specifying the multiplicity of the +## poles. @code{@var{multp}(n)} refers to the multiplicity of the Nth pole +## @code{@var{p}(@var{idxp}(n))}. +## +## For example: +## +## @example +## @group +## p = [2 3 1 1 2]; +## [m, n] = mpoles (p) +## @result{} m = [1; 1; 2; 1; 2] +## @result{} n = [2; 5; 1; 4; 3] +## @result{} p(n) = [3, 2, 2, 1, 1] +## @end group +## @end example +## +## @seealso{residue, poly, roots, conv, deconv} +## @end deftypefn + +## Author: Ben Abbott +## Created: Sept 30, 2007 + +function [multp, indx] = mpoles (p, tol, reorder) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (nargin < 2 || isempty (tol)) + tol = 0.001; + endif + + if (nargin < 3 || isempty (reorder)) + reorder = true; + endif + + Np = numel (p); + + ## Force the poles to be a column vector. + + p = p(:); + + ## Sort the poles according to their magnitidues, largest first. + + if (reorder) + ## Sort with smallest magnitude first. + [p, ordr] = sort (p); + ## Reverse order, largest maginitude first. + n = Np:-1:1; + p = p(n); + ordr = ordr(n); + else + ordr = 1:Np; + endif + + ## Find pole multiplicty by comparing the relative differnce in the + ## poles. + + multp = zeros (Np, 1); + indx = []; + n = find (multp == 0, 1); + while (n) + dp = abs (p-p(n)); + if (p(n) == 0.0) + if (any (abs (p) > 0 & isfinite (p))) + p0 = mean (abs (p(abs (p) > 0 & isfinite (p)))); + else + p0 = 1; + endif + else + p0 = abs (p(n)); + endif + k = find (dp < tol * p0); + ## Poles can only be members of one multiplicity group. + if (numel (indx)) + k = k(! ismember (k, indx)); + endif + m = 1:numel (k); + multp(k) = m; + indx = [indx; k]; + n = find (multp == 0, 1); + endwhile + multp = multp(indx); + indx = ordr(indx); + +endfunction + +%!test +%! [mp, n] = mpoles ([0 0], 0.01); +%! assert (mp, [1; 2]) + diff --git a/octave_packages/m/polynomial/pchip.m b/octave_packages/m/polynomial/pchip.m new file mode 100644 index 0000000..03b4f8f --- /dev/null +++ b/octave_packages/m/polynomial/pchip.m @@ -0,0 +1,172 @@ +## Copyright (C) 2001-2012 Kai Habel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{pp} =} pchip (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{yi} =} pchip (@var{x}, @var{y}, @var{xi}) +## Return the Piecewise Cubic Hermite Interpolating Polynomial (pchip) of +## points @var{x} and @var{y}. +## +## If called with two arguments, return the piecewise polynomial @var{pp} +## that may be used with @code{ppval} to evaluate the polynomial at specific +## points. When called with a third input argument, @code{pchip} evaluates +## the pchip polynomial at the points @var{xi}. The third calling form is +## equivalent to @code{ppval (pchip (@var{x}, @var{y}), @var{xi})}. +## +## The variable @var{x} must be a strictly monotonic vector (either +## increasing or decreasing) of length @var{n}. @var{y} can be either a +## vector or array. If @var{y} is a vector then it must be the same length +## @var{n} as @var{x}. If @var{y} is an array then the size of @var{y} must +## have the form +## @tex +## $$[s_1, s_2, \cdots, s_k, n]$$ +## @end tex +## @ifnottex +## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n}]} +## @end ifnottex +## The array is reshaped internally to a matrix where the leading +## dimension is given by +## @tex +## $$s_1 s_2 \cdots s_k$$ +## @end tex +## @ifnottex +## @code{@var{s1} * @var{s2} * @dots{} * @var{sk}} +## @end ifnottex +## and each row of this matrix is then treated separately. Note that this +## is exactly opposite to @code{interp1} but is done for @sc{matlab} +## compatibility. +## +## @seealso{spline, ppval, mkpp, unmkpp} +## @end deftypefn + +## Author: Kai Habel +## Date: 9. mar 2001 +## +## S_k = a_k + b_k*x + c_k*x^2 + d_k*x^3; (spline polynom) +## +## 4 conditions: +## S_k(x_k) = y_k; +## S_k(x_k+1) = y_k+1; +## S_k'(x_k) = y_k'; +## S_k'(x_k+1) = y_k+1'; + +function ret = pchip (x, y, xi) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + ## make row vector + x = x(:).'; + n = length (x); + + ## Check the size and shape of y + if (isvector (y)) + y = y(:).'; ##row vector + szy = size (y); + if !(size_equal (x, y)) + error ("pchip: length of X and Y must match") + endif + else + szy = size (y); + if (n != szy(end)) + error ("pchip: length of X and last dimension of Y must match") + endif + y = reshape (y, [prod(szy(1:end-1)), szy(end)]); + endif + + h = diff (x); + if (all (h < 0)) + x = fliplr (x); + h = diff (x); + y = fliplr (y); + elseif (any (h <= 0)) + error("pchip: X must be strictly monotonic"); + endif + + f1 = y(:, 1:n-1); + + ## Compute derivatives. + d = __pchip_deriv__ (x, y, 2); + d1 = d(:, 1:n-1); + d2 = d(:, 2:n); + + ## This is taken from SLATEC. + h = diag (h); + + delta = diff (y, 1, 2) / h; + del1 = (d1 - delta) / h; + del2 = (d2 - delta) / h; + c3 = del1 + del2; + c2 = -c3 - del1; + c3 = c3 / h; + coeffs = cat (3, c3, c2, d1, f1); + + ret = mkpp (x, coeffs, szy(1:end-1)); + + if (nargin == 3) + ret = ppval (ret, xi); + endif + +endfunction + +%!demo +%! x = 0:8; +%! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0]; +%! xi = 0:0.01:8; +%! yspline = spline(x,y,xi); +%! ypchip = pchip(x,y,xi); +%! title("pchip and spline fit to discontinuous function"); +%! plot(xi,yspline,xi,ypchip,"-",x,y,"+"); +%! legend ("spline","pchip","data"); +%! %------------------------------------------------------------------- +%! % confirm that pchip agreed better to discontinuous data than spline + +%!shared x,y,y2,pp,yi1,yi2,yi3 +%! x = 0:8; +%! y = [1, 1, 1, 1, 0.5, 0, 0, 0, 0]; +%!assert (pchip(x,y,x), y); +%!assert (pchip(x,y,x'), y'); +%!assert (pchip(x',y',x'), y'); +%!assert (pchip(x',y',x), y); +%!assert (isempty(pchip(x',y',[]))); +%!assert (isempty(pchip(x,y,[]))); +%!assert (pchip(x,[y;y],x), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x,[y;y],x'), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x',[y;y],x), [pchip(x,y,x);pchip(x,y,x)]) +%!assert (pchip(x',[y;y],x'), [pchip(x,y,x);pchip(x,y,x)]) +%!test +%! x=(0:8)*pi/4;y=[sin(x);cos(x)]; +%! y2(:,:,1)=y;y2(:,:,2)=y+1;y2(:,:,3)=y-1; +%! pp=pchip(x,shiftdim(y2,2)); +%! yi1=ppval(pp,(1:4)*pi/4); +%! yi2=ppval(pp,repmat((1:4)*pi/4,[5,1])); +%! yi3=ppval(pp,[pi/2,pi]); +%!assert(size(pp.coefs),[48,4]); +%!assert(pp.pieces,8); +%!assert(pp.order,4); +%!assert(pp.dim,[3,2]); +%!assert(ppval(pp,pi),[0,-1;1,0;-1,-2],1e-14); +%!assert(yi3(:,:,2),ppval(pp,pi),1e-14); +%!assert(yi3(:,:,1),[1,0;2,1;0,-1],1e-14); +%!assert(squeeze(yi1(1,2,:)),[1/sqrt(2); 0; -1/sqrt(2);-1],1e-14); +%!assert(size(yi2),[3,2,5,4]); +%!assert(squeeze(yi2(1,2,3,:)),[1/sqrt(2); 0; -1/sqrt(2);-1],1e-14); + +%!error (pchip (1,2)); +%!error (pchip (1,2,3)); diff --git a/octave_packages/m/polynomial/poly.m b/octave_packages/m/polynomial/poly.m new file mode 100644 index 0000000..c32e6c7 --- /dev/null +++ b/octave_packages/m/polynomial/poly.m @@ -0,0 +1,91 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} poly (@var{A}) +## @deftypefnx {Function File} {} poly (@var{x}) +## If @var{A} is a square @math{N}-by-@math{N} matrix, @code{poly (@var{A})} +## is the row vector of the coefficients of @code{det (z * eye (N) - A)}, +## the characteristic polynomial of @var{A}. For example, +## the following code finds the eigenvalues of @var{A} which are the roots of +## @code{poly (@var{A})}. +## +## @example +## @group +## roots (poly (eye (3))) +## @result{} 1.00001 + 0.00001i +## 1.00001 - 0.00001i +## 0.99999 + 0.00000i +## @end group +## @end example +## +## In fact, all three eigenvalues are exactly 1 which emphasizes that for +## numerical performance the @code{eig} function should be used to compute +## eigenvalues. +## +## If @var{x} is a vector, @code{poly (@var{x})} is a vector of the +## coefficients of the polynomial whose roots are the elements of @var{x}. +## That is, if @var{c} is a polynomial, then the elements of @code{@var{d} = +## roots (poly (@var{c}))} are contained in @var{c}. The vectors @var{c} and +## @var{d} are not identical, however, due to sorting and numerical errors. +## @seealso{roots, eig} +## @end deftypefn + +## Author: KH +## Created: 24 December 1993 +## Adapted-By: jwe + +function y = poly (x) + + if (nargin != 1) + print_usage (); + endif + + m = min (size (x)); + n = max (size (x)); + if (m == 0) + y = 1; + return; + elseif (m == 1) + v = x; + elseif (m == n) + v = eig (x); + else + print_usage (); + endif + + y = zeros (1, n+1); + y(1) = 1; + for j = 1:n; + y(2:(j+1)) = y(2:(j+1)) - v(j) .* y(1:j); + endfor + + if (all (all (imag (x) == 0))) + y = real (y); + endif + +endfunction + +%!assert(all (all (poly ([1, 2, 3]) == [1, -6, 11, -6]))); + +%!assert(all (all (abs (poly ([1, 2; 3, 4]) - [1, -5, -2]) < sqrt (eps)))); + +%!error poly ([1, 2, 3; 4, 5, 6]); + +%!assert(poly ([]),1); + diff --git a/octave_packages/m/polynomial/polyaffine.m b/octave_packages/m/polynomial/polyaffine.m new file mode 100644 index 0000000..973268e --- /dev/null +++ b/octave_packages/m/polynomial/polyaffine.m @@ -0,0 +1,88 @@ +## Copyright (C) 2009-2012 Tony Richardson, Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polyaffine (@var{f}, @var{mu}) +## Return the coefficients of the polynomial vector @var{f} after an affine +## transformation. If @var{f} is the vector representing the polynomial f(x), +## then @code{@var{g} = polyaffine (@var{f}, @var{mu})} is the vector +## representing: +## +## @example +## g(x) = f( (x - @var{mu}(1)) / @var{mu}(2) ) +## @end example +## +## @seealso{polyval, polyfit} +## @end deftypefn + + +function g = polyaffine (f, mu) + + if (nargin != 2) + print_usage (); + endif + + if (! isvector (f)) + error ("polyaffine: F must be a vector"); + endif + + if (! isvector (mu) || length (mu) != 2) + error ("polyaffine: MU must be a two-element vector"); + endif + + lf = length (f); + + ## Ensure that f is a row vector + if (rows (f) > 1) + f = f.'; + endif + + g = f; + + ## Scale. + if (mu(2) != 1) + g = g ./ (mu(2) .^ (lf-1:-1:0)); + endif + + ## Translate. + if (mu(1) != 0) + w = (-mu(1)) .^ (0:lf-1); + ii = lf:-1:1; + g = g(ii) * (toeplitz (w) .* pascal (lf, -1)); + g = g(ii); + endif + +endfunction + + +%!demo +%! f = [1/5 4/5 -7/5 -2]; +%! g = polyaffine (f, [1, 1.2]); +%! x = linspace (-4, 4, 100); +%! plot(x, polyval (f, x), x, polyval (g, x)); +%! legend ("original", "affine"); +%! axis ([-4 4 -3 5]); +%! grid ("on"); + +%!test +%! f = [1/5 4/5 -7/5 -2]; +%! mu = [1, 1.2]; +%! g = polyaffine (f, mu); +%! x = linspace (-4, 4, 100); +%! assert (polyval (f, x, [], mu), polyval (g, x), 1e-10); + diff --git a/octave_packages/m/polynomial/polyder.m b/octave_packages/m/polynomial/polyder.m new file mode 100644 index 0000000..0e80e3d --- /dev/null +++ b/octave_packages/m/polynomial/polyder.m @@ -0,0 +1,99 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polyder (@var{p}) +## @deftypefnx {Function File} {[@var{k}] =} polyder (@var{a}, @var{b}) +## @deftypefnx {Function File} {[@var{q}, @var{d}] =} polyder (@var{b}, @var{a}) +## Return the coefficients of the derivative of the polynomial whose +## coefficients are given by the vector @var{p}. If a pair of polynomials +## is given, return the derivative of the product @math{@var{a}*@var{b}}. +## If two inputs and two outputs are given, return the derivative of the +## polynomial quotient @math{@var{b}/@var{a}}. The quotient numerator is +## in @var{q} and the denominator in @var{d}. +## @seealso{polyint, polyval, polyreduce} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function [q, d] = polyder (p, a) + + if (nargin == 1 || nargin == 2) + if (! isvector (p)) + error ("polyder: argument must be a vector"); + endif + if (nargin == 2) + if (! isvector (a)) + error ("polyder: argument must be a vector"); + endif + if (nargout == 1) + ## derivative of p*a returns a single polynomial + q = polyder (conv (p, a)); + else + ## derivative of p/a returns numerator and denominator + d = conv (a, a); + if (numel (p) == 1) + q = -p * polyder (a); + elseif (numel (a) == 1) + q = a * polyder (p); + else + q = conv (polyder (p), a) - conv (p, polyder (a)); + q = polyreduce (q); + endif + + ## remove common factors from numerator and denominator + x = polygcd (q, d); + if (length(x) != 1) + q = deconv (q, x); + d = deconv (d, x); + endif + + ## move all the gain into the numerator + q = q/d(1); + d = d/d(1); + endif + else + lp = numel (p); + if (lp == 1) + q = 0; + return; + elseif (lp == 0) + q = []; + return; + endif + + ## Force P to be a row vector. + p = p(:).'; + + q = p(1:(lp-1)) .* [(lp-1):-1:1]; + endif + else + print_usage (); + endif + +endfunction + + +%!assert(all (all (polyder ([1, 2, 3]) == [2, 2]))); +%!assert(polyder (13) == 0); + +%!error polyder ([]); +%!error polyder ([1, 2; 3, 4]); + diff --git a/octave_packages/m/polynomial/polyfit.m b/octave_packages/m/polynomial/polyfit.m new file mode 100644 index 0000000..57000fc --- /dev/null +++ b/octave_packages/m/polynomial/polyfit.m @@ -0,0 +1,177 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} polyfit (@var{x}, @var{y}, @var{n}) +## @deftypefnx {Function File} {[@var{p}, @var{s}] =} polyfit (@var{x}, @var{y}, @var{n}) +## @deftypefnx {Function File} {[@var{p}, @var{s}, @var{mu}] =} polyfit (@var{x}, @var{y}, @var{n}) +## Return the coefficients of a polynomial @var{p}(@var{x}) of degree +## @var{n} that minimizes the least-squares-error of the fit to the points +## @code{[@var{x}, @var{y}]}. +## +## The polynomial coefficients are returned in a row vector. +## +## The optional output @var{s} is a structure containing the following fields: +## +## @table @samp +## @item R +## Triangular factor R from the QR@tie{}decomposition. +## +## @item X +## The Vandermonde matrix used to compute the polynomial coefficients. +## +## @item df +## The degrees of freedom. +## +## @item normr +## The norm of the residuals. +## +## @item yf +## The values of the polynomial for each value of @var{x}. +## @end table +## +## The second output may be used by @code{polyval} to calculate the +## statistical error limits of the predicted values. +## +## When the third output, @var{mu}, is present the +## coefficients, @var{p}, are associated with a polynomial in +## @var{xhat} = (@var{x}-@var{mu}(1))/@var{mu}(2). +## Where @var{mu}(1) = mean (@var{x}), and @var{mu}(2) = std (@var{x}). +## This linear transformation of @var{x} improves the numerical +## stability of the fit. +## @seealso{polyval, polyaffine, roots, vander, zscore} +## @end deftypefn + +## Author: KH +## Created: 13 December 1994 +## Adapted-By: jwe + +function [p, s, mu] = polyfit (x, y, n) + + if (nargin < 3 || nargin > 4) + print_usage (); + endif + + if (nargout > 2) + ## Normalized the x values. + mu = [mean(x), std(x)]; + x = (x - mu(1)) / mu(2); + endif + + if (! size_equal (x, y)) + error ("polyfit: X and Y must be vectors of the same size"); + endif + + if (! (isscalar (n) && n >= 0 && ! isinf (n) && n == fix (n))) + error ("polyfit: N must be a non-negative integer"); + endif + + y_is_row_vector = (rows (y) == 1); + + ## Reshape x & y into column vectors. + l = numel (x); + x = x(:); + y = y(:); + + ## Construct the Vandermonde matrix. + v = vander (x, n+1); + + ## Solve by QR decomposition. + [q, r, k] = qr (v, 0); + p = r \ (q' * y); + p(k) = p; + + if (nargout > 1) + yf = v*p; + + if (y_is_row_vector) + s.yf = yf.'; + else + s.yf = yf; + endif + + s.R = r; + s.X = v; + s.df = l - n - 1; + s.normr = norm (yf - y); + endif + + ## Return a row vector. + p = p.'; + +endfunction + +%!test +%! x = [-2, -1, 0, 1, 2]; +%! assert(all (all (abs (polyfit (x, x.^2+x+1, 2) - [1, 1, 1]) < sqrt (eps)))); + +%!error(polyfit ([1, 2; 3, 4], [1, 2, 3, 4], 2)) + +%!test +%! x = [-2, -1, 0, 1, 2]; +%! assert(all (all (abs (polyfit (x, x.^2+x+1, 3) - [0, 1, 1, 1]) < sqrt (eps)))); + +%!test +%! x = [-2, -1, 0, 1, 2]; +%! fail("polyfit (x, x.^2+x+1)"); + +%!test +%! x = [-2, -1, 0, 1, 2]; +%! fail("polyfit (x, x.^2+x+1, [])"); + +## Test difficult case where scaling is really needed. This example +## demonstrates the rather poor result which occurs when the dependent +## variable is not normalized properly. +## Also check the usage of 2nd & 3rd output arguments. +%!test +%! x = [ -1196.4, -1195.2, -1194, -1192.8, -1191.6, -1190.4, -1189.2, -1188, \ +%! -1186.8, -1185.6, -1184.4, -1183.2, -1182]; +%! y = [ 315571.7086, 315575.9618, 315579.4195, 315582.6206, 315585.4966, \ +%! 315588.3172, 315590.9326, 315593.5934, 315596.0455, 315598.4201, \ +%! 315600.7143, 315602.9508, 315605.1765 ]; +%! [p1, s1] = polyfit (x, y, 10); +%! [p2, s2, mu] = polyfit (x, y, 10); +%! assert (s2.normr < s1.normr) + +%!test +%! x = 1:4; +%! p0 = [1i, 0, 2i, 4]; +%! y0 = polyval (p0, x); +%! p = polyfit (x, y0, numel(p0)-1); +%! assert (p, p0, 1000*eps) + +%!test +%! x = 1000 + (-5:5); +%! xn = (x - mean (x)) / std (x); +%! pn = ones (1,5); +%! y = polyval (pn, xn); +%! [p, s, mu] = polyfit (x, y, numel(pn)-1); +%! [p2, s2] = polyfit (x, y, numel(pn)-1); +%! assert (p, pn, s.normr) +%! assert (s.yf, y, s.normr) +%! assert (mu, [mean(x), std(x)]) +%! assert (s.normr/s2.normr < sqrt(eps)) + +%!test +%! x = [1, 2, 3; 4, 5, 6]; +%! y = [0, 0, 1; 1, 0, 0]; +%! p = polyfit (x, y, 5); +%! expected = [0, 1, -14, 65, -112, 60]/12; +%! assert (p, expected, sqrt(eps)) + + diff --git a/octave_packages/m/polynomial/polygcd.m b/octave_packages/m/polynomial/polygcd.m new file mode 100644 index 0000000..5b763e1 --- /dev/null +++ b/octave_packages/m/polynomial/polygcd.m @@ -0,0 +1,102 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} polygcd (@var{b}, @var{a}) +## @deftypefnx {Function File} {@var{q} =} polygcd (@var{b}, @var{a}, @var{tol}) +## +## Find the greatest common divisor of two polynomials. This is equivalent +## to the polynomial found by multiplying together all the common roots. +## Together with deconv, you can reduce a ratio of two polynomials. +## The tolerance @var{tol} defaults to @code{sqrt(eps)}. +## +## @strong{Caution:} This is a numerically unstable algorithm and should not +## be used on large polynomials. +## +## Example code: +## +## @example +## @group +## polygcd (poly (1:8), poly (3:12)) - poly (3:8) +## @result{} [ 0, 0, 0, 0, 0, 0, 0 ] +## deconv (poly (1:8), polygcd (poly (1:8), poly (3:12))) - poly(1:2) +## @result{} [ 0, 0, 0 ] +## @end group +## @end example +## @seealso{poly, roots, conv, deconv, residue} +## @end deftypefn + +function x = polygcd (b, a, tol) + + if (nargin == 2 || nargin == 3) + if (nargin == 2) + if (isa (a, "single") || isa (b, "single")) + tol = sqrt (eps ("single")); + else + tol = sqrt (eps); + endif + endif + if (length (a) == 1 || length (b) == 1) + if (a == 0) + x = b; + elseif (b == 0) + x = a; + else + x = 1; + endif + else + a /= a(1); + while (1) + [d, r] = deconv (b, a); + nz = find (abs (r) > tol); + if (isempty (nz)) + x = a; + break; + else + r = r(nz(1):length(r)); + endif + b = a; + a = r / r(1); + endwhile + endif + else + print_usage (); + endif + +endfunction + + +%!test +%! poly1 = [1 6 11 6]; % (x+1)(x+2)(x+3) +%! poly2 = [1 3 2]; % (x+1)(x+2) +%! poly3 = polygcd (poly1, poly2); +%! assert (poly3, poly2, sqrt (eps)) + +%!test +%! assert (polygcd (poly(1:8), poly(3:12)), poly(3:8), sqrt (eps)) + +%!test +%! assert (deconv (poly(1:8), polygcd (poly(1:8), poly(3:12))), poly(1:2), sqrt (eps)) + +%!test +%! for ii=1:10 +%! p = (unique (randn (10, 1)) * 10).'; +%! p1 = p(3:end); +%! p2 = p(1:end-2); +%! assert (polygcd (poly (-p1), poly (-p2)), poly (- intersect (p1, p2)), sqrt (eps)) +%! endfor diff --git a/octave_packages/m/polynomial/polyint.m b/octave_packages/m/polynomial/polyint.m new file mode 100644 index 0000000..2b6eb8e --- /dev/null +++ b/octave_packages/m/polynomial/polyint.m @@ -0,0 +1,77 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polyint (@var{p}) +## @deftypefnx {Function File} {} polyint (@var{p}, @var{k}) +## Return the coefficients of the integral of the polynomial whose +## coefficients are represented by the vector @var{p}. The variable +## @var{k} is the constant of integration, which by default is set to zero. +## @seealso{polyder, polyval} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function retval = polyint (p, k) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1) + k = 0; + elseif (! isscalar (k)) + error ("polyint: the constant of integration must be a scalar"); + endif + + if (! (isvector (p) || isempty (p))) + error ("polyint: argument must be a vector"); + endif + + lp = length (p); + + if (lp == 0) + retval = []; + return; + endif + + if (rows (p) > 1) + ## Convert to column vector + p = p.'; + endif + + retval = [(p ./ [lp:-1:1]), k]; + +endfunction + +%!test +%! A = [3, 2, 1]; +%! assert (polyint(A),polyint(A,0)); +%! assert (polyint(A),polyint(A')); +%! assert (polyint(A),[1, 1, 1, 0]); +%! assert (polyint(A,1),ones(1,4)); + +%!test +%! A = ones(1,8); +%! B = [length(A):-1:1]; +%! assert (polyint(A),[1./B, 0]); + +%!error polyint() +%!error polyint(ones(2,2)) diff --git a/octave_packages/m/polynomial/polyout.m b/octave_packages/m/polynomial/polyout.m new file mode 100644 index 0000000..78d327b --- /dev/null +++ b/octave_packages/m/polynomial/polyout.m @@ -0,0 +1,103 @@ +## Copyright (C) 1995-2012 Auburn University. All rights reserved. +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polyout (@var{c}) +## @deftypefnx {Function File} {} polyout (@var{c}, @var{x}) +## @deftypefnx {Function File} {@var{str} =} polyout (@dots{}) +## Write formatted polynomial +## @tex +## $$ c(x) = c_1 x^n + \ldots + c_n x + c_{n+1} $$ +## @end tex +## @ifnottex +## +## @example +## c(x) = c(1) * x^n + @dots{} + c(n) x + c(n+1) +## @end example +## +## @end ifnottex +## and return it as a string or write it to the screen (if @var{nargout} is +## zero). @var{x} defaults to the string @code{"s"}. +## @seealso{polyreduce} +## @end deftypefn + +## Author: A. S. Hodel +## Created: May 1995 +## Nov 1998: Correctly handles complex coefficients + +function y = polyout (c, x) + + if (nargin < 1) || (nargin > 2) || (nargout < 0) || (nargout > 1) + print_usage (); + endif + + if (! isvector (c)) + error ("polyout: first argument must be a vector"); + endif + + if (nargin == 1) + x = "s"; + elseif (! ischar (x)) + error ("polyout: second argument must be a string"); + endif + + n = length (c); + if(n > 0) + n1 = n+1; + + tmp = coeff (c(1)); + for ii = 2:n + if (real (c(ii)) < 0) + ns = " - "; + c(ii) = -c(ii); + else + ns = " + "; + endif + + tmp = sprintf ("%s*%s^%d%s%s", tmp, x, n1-ii, ns, coeff (c(ii))); + + endfor + else + tmp = " "; + endif + + if(nargout == 0) + disp (tmp); + else + y = tmp; + endif + +endfunction + +function str = coeff (c) + if (imag (c)) + if (real (c)) + str = sprintf ("(%s)", num2str (c, 5)); + else + str = num2str (c, 5); + endif + else + str = num2str (c, 5); + endif +endfunction + +%!assert (polyout ([3 2 1]), '3*s^2 + 2*s^1 + 1') +%!assert (polyout ([3 2 1], 'x'), '3*x^2 + 2*x^1 + 1') +%!assert (polyout ([3 2 1], 'wxyz'), '3*wxyz^2 + 2*wxyz^1 + 1') +%!assert (polyout ([5 4 3 2 1], '1'),'5*1^4 + 4*1^3 + 3*1^2 + 2*1^1 + 1') +%!error polyout ([]) diff --git a/octave_packages/m/polynomial/polyreduce.m b/octave_packages/m/polynomial/polyreduce.m new file mode 100644 index 0000000..578265d --- /dev/null +++ b/octave_packages/m/polynomial/polyreduce.m @@ -0,0 +1,65 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polyreduce (@var{c}) +## Reduce a polynomial coefficient vector to a minimum number of terms by +## stripping off any leading zeros. +## @seealso{polyout} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function p = polyreduce (c) + + if (nargin != 1) + print_usage (); + endif + + if (!isvector (c) || isempty (c)) + error ("polyreduce: C must be a non-empty vector"); + endif + + if (! isempty (c)) + + index = find (c != 0); + + if (isempty (index)) + + p = 0; + + else + + p = c(index (1):length (c)); + + endif + + endif + +endfunction + +%!assert(all (all (polyreduce ([0, 0, 1, 2, 3]) == [1, 2, 3]))); + +%!assert(all (all (polyreduce ([1, 2, 3, 0, 0]) == [1, 2, 3, 0, 0]))); + +%!assert(all (all (polyreduce ([1, 0, 3]) == [1, 0, 3]))); + +%!error polyreduce ([1, 2; 3, 4]); + diff --git a/octave_packages/m/polynomial/polyval.m b/octave_packages/m/polynomial/polyval.m new file mode 100644 index 0000000..cb4895c --- /dev/null +++ b/octave_packages/m/polynomial/polyval.m @@ -0,0 +1,152 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} polyval (@var{p}, @var{x}) +## @deftypefnx {Function File} {@var{y} =} polyval (@var{p}, @var{x}, [], @var{mu}) +## Evaluate the polynomial @var{p} at the specified values of @var{x}. When +## @var{mu} is present, evaluate the polynomial for +## (@var{x}-@var{mu}(1))/@var{mu}(2). +## If @var{x} is a vector or matrix, the polynomial is evaluated for each of +## the elements of @var{x}. +## +## @deftypefnx {Function File} {[@var{y}, @var{dy}] =} polyval (@var{p}, @var{x}, @var{s}) +## @deftypefnx {Function File} {[@var{y}, @var{dy}] =} polyval (@var{p}, @var{x}, @var{s}, @var{mu}) +## In addition to evaluating the polynomial, the second output +## represents the prediction interval, @var{y} +/- @var{dy}, which +## contains at least 50% of the future predictions. To calculate the +## prediction interval, the structured variable @var{s}, originating +## from @code{polyfit}, must be supplied. +## @seealso{polyvalm, polyaffine, polyfit, roots, poly} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function [y, dy] = polyval (p, x, s = [], mu) + + if (nargin < 2 || nargin > 4 || (nargout == 2 && nargin < 3)) + print_usage (); + endif + + if (isempty (x)) + y = []; + return; + elseif (isempty (p)) + y = zeros (size (x)); + return; + elseif (! isvector (p)) + error ("polyval: first argument must be a vector"); + endif + + if (nargin > 3) + x = (x - mu(1)) / mu(2); + endif + + n = length (p) - 1; + y = p(1) * ones (size (x)); + for i = 2:n+1 + y = y .* x + p(i); + endfor + + if (nargout == 2) + ## Note: the F-Distribution is generally considered to be single-sided. + ## http://www.itl.nist.gov/div898/handbook/eda/section3/eda3673.htm + ## t = finv (1-alpha, s.df, s.df); + ## dy = t * sqrt (1 + sumsq (A/s.R, 2)) * s.normr / sqrt (s.df) + ## If my inference is correct, then t must equal 1 for polyval. + ## This is because finv (0.5, n, n) = 1.0 for any n. + try + k = numel (x); + A = (x(:) * ones (1, n+1)) .^ (ones (k, 1) * (n:-1:0)); + dy = sqrt (1 + sumsq (A/s.R, 2)) * s.normr / sqrt (s.df); + dy = reshape (dy, size (x)); + catch + if (isempty (s)) + error ("polyval: third input is required.") + elseif (isstruct (s) + && all (ismember ({"R", "normr", "df"}, fieldnames (s)))) + error (lasterr ()) + elseif (isstruct (s)) + error ("polyval: third input is missing the required fields."); + else + error ("polyval: third input is not a structure."); + endif + end_try_catch + endif + +endfunction + +%!test +%! fail("polyval([1,0;0,1],0:10)"); + +%!test +%! r = 0:10:50; +%! p = poly (r); +%! p = p / max(abs(p)); +%! x = linspace(0,50,11); +%! y = polyval(p,x) + 0.25*sin(100*x); +%! [pf, s] = polyfit (x, y, numel(r)); +%! [y1, delta] = polyval (pf, x, s); +%! expected = [0.37235, 0.35854, 0.32231, 0.32448, 0.31328, ... +%! 0.32036, 0.31328, 0.32448, 0.32231, 0.35854, 0.37235]; +%! assert (delta, expected, 0.00001) + +%!test +%! x = 10 + (-2:2); +%! y = [0, 0, 1, 0, 2]; +%! p = polyfit (x, y, numel (x) - 1); +%! [pn, s, mu] = polyfit (x, y, numel (x) - 1); +%! y1 = polyval (p, x); +%! yn = polyval (pn, x, [], mu); +%! assert (y1, y, sqrt(eps)) +%! assert (yn, y, sqrt(eps)) + +%!test +%! p = [0, 1, 0]; +%! x = 1:10; +%! assert (x, polyval(p,x), eps) +%! x = x(:); +%! assert (x, polyval(p,x), eps) +%! x = reshape(x, [2, 5]); +%! assert (x, polyval(p,x), eps) +%! x = reshape(x, [5, 2]); +%! assert (x, polyval(p,x), eps) +%! x = reshape(x, [1, 1, 5, 2]); +%! assert (x, polyval(p,x), eps) + +%!test +%! p = [1]; +%! x = 1:10; +%! y = ones(size(x)); +%! assert (y, polyval(p,x), eps) +%! x = x(:); +%! y = ones(size(x)); +%! assert (y, polyval(p,x), eps) +%! x = reshape(x, [2, 5]); +%! y = ones(size(x)); +%! assert (y, polyval(p,x), eps) +%! x = reshape(x, [5, 2]); +%! y = ones(size(x)); +%! assert (y, polyval(p,x), eps) +%! x = reshape(x, [1, 1, 5, 2]); + +%!assert (zeros (1, 10), polyval ([], 1:10)) +%!assert ([], polyval (1, [])) +%!assert ([], polyval ([], [])) diff --git a/octave_packages/m/polynomial/polyvalm.m b/octave_packages/m/polynomial/polyvalm.m new file mode 100644 index 0000000..c990db4 --- /dev/null +++ b/octave_packages/m/polynomial/polyvalm.m @@ -0,0 +1,68 @@ +## Copyright (C) 1994-2012 John W. Eaton +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} polyvalm (@var{c}, @var{x}) +## Evaluate a polynomial in the matrix sense. +## +## @code{polyvalm (@var{c}, @var{x})} will evaluate the polynomial in the +## matrix sense, i.e., matrix multiplication is used instead of element by +## element multiplication as used in @code{polyval}. +## +## The argument @var{x} must be a square matrix. +## @seealso{polyval, roots, poly} +## @end deftypefn + +## Author: Tony Richardson +## Created: June 1994 +## Adapted-By: jwe + +function y = polyvalm (c, x) + + if (nargin != 2) + print_usage (); + endif + + if (! (isvector (c) || isempty (c))) + error ("polyvalm: first argument must be a vector"); + endif + + if (! issquare (x)) + error ("polyvalm: second argument must be a square matrix"); + endif + + n = length (c); + if (n == 0) + y = zeros (rows (x), class (x)); + else + id = eye (rows (x), class (x)); + y = c(1) * id; + for i = 2:n + y = y * x + c(i) * id; + endfor + endif + +endfunction + + +%!assert(! any (polyvalm ([], [1, 2; 3, 4]))(:)); +%!assert(polyvalm ([1, 2, 3, 4], [3, -4, 1; -2, 0, 2; -1, 4, -3]), [117, -124, 11; -70, 36, 38; -43, 92, -45]) + +%!error polyvalm ([1, 1, 1], [1, 2; 3, 4; 5, 6]); + diff --git a/octave_packages/m/polynomial/ppder.m b/octave_packages/m/polynomial/ppder.m new file mode 100644 index 0000000..1e7a6b0 --- /dev/null +++ b/octave_packages/m/polynomial/ppder.m @@ -0,0 +1,70 @@ +## Copyright (C) 2008-2012 VZLU Prague, a.s., Czech Republic +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## 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 +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {ppd =} ppder (pp) +## @deftypefnx {Function File} {ppd =} ppder (pp, m) +## Compute the piecewise @var{m}-th derivative of a piecewise polynomial +## struct @var{pp}. If @var{m} is omitted the first derivative is calculated. +## @seealso{mkpp, ppval, ppint} +## @end deftypefn + +function ppd = ppder (pp, m) + + if ((nargin < 1) || (nargin > 2)) + print_usage (); + elseif (nargin == 1) + m = 1; + endif + + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) + error ("ppder: PP must be a structure"); + endif + + [x, p, n, k, d] = unmkpp (pp); + + if (k - m <= 0) + x = [x(1) x(end)]; + pd = zeros (prod (d), 1); + else + f = k : -1 : 1; + ff = bincoeff (f, m + 1) .* factorial (m + 1) ./ f; + k -= m; + pd = p(:,1:k) * diag (ff(1:k)); + endif + + ppd = mkpp (x, pd, d); +endfunction + +%!shared x,y,pp,ppd +%! x=0:8;y=[x.^2;x.^3+1];pp=spline(x,y); +%! ppd=ppder(pp); +%!assert(ppval(ppd,x),[2*x;3*x.^2],1e-14) +%!assert(ppd.order,3) +%! ppd=ppder(pp,2); +%!assert(ppval(ppd,x),[2*ones(size(x));6*x],1e-14) +%!assert(ppd.order,2) +%! ppd=ppder(pp,3); +%!assert(ppd.order,1) +%!assert(ppd.pieces,8) +%!assert(size(ppd.coefs),[16,1]) +%! ppd=ppder(pp,4); +%!assert(ppd.order,1) +%!assert(ppd.pieces,1) +%!assert(size(ppd.coefs),[2,1]) +%!assert(ppval(ppd,x),zeros(size(y)),1e-14) diff --git a/octave_packages/m/polynomial/ppint.m b/octave_packages/m/polynomial/ppint.m new file mode 100644 index 0000000..d178ad2 --- /dev/null +++ b/octave_packages/m/polynomial/ppint.m @@ -0,0 +1,58 @@ +## Copyright (C) 2008-2012 VZLU Prague, a.s., Czech Republic +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## 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 +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{ppi} =} ppint (@var{pp}) +## @deftypefnx {Function File} {@var{ppi} =} ppint (@var{pp}, @var{c}) +## Compute the integral of the piecewise polynomial struct @var{pp}. +## @var{c}, if given, is the constant of integration. +## @seealso{mkpp, ppval, ppder} +## @end deftypefn + +function ppi = ppint (pp, c) + if (nargin < 1 || nargin > 2) + print_usage (); + endif + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) + error ("ppint: PP must be a structure"); + endif + + [x, p, n, k, d] = unmkpp (pp); + p = reshape (p, [], k); + + ## Get piecewise antiderivatives + pi = p / diag (k:-1:1); + k += 1; + if (nargin == 1) + pi(:, k) = 0; + else + pi(:, k) = repmat (c(:), n, 1); + endif + + ppi = mkpp (x, pi, d); + + tmp = -cumsum (ppjumps (ppi), length (d) + 1); + ppi.coefs(prod(d)+1:end, k) = tmp(:); + +endfunction + +%!shared x,y,pp,ppi +%! x=0:8;y=[ones(size(x));x+1];pp=spline(x,y); +%! ppi=ppint(pp); +%!assert(ppval(ppi,x),[x;0.5*x.^2+x],1e-14) +%!assert(ppi.order,5) diff --git a/octave_packages/m/polynomial/ppjumps.m b/octave_packages/m/polynomial/ppjumps.m new file mode 100644 index 0000000..aa3f2bb --- /dev/null +++ b/octave_packages/m/polynomial/ppjumps.m @@ -0,0 +1,84 @@ +## Copyright (C) 2008-2012 VZLU Prague, a.s., Czech Republic +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or +## (at your option) any later version. +## +## 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 +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{jumps} =} ppjumps (@var{pp}) +## Evaluate the boundary jumps of a piecewise polynomial. +## If there are @math{n} intervals, and the dimensionality of @var{pp} is +## @math{d}, the resulting array has dimensions @code{[d, n-1]}. +## @seealso{mkpp} +## @end deftypefn + +function jumps = ppjumps (pp) + if (nargin != 1) + print_usage (); + endif + + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) + error ("ppjumps: PP must be a structure"); + endif + + ## Extract info. + [x, P, n, k, d] = unmkpp(pp); + nd = length (d) + 1; + + ## Offsets. + dx = diff(x(1:n)); + dx = repmat (dx, [prod(d), 1]); + dx = reshape (dx, [d, n-1]); + dx = shiftdim (dx, nd - 1); + + ## Use Horner scheme. + if (k>1) + llim = shiftdim (reshape (P(1:(n-1) * prod(d), 1), [d, n-1]), nd - 1); + endif + + for i = 2 : k; + llim .*= dx; + llim += shiftdim (reshape (P(1:(n-1) * prod (d), i), [d, n-1]), nd - 1); + endfor + + rlim = shiftdim (ppval (pp, x(2:end-1)), nd - 1); + jumps = shiftdim (rlim - llim, 1); +endfunction + + +%!test +%! p = [1 6 11 6]; +%! x = linspace (5, 6, 4); +%! y = polyval (p, x); +%! pp = spline (x, y); +%! jj = ppjumps (pp); +%! assert (jj, [0 0], eps) + +%!test +%! +%! breaks = [0 1 2]; +%! pp1 = poly (-[1 2 3]); +%! pp2 = poly (-([1 2 3]+1)); +%! pp = mkpp (breaks, [pp1;pp2]); +%! assert (ppjumps (pp), 0, eps) + +%!test +%! +%! breaks = [0 1 2]; +%! pp1 = poly (-[1 2 3]); +%! pp2 = poly (([1 2 3]+1)); +%! pp = mkpp (breaks, [pp1;pp2]); +%! j = - 2 * polyval (pp1, 1); +%! assert (ppjumps (pp), j, eps) diff --git a/octave_packages/m/polynomial/ppval.m b/octave_packages/m/polynomial/ppval.m new file mode 100644 index 0000000..5e94cdf --- /dev/null +++ b/octave_packages/m/polynomial/ppval.m @@ -0,0 +1,116 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{yi} =} ppval (@var{pp}, @var{xi}) +## Evaluate the piecewise polynomial structure @var{pp} at the points @var{xi}. +## If @var{pp} describes a scalar polynomial function, the result is an +## array of the same shape as @var{xi}. +## Otherwise, the size of the result is @code{[pp.dim, length(@var{xi})]} if +## @var{xi} is a vector, or @code{[pp.dim, size(@var{xi})]} if it is a +## multi-dimensional array. +## @seealso{mkpp, unmkpp, spline, pchip} +## @end deftypefn + +function yi = ppval (pp, xi) + + if (nargin != 2) + print_usage (); + endif + if (! (isstruct (pp) && strcmp (pp.form, "pp"))) + error ("ppval: first argument must be a pp-form structure"); + endif + + ## Extract info. + [x, P, n, k, d] = unmkpp (pp); + + ## dimension checks + sxi = size (xi); + if (isvector (xi)) + xi = xi(:).'; + endif + + nd = length (d); + + ## Determine intervals. + xn = numel (xi); + idx = lookup (x, xi, "lr"); + + P = reshape (P, [d, n * k]); + P = shiftdim (P, nd); + P = reshape (P, [n, k, d]); + Pidx = P(idx(:), :);#2d matrix size x: coefs*prod(d) y: prod(sxi) + + if (isvector(xi)) + Pidx = reshape (Pidx, [xn, k, d]); + Pidx = shiftdim (Pidx, 1); + dimvec = [d, xn]; + else + Pidx = reshape (Pidx, [sxi, k, d]); + Pidx = shiftdim (Pidx, length (sxi)); + dimvec = [d, sxi]; + endif + ndv = length (dimvec); + + ## Offsets. + dx = (xi - x(idx)); + dx = repmat (dx, [prod(d), 1]); + dx = reshape (dx, dimvec); + dx = shiftdim (dx, ndv - 1); + + ## Use Horner scheme. + yi = Pidx; + if (k > 1) + yi = shiftdim (reshape (Pidx(1,:), dimvec), ndv - 1); + endif + + for i = 2 : k; + yi .*= dx; + yi += shiftdim (reshape (Pidx(i,:), dimvec), ndv - 1); + endfor + + ## Adjust shape. + if ((numel (xi) > 1) || (length (d) == 1)) + yi = reshape (shiftdim (yi, 1), dimvec); + endif + + if (isvector (xi) && (d == 1)) + yi = reshape (yi, sxi); + elseif (isfield (pp, "orient") && strcmp (pp.orient, "first")) + yi = shiftdim(yi, nd); + endif + + ## + #if (d == 1) + # yi = reshape (yi, sxi); + #endif + +endfunction + +%!shared b,c,pp,pp2,xi,abserr +%! b = 1:3; c = ones(2); pp=mkpp(b,c);abserr = 1e-14;pp2=mkpp(b,[c;c],2); +%! xi = [1.1 1.3 1.9 2.1]; +%!assert (ppval(pp,1.1), 1.1, abserr); +%!assert (ppval(pp,2.1), 1.1, abserr); +%!assert (ppval(pp,xi), [1.1 1.3 1.9 1.1], abserr); +%!assert (ppval(pp,xi.'), [1.1 1.3 1.9 1.1].', abserr); +%!assert (ppval(pp2,1.1), [1.1;1.1], abserr); +%!assert (ppval(pp2,2.1), [1.1;1.1], abserr); +%!assert (ppval(pp2,xi), [1.1 1.3 1.9 1.1;1.1 1.3 1.9 1.1], abserr); +%!assert (ppval(pp2,xi'), [1.1 1.3 1.9 1.1;1.1 1.3 1.9 1.1], abserr); +%!assert (size(ppval(pp2,[xi;xi])), [2 2 4]); diff --git a/octave_packages/m/polynomial/residue.m b/octave_packages/m/polynomial/residue.m new file mode 100644 index 0000000..4107ccc --- /dev/null +++ b/octave_packages/m/polynomial/residue.m @@ -0,0 +1,430 @@ +## Copyright (C) 1994-2012 John W. Eaton +## Copyright (C) 2007 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{r}, @var{p}, @var{k}, @var{e}] =} residue (@var{b}, @var{a}) +## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}) +## @deftypefnx {Function File} {[@var{b}, @var{a}] =} residue (@var{r}, @var{p}, @var{k}, @var{e}) +## The first calling form computes the partial fraction expansion for the +## quotient of the polynomials, @var{b} and @var{a}. +## @tex +## $$ +## {B(s)\over A(s)} = \sum_{m=1}^M {r_m\over (s-p_m)^e_m} +## + \sum_{i=1}^N k_i s^{N-i}. +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## B(s) M r(m) N +## ---- = SUM ------------- + SUM k(i)*s^(N-i) +## A(s) m=1 (s-p(m))^e(m) i=1 +## @end group +## @end example +## +## @end ifnottex +## @noindent +## where @math{M} is the number of poles (the length of the @var{r}, +## @var{p}, and @var{e}), the @var{k} vector is a polynomial of order @math{N-1} +## representing the direct contribution, and the @var{e} vector specifies +## the multiplicity of the m-th residue's pole. +## +## For example, +## +## @example +## @group +## b = [1, 1, 1]; +## a = [1, -5, 8, -4]; +## [r, p, k, e] = residue (b, a) +## @result{} r = [-2; 7; 3] +## @result{} p = [2; 2; 1] +## @result{} k = [](0x0) +## @result{} e = [1; 2; 1] +## @end group +## @end example +## +## @noindent +## which represents the following partial fraction expansion +## @tex +## $$ +## {s^2+s+1\over s^3-5s^2+8s-4} = {-2\over s-2} + {7\over (s-2)^2} + {3\over s-1} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## s^2 + s + 1 -2 7 3 +## ------------------- = ----- + ------- + ----- +## s^3 - 5s^2 + 8s - 4 (s-2) (s-2)^2 (s-1) +## @end group +## @end example +## +## @end ifnottex +## +## The second calling form performs the inverse operation and computes +## the reconstituted quotient of polynomials, @var{b}(s)/@var{a}(s), +## from the partial fraction expansion; represented by the residues, +## poles, and a direct polynomial specified by @var{r}, @var{p} and +## @var{k}, and the pole multiplicity @var{e}. +## +## If the multiplicity, @var{e}, is not explicitly specified the multiplicity is +## determined by the function @code{mpoles}. +## +## For example: +## +## @example +## @group +## r = [-2; 7; 3]; +## p = [2; 2; 1]; +## k = [1, 0]; +## [b, a] = residue (r, p, k) +## @result{} b = [1, -5, 9, -3, 1] +## @result{} a = [1, -5, 8, -4] +## +## where mpoles is used to determine e = [1; 2; 1] +## @end group +## @end example +## +## Alternatively the multiplicity may be defined explicitly, for example, +## +## @example +## @group +## r = [7; 3; -2]; +## p = [2; 1; 2]; +## k = [1, 0]; +## e = [2; 1; 1]; +## [b, a] = residue (r, p, k, e) +## @result{} b = [1, -5, 9, -3, 1] +## @result{} a = [1, -5, 8, -4] +## @end group +## @end example +## +## @noindent +## which represents the following partial fraction expansion +## @tex +## $$ +## {-2\over s-2} + {7\over (s-2)^2} + {3\over s-1} + s = {s^4-5s^3+9s^2-3s+1\over s^3-5s^2+8s-4} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## -2 7 3 s^4 - 5s^3 + 9s^2 - 3s + 1 +## ----- + ------- + ----- + s = -------------------------- +## (s-2) (s-2)^2 (s-1) s^3 - 5s^2 + 8s - 4 +## @end group +## @end example +## +## @end ifnottex +## @seealso{mpoles, poly, roots, conv, deconv} +## @end deftypefn + +## Author: Tony Richardson +## Author: Ben Abbott +## Created: June 1994 +## Adapted-By: jwe + +function [r, p, k, e] = residue (b, a, varargin) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + toler = .001; + + if (nargin >= 3) + if (nargin >= 4) + e = varargin{2}; + else + e = []; + endif + ## The inputs are the residue, pole, and direct part. Solve for the + ## corresponding numerator and denominator polynomials + [r, p] = rresidue (b, a, varargin{1}, toler, e); + return + endif + + ## Make sure both polynomials are in reduced form. + + a = polyreduce (a); + b = polyreduce (b); + + b = b / a(1); + a = a / a(1); + + la = length (a); + lb = length (b); + + ## Handle special cases here. + + if (la == 0 || lb == 0) + k = r = p = e = []; + return; + elseif (la == 1) + k = b / a; + r = p = e = []; + return; + endif + + ## Find the poles. + + p = roots (a); + lp = length (p); + + ## Sort poles so that multiplicity loop will work. + + [e, indx] = mpoles (p, toler, 1); + p = p (indx); + + ## For each group of pole multiplicity, set the value of each + ## pole to the average of the group. This reduces the error in + ## the resulting poles. + + p_group = cumsum (e == 1); + for ng = 1:p_group(end) + m = find (p_group == ng); + p(m) = mean (p(m)); + endfor + + ## Find the direct term if there is one. + + if (lb >= la) + ## Also return the reduced numerator. + [k, b] = deconv (b, a); + lb = length (b); + else + k = []; + endif + + ## Determine if the poles are (effectively) zero. + + small = max (abs (p)); + if (isa (a, "single") || isa (b, "single")) + small = max ([small, 1]) * eps ("single") * 1e4 * (1 + numel (p))^2; + else + small = max ([small, 1]) * eps * 1e4 * (1 + numel (p))^2; + endif + p(abs (p) < small) = 0; + + ## Determine if the poles are (effectively) real, or imaginary. + + index = (abs (imag (p)) < small); + p(index) = real (p(index)); + index = (abs (real (p)) < small); + p(index) = 1i * imag (p(index)); + + ## The remainder determines the residues. The case of one pole + ## is trivial. + + if (lp == 1) + r = polyval (b, p); + return; + endif + + ## Determine the order of the denominator and remaining numerator. + ## With the direct term removed the potential order of the numerator + ## is one less than the order of the denominator. + + aorder = numel (a) - 1; + border = aorder - 1; + + ## Construct a system of equations relating the individual + ## contributions from each residue to the complete numerator. + + A = zeros (border+1, border+1); + B = prepad (reshape (b, [numel(b), 1]), border+1, 0); + for ip = 1:numel(p) + ri = zeros (size (p)); + ri(ip) = 1; + A(:,ip) = prepad (rresidue (ri, p, [], toler), border+1, 0).'; + endfor + + ## Solve for the residues. + + r = A \ B; + +endfunction + +function [pnum, pden, e] = rresidue (r, p, k, toler, e) + + ## Reconstitute the numerator and denominator polynomials from the + ## residues, poles, and direct term. + + if (nargin < 2 || nargin > 5) + print_usage (); + endif + + if (nargin < 5) + e = []; + endif + + if (nargin < 4) + toler = []; + endif + + if (nargin < 3) + k = []; + endif + + if numel (e) + indx = 1:numel(p); + else + [e, indx] = mpoles (p, toler, 0); + p = p (indx); + r = r (indx); + endif + + indx = 1:numel(p); + + for n = indx + pn = [1, -p(n)]; + if n == 1 + pden = pn; + else + pden = conv (pden, pn); + endif + endfor + + ## D is the order of the denominator + ## K is the order of the direct polynomial + ## N is the order of the resulting numerator + ## pnum(1:(N+1)) is the numerator's polynomial + ## pden(1:(D+1)) is the denominator's polynomial + ## pm is the multible pole for the nth residue + ## pn is the numerator contribution for the nth residue + + D = numel (pden) - 1; + K = numel (k) - 1; + N = K + D; + pnum = zeros (1, N+1); + for n = indx(abs (r) > 0) + p1 = [1, -p(n)]; + for m = 1:e(n) + if (m == 1) + pm = p1; + else + pm = conv (pm, p1); + endif + endfor + pn = deconv (pden, pm); + pn = r(n) * pn; + pnum = pnum + prepad (pn, N+1, 0, 2); + endfor + + ## Add the direct term. + + if (numel (k)) + pnum = pnum + conv (pden, k); + endif + + ## Check for leading zeros and trim the polynomial coefficients. + if (isa (r, "single") || isa (p, "single") || isa (k, "single")) + small = max ([max(abs(pden)), max(abs(pnum)), 1]) * eps ("single"); + else + small = max ([max(abs(pden)), max(abs(pnum)), 1]) * eps; + endif + + pnum(abs (pnum) < small) = 0; + pden(abs (pden) < small) = 0; + + pnum = polyreduce (pnum); + pden = polyreduce (pden); + +endfunction + +%!test +%! b = [1, 1, 1]; +%! a = [1, -5, 8, -4]; +%! [r, p, k, e] = residue (b, a); +%! assert (abs (r - [-2; 7; 3]) < 1e-12 +%! && abs (p - [2; 2; 1]) < 1e-12 +%! && isempty (k) +%! && e == [1; 2; 1]); +%! k = [1 0]; +%! b = conv (k, a) + prepad (b, numel (k) + numel (a) - 1, 0); +%! a = a; +%! [br, ar] = residue (r, p, k); +%! assert ((abs (br - b) < 1e-12 +%! && abs (ar - a) < 1e-12)); +%! [br, ar] = residue (r, p, k, e); +%! assert ((abs (br - b) < 1e-12 +%! && abs (ar - a) < 1e-12)); + +%!test +%! b = [1, 0, 1]; +%! a = [1, 0, 18, 0, 81]; +%! [r, p, k, e] = residue (b, a); +%! r1 = [-5i; 12; +5i; 12]/54; +%! p1 = [+3i; +3i; -3i; -3i]; +%! assert (abs (r - r1) < 1e-12 && abs (p - p1) < 1e-12 +%! && isempty (k) +%! && e == [1; 2; 1; 2]); +%! [br, ar] = residue (r, p, k); +%! assert ((abs (br - b) < 1e-12 +%! && abs (ar - a) < 1e-12)); + +%!test +%! r = [7; 3; -2]; +%! p = [2; 1; 2]; +%! k = [1 0]; +%! e = [2; 1; 1]; +%! [b, a] = residue (r, p, k, e); +%! assert ((abs (b - [1, -5, 9, -3, 1]) < 1e-12 +%! && abs (a - [1, -5, 8, -4]) < 1e-12)); +%! [rr, pr, kr, er] = residue (b, a); +%! [jnk, n] = mpoles(p); +%! assert ((abs (rr - r(n)) < 1e-12 +%! && abs (pr - p(n)) < 1e-12 +%! && abs (kr - k) < 1e-12 +%! && abs (er - e(n)) < 1e-12)); + +%!test +%! b = [1]; +%! a = [1, 10, 25]; +%! [r, p, k, e] = residue (b, a); +%! r1 = [0; 1]; +%! p1 = [-5; -5]; +%! assert (abs (r - r1) < 1e-12 && abs (p - p1) < 1e-12 +%! && isempty (k) +%! && e == [1; 2]); +%! [br, ar] = residue (r, p, k); +%! assert ((abs (br - b) < 1e-12 +%! && abs (ar - a) < 1e-12)); + +## The following test is due to Bernard Grung (bug #34266) +%!xtest +%! z1 = 7.0372976777e6; +%! p1 = -3.1415926536e9; +%! p2 = -4.9964813512e8; +%! r1 = -(1 + z1/p1)/(1 - p1/p2)/p2/p1; +%! r2 = -(1 + z1/p2)/(1 - p2/p1)/p2/p1; +%! r3 = (1 + (p2 + p1)/p2/p1*z1)/p2/p1; +%! r4 = z1/p2/p1; +%! r = [r1; r2; r3; r4]; +%! p = [p1; p2; 0; 0]; +%! k = []; +%! e = [1; 1; 1; 2]; +%! b = [1, z1]; +%! a = [1, -(p1 + p2), p1*p2, 0, 0]; +%! [br, ar] = residue (r, p, k, e); +%! assert (br, b, 1e-8); +%! assert (ar, a, 1e-8); diff --git a/octave_packages/m/polynomial/roots.m b/octave_packages/m/polynomial/roots.m new file mode 100644 index 0000000..bf149ce --- /dev/null +++ b/octave_packages/m/polynomial/roots.m @@ -0,0 +1,141 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} roots (@var{v}) +## +## For a vector @var{v} with @math{N} components, return +## the roots of the polynomial +## @tex +## $$ +## v_1 z^{N-1} + \cdots + v_{N-1} z + v_N. +## $$ +## @end tex +## @ifnottex +## +## @example +## v(1) * z^(N-1) + @dots{} + v(N-1) * z + v(N) +## @end example +## +## @end ifnottex +## +## As an example, the following code finds the roots of the quadratic +## polynomial +## @tex +## $$ p(x) = x^2 - 5. $$ +## @end tex +## @ifnottex +## +## @example +## p(x) = x^2 - 5. +## @end example +## +## @end ifnottex +## +## @example +## @group +## c = [1, 0, -5]; +## roots (c) +## @result{} 2.2361 +## @result{} -2.2361 +## @end group +## @end example +## +## Note that the true result is +## @tex +## $\pm \sqrt{5}$ +## @end tex +## @ifnottex +## @math{+/- sqrt(5)} +## @end ifnottex +## which is roughly +## @tex +## $\pm 2.2361$. +## @end tex +## @ifnottex +## @math{+/- 2.2361}. +## @end ifnottex +## @seealso{poly, compan, fzero} +## @end deftypefn + +## Author: KH +## Created: 24 December 1993 +## Adapted-By: jwe + +function r = roots (v) + + if (nargin != 1 || min (size (v)) > 1) + print_usage (); + elseif (any (isnan(v) | isinf(v))) + error ("roots: inputs must not contain Inf or NaN"); + endif + + n = numel (v); + v = v(:); + + ## If v = [ 0 ... 0 v(k+1) ... v(k+l) 0 ... 0 ], we can remove the + ## leading k zeros and n - k - l roots of the polynomial are zero. + + if (isempty (v)) + f = v; + else + f = find (v ./ max (abs (v))); + endif + m = numel (f); + + if (m > 0 && n > 1) + v = v(f(1):f(m)); + l = max (size (v)); + if (l > 1) + A = diag (ones (1, l-2), -1); + A(1,:) = -v(2:l) ./ v(1); + r = eig (A); + if (f(m) < n) + tmp = zeros (n - f(m), 1); + r = [r; tmp]; + endif + else + r = zeros (n - f(m), 1); + endif + else + r = []; + endif + +endfunction + +%!test +%! p = [poly([3 3 3 3]), 0 0 0 0]; +%! r = sort (roots (p)); +%! assert (r, [0; 0; 0; 0; 3; 3; 3; 3], 0.001) + +%!assert(all (all (abs (roots ([1, -6, 11, -6]) - [3; 2; 1]) < sqrt (eps)))); + +%!assert(isempty (roots ([]))); + +%!error roots ([1, 2; 3, 4]); + +%!assert(isempty (roots (1))); + +%!error roots ([1, 2; 3, 4]); + +%!error roots ([1 Inf 1]); + +%!error roots ([1 NaN 1]); + +%!assert(roots ([1e-200, -1e200, 1]), 1e-200) +%!assert(roots ([1e-200, -1e200 * 1i, 1]), -1e-200 * 1i) diff --git a/octave_packages/m/polynomial/spline.m b/octave_packages/m/polynomial/spline.m new file mode 100644 index 0000000..ce83413 --- /dev/null +++ b/octave_packages/m/polynomial/spline.m @@ -0,0 +1,305 @@ +## Copyright (C) 2000-2012 Kai Habel +## Copyright (C) 2006 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{pp} =} spline (@var{x}, @var{y}) +## @deftypefnx {Function File} {@var{yi} =} spline (@var{x}, @var{y}, @var{xi}) +## Return the cubic spline interpolant of points @var{x} and @var{y}. +## +## When called with two arguments, return the piecewise polynomial @var{pp} +## that may be used with @code{ppval} to evaluate the polynomial at specific +## points. When called with a third input argument, @code{spline} evaluates +## the spline at the points @var{xi}. The third calling form @code{spline +## (@var{x}, @var{y}, @var{xi})} is equivalent to @code{ppval (spline +## (@var{x}, @var{y}), @var{xi})}. +## +## The variable @var{x} must be a vector of length @var{n}. @var{y} can be +## either a vector or array. If @var{y} is a vector it must have a length of +## either @var{n} or @code{@var{n} + 2}. If the length of @var{y} is +## @var{n}, then the "not-a-knot" end condition is used. If the length of +## @var{y} is @code{@var{n} + 2}, then the first and last values of the +## vector @var{y} are the values of the first derivative of the cubic spline +## at the endpoints. +## +## If @var{y} is an array, then the size of @var{y} must have the form +## @tex +## $$[s_1, s_2, \cdots, s_k, n]$$ +## @end tex +## @ifnottex +## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n}]} +## @end ifnottex +## or +## @tex +## $$[s_1, s_2, \cdots, s_k, n + 2].$$ +## @end tex +## @ifnottex +## @code{[@var{s1}, @var{s2}, @dots{}, @var{sk}, @var{n} + 2]}. +## @end ifnottex +## The array is reshaped internally to a matrix where the leading +## dimension is given by +## @tex +## $$s_1 s_2 \cdots s_k$$ +## @end tex +## @ifnottex +## @code{@var{s1} * @var{s2} * @dots{} * @var{sk}} +## @end ifnottex +## and each row of this matrix is then treated separately. Note that this +## is exactly opposite to @code{interp1} but is done for @sc{matlab} +## compatibility. +## +## @seealso{pchip, ppval, mkpp, unmkpp} +## @end deftypefn + +## This code is based on csape.m from octave-forge, but has been +## modified to use the sparse solver code in octave that itself allows +## special casing of tri-diagonal matrices, modified for NDArrays and +## for the treatment of vectors y 2 elements longer than x as complete +## splines. + +function ret = spline (x, y, xi) + + x = x(:); + n = length (x); + if (n < 2) + error ("spline: requires at least 2 points"); + endif + + ## Check the size and shape of y + ndy = ndims (y); + szy = size (y); + if (ndy == 2 && (szy(1) == n || szy(2) == n)) + if (szy(2) == n) + a = y.'; + else + a = y; + szy = fliplr (szy); + endif + else + a = shiftdim (reshape (y, [prod(szy(1:end-1)), szy(end)]), 1); + endif + + for k = (1:columns (a))(any (isnan (a))) + ok = ! isnan (a(:,k)); + a(!ok,k) = spline (x(ok), a(ok,k), x(!ok)); + endfor + + complete = false; + if (size (a, 1) == n + 2) + complete = true; + dfs = a(1,:); + dfe = a(end,:); + a = a(2:end-1,:); + endif + + if (~issorted (x)) + [x, idx] = sort(x); + a = a(idx,:); + endif + + b = c = zeros (size (a)); + h = diff (x); + idx = ones (columns (a), 1); + + if (complete) + + if (n == 2) + d = (dfs + dfe) / (x(2) - x(1)) ^ 2 + ... + 2 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 3; + c = (-2 * dfs - dfe) / (x(2) - x(1)) - ... + 3 * (a(1,:) - a(2,:)) / (x(2) - x(1)) ^ 2; + b = dfs; + a = a(1,:); + + d = d(1:n-1,:); + c = c(1:n-1,:); + b = b(1:n-1,:); + a = a(1:n-1,:); + else + if (n == 3) + dg = 1.5 * h(1) - 0.5 * h(2); + c(2:n-1,:) = 1/dg(1); + else + dg = 2 * (h(1:n-2) .+ h(2:n-1)); + dg(1) = dg(1) - 0.5 * h(1); + dg(n-2) = dg(n-2) - 0.5 * h(n-1); + + e = h(2:n-2); + + g = 3 * diff (a(2:n,:)) ./ h(2:n-1,idx) ... + - 3 * diff (a(1:n-1,:)) ./ h(1:n-2,idx); + g(1,:) = 3 * (a(3,:) - a(2,:)) / h(2) ... + - 3 / 2 * (3 * (a(2,:) - a(1,:)) / h(1) - dfs); + g(n-2,:) = 3 / 2 * (3 * (a(n,:) - a(n-1,:)) / h(n-1) - dfe) ... + - 3 * (a(n-1,:) - a(n-2,:)) / h(n-2); + + c(2:n-1,:) = spdiags ([[e(:); 0], dg, [0; e(:)]], + [-1, 0, 1], n-2, n-2) \ g; + endif + + c(1,:) = (3 / h(1) * (a(2,:) - a(1,:)) - 3 * dfs + - c(2,:) * h(1)) / (2 * h(1)); + c(n,:) = - (3 / h(n-1) * (a(n,:) - a(n-1,:)) - 3 * dfe + + c(n-1,:) * h(n-1)) / (2 * h(n-1)); + b(1:n-1,:) = diff (a) ./ h(1:n-1, idx) ... + - h(1:n-1,idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:)); + d = diff (c) ./ (3 * h(1:n-1, idx)); + + d = d(1:n-1,:); + c = c(1:n-1,:); + b = b(1:n-1,:); + a = a(1:n-1,:); + endif + else + + if (n == 2) + b = (a(2,:) - a(1,:)) / (x(2) - x(1)); + a = a(1,:); + d = []; + c = []; + b = b(1:n-1,:); + a = a(1:n-1,:); + elseif (n == 3) + + n = 2; + c = (a(1,:) - a(3,:)) / ((x(3) - x(1)) * (x(2) - x(3))) ... + + (a(2,:) - a(1,:)) / ((x(2) - x(1)) * (x(2) - x(3))); + b = (a(2,:) - a(1,:)) * (x(3) - x(1)) ... + / ((x(2) - x(1)) * (x(3) - x(2))) ... + + (a(1,:) - a(3,:)) * (x(2) - x(1)) ... + / ((x(3) - x(1)) * (x(3) - x(2))); + a = a(1,:); + d = []; + x = [min(x), max(x)]; + + c = c(1:n-1,:); + b = b(1:n-1,:); + a = a(1:n-1,:); + else + + g = zeros (n-2, columns (a)); + g(1,:) = 3 / (h(1) + h(2)) ... + * (a(3,:) - a(2,:) - h(2) / h(1) * (a(2,:) - a(1,:))); + g(n-2,:) = 3 / (h(n-1) + h(n-2)) ... + * (h(n-2) / h(n-1) * (a(n,:) - a(n-1,:)) - (a(n-1,:) - a(n-2,:))); + + if (n > 4) + + g(2:n - 3,:) = 3 * diff (a(3:n-1,:)) ./ h(3:n-2,idx) ... + - 3 * diff (a(2:n-2,:)) ./ h(2:n - 3,idx); + + dg = 2 * (h(1:n-2) .+ h(2:n-1)); + dg(1) = dg(1) - h(1); + dg(n-2) = dg(n-2) - h(n-1); + + ldg = udg = h(2:n-2); + udg(1) = udg(1) - h(1); + ldg(n - 3) = ldg(n-3) - h(n-1); + c(2:n-1,:) = spdiags ([[ldg(:); 0], dg, [0; udg(:)]], + [-1, 0, 1], n-2, n-2) \ g; + + elseif (n == 4) + + dg = [h(1) + 2 * h(2); 2 * h(2) + h(3)]; + ldg = h(2) - h(3); + udg = h(2) - h(1); + c(2:n-1,:) = spdiags ([[ldg(:);0], dg, [0; udg(:)]], + [-1, 0, 1], n-2, n-2) \ g; + + endif + + c(1,:) = c(2,:) + h(1) / h(2) * (c(2,:) - c(3,:)); + c(n,:) = c(n-1,:) + h(n-1) / h(n-2) * (c(n-1,:) - c(n-2,:)); + b = diff (a) ./ h(1:n-1, idx) ... + - h(1:n-1, idx) / 3 .* (c(2:n,:) + 2 * c(1:n-1,:)); + d = diff (c) ./ (3 * h(1:n-1, idx)); + + d = d(1:n-1,:);d = d.'(:); + c = c(1:n-1,:);c = c.'(:); + b = b(1:n-1,:);b = b.'(:); + a = a(1:n-1,:);a = a.'(:); + endif + + endif + ret = mkpp (x, cat (2, d, c, b, a), szy(1:end-1)); + + if (nargin == 3) + ret = ppval (ret, xi); + endif + +endfunction + +%!demo +%! x = 0:10; y = sin(x); +%! xspline = 0:0.1:10; yspline = spline(x,y,xspline); +%! title("spline fit to points from sin(x)"); +%! plot(xspline,sin(xspline),"r",xspline,yspline,"g-",x,y,"b+"); +%! legend("original","interpolation","interpolation points"); +%! %-------------------------------------------------------- +%! % confirm that interpolated function matches the original + +%!shared x,y,abserr +%! x = [0:10]; y = sin(x); abserr = 1e-14; +%!assert (spline(x,y,x), y, abserr); +%!assert (spline(x,y,x'), y', abserr); +%!assert (spline(x',y',x'), y', abserr); +%!assert (spline(x',y',x), y, abserr); +%!assert (isempty(spline(x',y',[]))); +%!assert (isempty(spline(x,y,[]))); +%!assert (spline(x,[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x,[y;y],x'), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x',[y;y],x), [spline(x,y,x);spline(x,y,x)],abserr) +%!assert (spline(x',[y;y],x'), [spline(x,y,x);spline(x,y,x)],abserr) +%! y = cos(x) + i*sin(x); +%!assert (spline(x,y,x), y, abserr) +%!assert (real(spline(x,y,x)), real(y), abserr); +%!assert (real(spline(x,y,x.')), real(y).', abserr); +%!assert (real(spline(x.',y.',x.')), real(y).', abserr); +%!assert (real(spline(x.',y,x)), real(y), abserr); +%!assert (imag(spline(x,y,x)), imag(y), abserr); +%!assert (imag(spline(x,y,x.')), imag(y).', abserr); +%!assert (imag(spline(x.',y.',x.')), imag(y).', abserr); +%!assert (imag(spline(x.',y,x)), imag(y), abserr); +%!test +%! xnan = 5; +%! y(x==xnan) = NaN; +%! ok = ! isnan (y); +%! assert (spline (x, y, x(ok)), y(ok), abserr); +%!test +%! ok = ! isnan (y); +%! assert (! isnan (spline (x, y, x(!ok)))); +%!test +%! x = [1,2]; +%! y = [1,4]; +%! assert (spline (x,y,x), [1,4], abserr); +%!test +%! x = [2,1]; +%! y = [1,4]; +%! assert (spline (x,y,x), [1,4], abserr); +%!test +%! x = [1,2]; +%! y = [1,2,3,4]; +%! pp = spline (x,y); +%! [x,P] = unmkpp (pp); +%! assert (norm (P-[3,-3,1,2]), 0, abserr); +%!test +%! x = [2,1]; +%! y = [1,2,3,4]; +%! pp = spline (x,y); +%! [x,P] = unmkpp (pp); +%! assert (norm (P-[7,-9,1,3]), 0, abserr); diff --git a/octave_packages/m/polynomial/unmkpp.m b/octave_packages/m/polynomial/unmkpp.m new file mode 100644 index 0000000..e16f713 --- /dev/null +++ b/octave_packages/m/polynomial/unmkpp.m @@ -0,0 +1,83 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{x}, @var{p}, @var{n}, @var{k}, @var{d}] =} unmkpp (@var{pp}) +## +## Extract the components of a piecewise polynomial structure @var{pp}. +## The components are: +## +## @table @asis +## @item @var{x} +## Sample points. +## +## @item @var{p} +## Polynomial coefficients for points in sample interval. @code{@var{p} +## (@var{i}, :)} contains the coefficients for the polynomial over +## interval @var{i} ordered from highest to lowest. If @code{@var{d} > +## 1}, @code{@var{p} (@var{r}, @var{i}, :)} contains the coefficients for +## the r-th polynomial defined on interval @var{i}. +## +## @item @var{n} +## Number of polynomial pieces. +## +## @item @var{k} +## Order of the polynomial plus 1. +## +## @item @var{d} +## Number of polynomials defined for each interval. +## @end table +## +## @seealso{mkpp, ppval, spline, pchip} +## @end deftypefn + +function [x, P, n, k, d] = unmkpp (pp) + + if (nargin != 1) + print_usage (); + endif + if (! (isstruct (pp) && isfield (pp, "form") && strcmp (pp.form, "pp"))) + error ("unmkpp: PP must be a piecewise polynomial structure"); + endif + x = pp.breaks; + P = pp.coefs; + n = pp.pieces; + k = pp.order; + d = pp.dim; + +endfunction + + +%!test +%! b = 1:3; +%! c = 1:24; +%! pp = mkpp (b,c); +%! [x, P, n, k, d] = unmkpp (pp); +%! assert (x, b); +%! assert (P, reshape (c, [2 12])); +%! assert (n, 2); +%! assert (k, 12); +%! assert (d, 1); + +%% Test input validation +%!error unmkpp () +%!error unmkpp (1,2) +%!error unmkpp (1) +%!error unmkpp (struct ("field1", "pp")) +%!error unmkpp (struct ("form", "not_a_pp")) + diff --git a/octave_packages/m/prefs/addpref.m b/octave_packages/m/prefs/addpref.m new file mode 100644 index 0000000..1d6e819 --- /dev/null +++ b/octave_packages/m/prefs/addpref.m @@ -0,0 +1,74 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} addpref (@var{group}, @var{pref}, @var{val}) +## Add a preference @var{pref} and associated value @var{val} to the +## named preference group @var{group}. +## +## The named preference group must be a character string. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. The corresponding value @var{val} may be any +## value, or, if @var{pref} is a cell array of strings, @var{val} +## must be a cell array of values with the same size as @var{pref}. +## @seealso{setpref, getpref, ispref, rmpref} +## @end deftypefn + +## Author: jwe + +function addpref (group, pref, val) + + if (nargin == 3) + if (ischar (group)) + prefs = loadprefs (); + if (ischar (pref)) + if (isfield (group, pref)) + error ("preference %s already exists in group %s", pref, group); + else + prefs.(group).(pref) = val; + endif + elseif (iscellstr (pref)) + if (size_equal (pref, val)) + for i = 1:numel(pref) + if (isfield (group, pref{i})) + error ("preference %s already exists in group %s", + pref{i}, group); + else + prefs.(group).(pref{i}) = val; + endif + endfor + else + error ("size mismatch for pref and val"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + saveprefs (prefs); + else + error ("expecting group to be a character string"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests. diff --git a/octave_packages/m/prefs/getpref.m b/octave_packages/m/prefs/getpref.m new file mode 100644 index 0000000..f824c61 --- /dev/null +++ b/octave_packages/m/prefs/getpref.m @@ -0,0 +1,95 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} getpref (@var{group}, @var{pref}, @var{default}) +## Return the preference value corresponding to the named preference +## @var{pref} in the preference group @var{group}. +## +## The named preference group must be a character string. +## +## If @var{pref} does not exist in @var{group} and @var{default} is +## specified, return @var{default}. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. The corresponding default value @var{default} +## may be any value, or, if @var{pref} is a cell array of strings, +## @var{default} must be a cell array of values with the same size as +## @var{pref}. +## +## If neither @var{pref} nor @var{default} are specified, return a +## structure of preferences for the preference group @var{group}. +## +## If no arguments are specified, return a structure containing all +## groups of preferences and their values. +## @seealso{addpref, setpref, ispref, rmpref} +## @end deftypefn + +## Author: jwe + +function retval = getpref (group, pref, default) + + if (nargin == 0) + retval = loadprefs (); + elseif (nargin == 1) + if (ischar (group)) + prefs = loadprefs (); + if (isfield (prefs, group)) + retval = prefs.(group); + else + retval = []; + endif + else + error ("expecting group to be a character string"); + endif + elseif (nargin == 2 || nargin == 3) + grp = getpref (group); + if (ischar (pref)) + if (isfield (grp, pref)) + retval = grp.(pref); + elseif (nargin == 3) + retval = default; + else + error ("preference %s does not exist in group %s", pref, group); + endif + elseif (iscellstr (pref)) + if (nargin == 2 || size_equal (pref, default)) + for i = 1:numel(pref) + if (isfield (grp, pref{i})) + retval.(pref) = grp.(pref{i}); + elseif (nargin == 3) + retval.(pref) = default{i}; + else + error ("preference %s does not exist in group %s", pref{i}, group); + endif + endfor + else + error ("size mismatch for pref and default"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests. diff --git a/octave_packages/m/prefs/ispref.m b/octave_packages/m/prefs/ispref.m new file mode 100644 index 0000000..a52f76a --- /dev/null +++ b/octave_packages/m/prefs/ispref.m @@ -0,0 +1,60 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ispref (@var{group}, @var{pref}) +## Return true if the named preference @var{pref} exists in the +## preference group @var{group}. +## +## The named preference group must be a character string. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. +## +## If @var{pref} is not specified, return true if the preference +## group @var{group} exists. +## @seealso{getpref, addpref, setpref, rmpref} +## @end deftypefn + +## Author: jwe + +function retval = ispref (group, pref) + + if (nargin == 1) + retval = isfield (loadprefs (), group); + elseif (nargin == 2) + prefs = loadprefs (); + if (isfield (prefs, group)) + grp = prefs.(group); + if (ischar (pref) || iscellstr (pref)) + retval = isfield (grp, pref); + else + retval = false; + endif + else + retval = false; + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests. diff --git a/octave_packages/m/prefs/private/loadprefs.m b/octave_packages/m/prefs/private/loadprefs.m new file mode 100644 index 0000000..fe978ac --- /dev/null +++ b/octave_packages/m/prefs/private/loadprefs.m @@ -0,0 +1,43 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} loadprefs () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = loadprefs () + + file = prefsfile (); + + s = stat (file); + + if (isstruct (s) && S_ISREG (s.mode)) + tmp = load (file); + retval= tmp.prefs; + else + retval = []; + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests. diff --git a/octave_packages/m/prefs/private/prefsfile.m b/octave_packages/m/prefs/private/prefsfile.m new file mode 100644 index 0000000..9ea4d9a --- /dev/null +++ b/octave_packages/m/prefs/private/prefsfile.m @@ -0,0 +1,53 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} prefsfile () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = prefsfile () + + retval = "~/.octave_prefs"; + + ## Transition users to new filename if necessary + ## FIXME: Delete before 3.6.0 release + oldname = tilde_expand ("~/.octave-prefs"); + if (exist (oldname, "file")) + newname = tilde_expand (retval); + if (exist (newname, "file")) + error (["Octave uses the file ~/.octave_prefs to store preferences.\n",... + " The old file name was ~/.octave-prefs.\n",... + " Both files exist."... + " User must manually delete one of the files.\n"]); + endif + status = movefile (oldname, newname); + if (! status) + error (["Octave uses the file ~/.octave_prefs to store preferences.\n", + " The old file name was ~/.octave-prefs.\n", + " User must manually rename the old file to the new name.\n"]); + endif + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests. diff --git a/octave_packages/m/prefs/private/saveprefs.m b/octave_packages/m/prefs/private/saveprefs.m new file mode 100644 index 0000000..3b85865 --- /dev/null +++ b/octave_packages/m/prefs/private/saveprefs.m @@ -0,0 +1,36 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} saveprefs () +## Undocumented internal function. +## @end deftypefn + +## Author: jwe + +function retval = saveprefs (s) + + prefs = s; + + save (prefsfile (), "prefs"); + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests. diff --git a/octave_packages/m/prefs/rmpref.m b/octave_packages/m/prefs/rmpref.m new file mode 100644 index 0000000..0e9a84d --- /dev/null +++ b/octave_packages/m/prefs/rmpref.m @@ -0,0 +1,61 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rmpref (@var{group}, @var{pref}) +## Remove the named preference @var{pref} from the preference group +## @var{group}. +## +## The named preference group must be a character string. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. +## +## If @var{pref} is not specified, remove the preference group +## @var{group}. +## +## It is an error to remove a nonexistent preference or group. +## @seealso{addpref, ispref, setpref, getpref} +## @end deftypefn + +## Author: jwe + +function retval = rmpref (group, pref) + + prefs = loadprefs (); + + if (nargin == 1) + if (ischar (group)) + retval = isfield (prefs, group); + else + error ("expecting group to be a character array"); + endif + elseif (nargin == 2) + grp = getpref (group, pref); + if (ischar (pref) || iscellstr (pref)) + retval = isfield (grp, pref); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests. diff --git a/octave_packages/m/prefs/setpref.m b/octave_packages/m/prefs/setpref.m new file mode 100644 index 0000000..7021413 --- /dev/null +++ b/octave_packages/m/prefs/setpref.m @@ -0,0 +1,67 @@ +## Copyright (C) 2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} setpref (@var{group}, @var{pref}, @var{val}) +## Set a preference @var{pref} to the given @var{val} in the named +## preference group @var{group}. +## +## The named preference group must be a character string. +## +## The preference @var{pref} may be a character string or a cell array +## of character strings. The corresponding value @var{val} may be any +## value, or, if @var{pref} is a cell array of strings, @var{val} +## must be a cell array of values with the same size as @var{pref}. +## +## If the named preference or group does not exist, it is added. +## @seealso{addpref, getpref, ispref, rmpref} +## @end deftypefn + +## Author: jwe + +function setpref (group, pref, val) + + if (nargin == 3) + if (ischar (group)) + prefs = loadprefs (); + if (ischar (pref)) + prefs.(group).(pref) = val; + elseif (iscellstr (pref)) + if (size_equal (pref, val)) + for i = 1:numel(pref) + prefs.(group).(pref{i}) = val; + endfor + else + error ("size mismatch for pref and val"); + endif + else + error ("expecting pref to be a character string or cellstr"); + endif + saveprefs (prefs); + else + error ("expecting group to be a character string"); + endif + else + print_usage (); + endif + +endfunction + +%% Testing these functions will require some care to avoid wiping out +%% existing (or creating unwanted) preferences for the user running the +%% tests. diff --git a/octave_packages/m/set/intersect.m b/octave_packages/m/set/intersect.m new file mode 100644 index 0000000..488bffd --- /dev/null +++ b/octave_packages/m/set/intersect.m @@ -0,0 +1,115 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2008-2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} intersect (@var{a}, @var{b}) +## @deftypefnx {Function File} {[@var{c}, @var{ia}, @var{ib}] =} intersect (@var{a}, @var{b}) +## +## Return the elements in both @var{a} and @var{b}, sorted in ascending +## order. If @var{a} and @var{b} are both column vectors return a column +## vector, otherwise return a row vector. +## @var{a}, @var{b} may be cell arrays of string(s). +## +## Return index vectors @var{ia} and @var{ib} such that @code{a(ia)==c} and +## @code{b(ib)==c}. +## +## @end deftypefn +## @seealso{unique, union, setxor, setdiff, ismember} + +function [c, ia, ib] = intersect (a, b, varargin) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + [a, b] = validargs ("intersect", a, b, varargin{:}); + + if (isempty (a) || isempty (b)) + c = ia = ib = []; + else + ## form a and b into sets + if (nargout > 1) + [a, ja] = unique (a, varargin{:}); + [b, jb] = unique (b, varargin{:}); + else + a = unique (a, varargin{:}); + b = unique (b, varargin{:}); + endif + + if (nargin > 2) + c = [a; b]; + [c, ic] = sortrows (c); + ii = find (all (c(1:end-1,:) == c(2:end,:), 2)); + c = c(ii,:); + len_a = rows (a); + else + c = [a(:); b(:)]; + [c, ic] = sort (c); ## [a(:);b(:)](ic) == c + if (iscellstr (c)) + ii = find (strcmp (c(1:end-1), c(2:end))); + else + ii = find (c(1:end-1) == c(2:end)); + endif + c = c(ii); + len_a = length (a); + endif + + if (nargout > 1) + ia = ja(ic(ii)); ## a(ia) == c + ib = jb(ic(ii+1) - len_a); ## b(ib) == c + endif + + if (nargin == 2 && (size (b, 1) == 1 || size (a, 1) == 1)) + c = c.'; + endif + endif + +endfunction + + +%!# Test the routine for index vectors ia and ib +%!test +%! a = [3 2 4 5 7 6 5 1 0 13 13]; +%! b = [3 5 12 1 1 7]; +%! [c,ia,ib] = intersect(a,b); +%! assert(c,[1 3 5 7]); +%! assert(ia,[8 1 7 5]); +%! assert(ib,[5 1 2 6]); +%! assert(a(ia),c); +%! assert(b(ib),c); +%!test +%! a = [1,1,2;1,4,5;2,1,7]; +%! b = [1,4,5;2,3,4;1,1,2;9,8,7]; +%! [c,ia,ib] = intersect(a,b,'rows'); +%! assert(c,[1,1,2;1,4,5]); +%! assert(ia,[1;2]); +%! assert(ib,[3;1]); +%! assert(a(ia,:),c); +%! assert(b(ib,:),c); +%!test +%! a = [1 1 1 2 2 2]; +%! b = [1 2 3 4 5 6]; +%! c = intersect(a,b); +%! assert(c, [1,2]); +%!test +%! a = [1 2 3 4; 5 6 7 8; 9 10 11 12]; +%! [b, ia, ib] = intersect(a, a, "rows"); +%! assert(b, a); +%! assert(ia, [1:3]'); +%! assert(ib, [1:3]'); diff --git a/octave_packages/m/set/ismember.m b/octave_packages/m/set/ismember.m new file mode 100644 index 0000000..c301813 --- /dev/null +++ b/octave_packages/m/set/ismember.m @@ -0,0 +1,209 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{tf} =} ismember (@var{A}, @var{s}) +## @deftypefnx {Function File} {[@var{tf}, @var{S_idx}] =} ismember (@var{A}, @var{s}) +## @deftypefnx {Function File} {[@var{tf}, @var{S_idx}] =} ismember (@var{A}, @var{s}, "rows") +## Return a logical matrix @var{tf} with the same shape as @var{A} which is +## true (1) if @code{A(i,j)} is in @var{s} and false (0) if it is not. If a +## second output argument is requested, the index into @var{s} of each of the +## matching elements is also returned. +## +## @example +## @group +## a = [3, 10, 1]; +## s = [0:9]; +## [tf, s_idx] = ismember (a, s) +## @result{} tf = [1, 0, 1] +## @result{} s_idx = [4, 0, 2] +## @end group +## @end example +## +## The inputs, @var{A} and @var{s}, may also be cell arrays. +## +## @example +## @group +## a = @{'abc'@}; +## s = @{'abc', 'def'@}; +## [tf, s_idx] = ismember (a, s) +## @result{} tf = [1, 0] +## @result{} s_idx = [1, 0] +## @end group +## @end example +## +## With the optional third argument @code{"rows"}, and matrices +## @var{A} and @var{s} with the same number of columns, compare rows in +## @var{A} with the rows in @var{s}. +## +## @example +## @group +## a = [1:3; 5:7; 4:6]; +## s = [0:2; 1:3; 2:4; 3:5; 4:6]; +## [tf, s_idx] = ismember(a, s, "rows") +## @result{} tf = logical ([1; 0; 1]) +## @result{} s_idx = [2; 0; 5]; +## @end group +## @end example +## +## @seealso{unique, union, intersect, setxor, setdiff} +## @end deftypefn + +## Author: Paul Kienzle +## Author: Søren Hauberg +## Author: Ben Abbott +## Adapted-by: jwe +## Reimplemented using lookup & unique: Jaroslav Hajek + +function [tf, a_idx] = ismember (A, s, varargin) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + ## lookup() does not handle logical values + if (islogical (A)) + A = uint8 (A); + endif + if (islogical (s)) + s = uint8 (s); + endif + + [A, s] = validargs ("ismember", A, s, varargin{:}); + + if (nargin == 2) + s = s(:); + ## We do it this way, because we expect the array to be often sorted. + if (issorted (s)) + is = []; + else + [s, is] = sort (s); + endif + + ## sort out NaNs in table + if (isreal (s) && ! isempty (s) && isnan (s(end))) + s = s(1:end - sum (isnan (s))); + endif + + if (nargout > 1) + a_idx = lookup (s, A, "m"); + tf = logical (a_idx); + if (! isempty (is)) + a_idx(tf) = is (a_idx(tf)); + endif + else + tf = lookup (s, A, "b"); + endif + + else + + if (isempty (A) || isempty (s)) + tf = false (rows (A), 1); + a_idx = zeros (rows (A), 1); + else + + ## FIXME: lookup does not support "rows", so we just use unique. + [xx, ii, jj] = unique ([A; s], "rows", "last"); + na = rows (A); + jj = ii(jj(1:na)); + tf = jj > na; + + if (nargout > 1) + a_idx = max (0, jj - na); + endif + + endif + endif + +endfunction + +%!assert (ismember ({''}, {'abc', 'def'}), false); +%!assert (ismember ('abc', {'abc', 'def'}), true); +%!assert (isempty (ismember ([], [1, 2])), true); +%!assert (isempty (ismember ({}, {'a', 'b'})), true); +%!assert (ismember ('', {'abc', 'def'}), false); +%!fail ('ismember ([], {1, 2})'); +%!fail ('ismember ({[]}, {1, 2})'); +%!fail ('ismember ({}, {1, 2})'); +%!fail ('ismember ({1}, {''1'', ''2''})'); +%!fail ('ismember (1, ''abc'')'); +%!fail ('ismember ({''1''}, {''1'', ''2''},''rows'')'); +%!fail ('ismember ([1 2 3], [5 4 3 1], ''rows'')'); +%!assert (ismember ({'foo', 'bar'}, {'foobar'}), logical ([0, 0])); +%!assert (ismember ({'foo'}, {'foobar'}), false); +%!assert (ismember ({'bar'}, {'foobar'}), false); +%!assert (ismember ({'bar'}, {'foobar', 'bar'}), true); +%!assert (ismember ({'foo', 'bar'}, {'foobar', 'bar'}), logical ([0, 1])); +%!assert (ismember ({'xfb', 'f', 'b'}, {'fb', 'b'}), logical ([0, 0, 1])); +%!assert (ismember ("1", "0123456789."), true); + +%!test +%! [result, a_idx] = ismember ([1, 2], []); +%! assert (result, logical ([0, 0])) +%! assert (a_idx, [0, 0]); + +%!test +%! [result, a_idx] = ismember ([], [1, 2]); +%! assert (result, logical ([])) +%! assert (a_idx, []); + +%!test +%! [result, a_idx] = ismember ({'a', 'b'}, ''); +%! assert (result, logical ([0, 0])) +%! assert (a_idx, [0, 0]); + +%!test +%! [result, a_idx] = ismember ({'a', 'b'}, {}); +%! assert (result, logical ([0, 0])) +%! assert (a_idx, [0, 0]); + +%!test +%! [result, a_idx] = ismember ('', {'a', 'b'}); +%! assert (result, false) +%! assert (a_idx, 0); + +%!test +%! [result, a_idx] = ismember ({}, {'a', 'b'}); +%! assert (result, logical ([])) +%! assert (a_idx, []); + +%!test +%! [result, a_idx] = ismember([1 2 3 4 5], [3]); +%! assert (all (result == logical ([0 0 1 0 0])) && all (a_idx == [0 0 1 0 0])); + +%!test +%! [result, a_idx] = ismember([1 6], [1 2 3 4 5 1 6 1]); +%! assert (all (result == logical ([1 1])) && a_idx(2) == 7); + +%!test +%! [result, a_idx] = ismember ([3,10,1], [0,1,2,3,4,5,6,7,8,9]); +%! assert (all (result == logical ([1, 0, 1])) && all (a_idx == [4, 0, 2])); + +%!test +%! [result, a_idx] = ismember ("1.1", "0123456789.1"); +%! assert (all (result == logical ([1, 1, 1])) && all (a_idx == [12, 11, 12])); + +%!test +%! [result, a_idx] = ismember([1:3; 5:7; 4:6], [0:2; 1:3; 2:4; 3:5; 4:6], 'rows'); +%! assert (all (result == logical ([1; 0; 1])) && all (a_idx == [2; 0; 5])); + +%!test +%! [result, a_idx] = ismember([1.1,1.2,1.3; 2.1,2.2,2.3; 10,11,12], [1.1,1.2,1.3; 10,11,12; 2.12,2.22,2.32], 'rows'); +%! assert (all (result == logical ([1; 0; 1])) && all (a_idx == [1; 0; 2])); + diff --git a/octave_packages/m/set/powerset.m b/octave_packages/m/set/powerset.m new file mode 100644 index 0000000..e72395e --- /dev/null +++ b/octave_packages/m/set/powerset.m @@ -0,0 +1,83 @@ +## Copyright (C) 2010-2012 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} powerset (@var{a}) +## @deftypefnx {Function File} {} powerset (@var{a}, "rows") +## +## Return a cell array containing all subsets of the set @var{a}. +## +## @end deftypefn +## @seealso{unique, union, setxor, setdiff, ismember} + +function p = powerset (a, byrows_arg) + + byrows = false; + + if (nargin == 2) + if (! strcmpi (byrows_arg, "rows")) + error ('powerset: expecting third argument to be "rows"'); + elseif (iscell (a)) + warning ('powerset: "rows" not valid for cell arrays'); + else + byrows = true; + endif + elseif (nargin != 1) + print_usage (); + endif + + if (byrows) + a = unique (a, byrows_arg); + n = rows (a); + else + a = unique (a); + n = numel (a); + endif + + if (n == 0) + p = []; + else + if (n > 32) + error ("powerset: not implemented for more than 32 elements"); + endif + + ## Logical rep + b = reshape (bitunpack (uint32 (0:2^n-1)), 32, 2^n)(1:n,:); + ## Convert to indices and lengths. + [i, k] = find (b); + k = sum (b, 1); + + ## Index and split. + if (byrows) + p = mat2cell (a(i,:), k, columns (a)); + else + if (rows (a) == 1) + p = mat2cell (a(i), 1, k); + else + p = mat2cell (a(i), k, 1); + endif + endif + endif + +endfunction + + +%!test +%! c = sort (cellstr ({ [], [1], [2], [3], [1, 2], [1, 3], [2, 3], [1, 2, 3]})); +%! p = sort (cellstr (powerset ([1, 2, 3]))); +%! assert (p, c); diff --git a/octave_packages/m/set/private/validargs.m b/octave_packages/m/set/private/validargs.m new file mode 100644 index 0000000..d6e43b3 --- /dev/null +++ b/octave_packages/m/set/private/validargs.m @@ -0,0 +1,57 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2009-2010 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## Validate arguments for binary set operation. +function [x, y] = validargs (caller, x, y, byrows_arg) + + if (nargin == 3) + icx = iscellstr (x); + icy = iscellstr (y); + if (icx || icy) + if (icx && ischar (y)) + y = cellstr (y); + elseif (icy && ischar (x)) + x = cellstr (x); + elseif (! (icx && icy)) + error ("%s: cell array of strings cannot be combined with a nonstring value", caller); + endif + elseif (! (ismatrix (x) && ismatrix (y))) + error ("%s: input arguments must be arrays or cell arrays of strings", caller); + endif + elseif (nargin == 4) + if (strcmpi (byrows_arg, "rows")) + if (iscell (x) || iscell (y)) + error ('%s: cells not supported with "rows"', caller); + elseif (! (ismatrix (x) && ismatrix (y))) + error ("%s: input arguments must be arrays or cell arrays of strings", caller); + else + if (ndims (x) > 2 || ndims (y) > 2) + error ('%s: need 2-dimensional matrices for "rows"', caller); + elseif (columns (x) != columns (y) && ! (isempty (x) || isempty (y))) + error ("%s: number of columns must match", caller); + endif + endif + else + error ("%s: invalid option: %s", caller, byrows_arg); + endif + else + print_usage (caller); + endif + +endfunction diff --git a/octave_packages/m/set/setdiff.m b/octave_packages/m/set/setdiff.m new file mode 100644 index 0000000..3b0ff36 --- /dev/null +++ b/octave_packages/m/set/setdiff.m @@ -0,0 +1,105 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2008-2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} setdiff (@var{a}, @var{b}) +## @deftypefnx {Function File} {} setdiff (@var{a}, @var{b}, "rows") +## @deftypefnx {Function File} {[@var{c}, @var{i}] =} setdiff (@var{a}, @var{b}) +## Return the elements in @var{a} that are not in @var{b}, sorted in +## ascending order. If @var{a} and @var{b} are both column vectors +## return a column vector, otherwise return a row vector. +## @var{a}, @var{b} may be cell arrays of string(s). +## +## Given the optional third argument @samp{"rows"}, return the rows in +## @var{a} that are not in @var{b}, sorted in ascending order by rows. +## +## If requested, return @var{i} such that @code{c = a(i)}. +## @seealso{unique, union, intersect, setxor, ismember} +## @end deftypefn + +## Author: Paul Kienzle +## Adapted-by: jwe + +function [c, i] = setdiff (a, b, varargin) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + [a, b] = validargs ("setdiff", a, b, varargin{:}); + + if (nargin > 2) + if (nargout > 1) + [c, i] = unique (a, "rows"); + else + c = unique (a, "rows"); + endif + if (! isempty (c) && ! isempty (b)) + ## Form a and b into combined set. + b = unique (b, "rows"); + [dummy, idx] = sortrows ([c; b]); + ## Eliminate those elements of a that are the same as in b. + dups = find (all (dummy(1:end-1,:) == dummy(2:end,:), 2)); + c(idx(dups),:) = []; + if (nargout > 1) + i(idx(dups),:) = []; + endif + endif + else + if (nargout > 1) + [c, i] = unique (a); + else + c = unique (a); + endif + if (! isempty (c) && ! isempty (b)) + ## Form a and b into combined set. + b = unique (b); + [dummy, idx] = sort ([c(:); b(:)]); + ## Eliminate those elements of a that are the same as in b. + if (iscellstr (dummy)) + dups = find (strcmp (dummy(1:end-1), dummy(2:end))); + else + dups = find (dummy(1:end-1) == dummy(2:end)); + endif + c(idx(dups)) = []; + if (nargout > 1) + i(idx(dups)) = []; + endif + ## Reshape if necessary. + if (size (c, 1) != 1 && size (b, 1) == 1) + c = c.'; + endif + endif + endif + +endfunction + +%!assert(setdiff(["bb";"zz";"bb";"zz"],["bb";"cc";"bb"],"rows"), "zz") +%!assert(setdiff(["b";"z";"b";"z"],["b";"c";"b"],"rows"), "z") +%!assert(setdiff(["b";"z";"b";"z"],["b";"c";"b"]), "z") +%!assert(setdiff([1, 1; 2, 2; 3, 3; 4, 4], [1, 1; 2, 2; 4, 4], "rows"), [3 3]) +%!assert(setdiff([1; 2; 3; 4], [1; 2; 4], "rows"), 3) +%!assert(setdiff([1, 2; 3, 4], [1, 2; 3, 6], "rows"), [3, 4]) +%!assert(setdiff({"one","two";"three","four"},{"one","two";"three","six"}), {"four"}) + +%!test +%! a = [3, 1, 4, 1, 5]; b = [1, 2, 3, 4]; +%! [y, i] = setdiff (a, b.'); +%! assert(y, [5]); +%! assert(y, a(i)); diff --git a/octave_packages/m/set/setxor.m b/octave_packages/m/set/setxor.m new file mode 100644 index 0000000..323dd40 --- /dev/null +++ b/octave_packages/m/set/setxor.m @@ -0,0 +1,101 @@ +## Copyright (C) 2008-2012 Jaroslav Hajek +## Copyright (C) 2000, 2006-2007 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by the +## Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} setxor (@var{a}, @var{b}) +## @deftypefnx {Function File} {} setxor (@var{a}, @var{b}, 'rows') +## @deftypefnx {Function File} {[@var{c}, @var{ia}, @var{ib}] =} setxor (@var{a}, @var{b}) +## +## Return the elements exclusive to @var{a} or @var{b}, sorted in ascending +## order. If @var{a} and @var{b} are both column vectors return a column +## vector, otherwise return a row vector. +## @var{a}, @var{b} may be cell arrays of string(s). +## +## With three output arguments, return index vectors @var{ia} and @var{ib} +## such that @code{a(ia)} and @code{b(ib)} are disjoint sets whose union +## is @var{c}. +## +## @seealso{unique, union, intersect, setdiff, ismember} +## @end deftypefn + +function [c, ia, ib] = setxor (a, b, varargin) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + [a, b] = validargs ("setxor", a, b, varargin{:}); + + ## Form A and B into sets. + if (nargout > 1) + [a, ia] = unique (a, varargin{:}); + [b, ib] = unique (b, varargin{:}); + else + a = unique (a, varargin{:}); + b = unique (b, varargin{:}); + endif + + if (isempty (a)) + c = b; + elseif (isempty (b)) + c = a; + else + ## Reject duplicates. + if (nargin > 2) + na = rows (a); nb = rows (b); + [c, i] = sortrows ([a; b]); + n = rows (c); + idx = find (all (c(1:n-1) == c(2:n), 2)); + if (! isempty (idx)) + c([idx, idx+1],:) = []; + i([idx, idx+1],:) = []; + endif + else + na = numel (a); nb = numel (b); + [c, i] = sort ([a(:); b(:)]); + n = length (c); + if (iscell (c)) + idx = find (strcmp (c(1:n-1), c(2:n))); + else + idx = find (c(1:n-1) == c(2:n)); + endif + if (! isempty (idx)) + c([idx, idx+1]) = []; + i([idx, idx+1]) = []; + endif + if (size (a, 1) == 1 || size (b, 1) == 1) + c = c.'; + endif + endif + endif + if (nargout > 1) + ia = ia(i(i <= na)); + ib = ib(i(i > na) - na); + endif + +endfunction + +%!assert(setxor([1,2,3],[2,3,4]),[1,4]) +%!assert(setxor({'a'}, {'a', 'b'}), {'b'}); +%!test +%! a = [3, 1, 4, 1, 5]; b = [1, 2, 3, 4]; +%! [y, ia, ib] = setxor (a, b.'); +%! assert(y, [2, 5]); +%! assert(y, sort([a(ia), b(ib)])); + diff --git a/octave_packages/m/set/union.m b/octave_packages/m/set/union.m new file mode 100644 index 0000000..e62af1b --- /dev/null +++ b/octave_packages/m/set/union.m @@ -0,0 +1,100 @@ +## Copyright (C) 1994-2012 John W. Eaton +## Copyright (C) 2008-2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} union (@var{a}, @var{b}) +## @deftypefnx {Function File} {} union (@var{a}, @var{b}, "rows") +## Return the set of elements that are in either of the sets @var{a} and +## @var{b}. @var{a}, @var{b} may be cell arrays of string(s). +## For example: +## +## @example +## @group +## union ([1, 2, 4], [2, 3, 5]) +## @result{} [1, 2, 3, 4, 5] +## @end group +## @end example +## +## If the optional third input argument is the string "rows" each row of +## the matrices @var{a} and @var{b} will be considered an element of sets. +## For example: +## +## @example +## @group +## union ([1, 2; 2, 3], [1, 2; 3, 4], "rows") +## @result{} 1 2 +## 2 3 +## 3 4 +## @end group +## @end example +## +## @deftypefnx {Function File} {[@var{c}, @var{ia}, @var{ib}] =} union (@var{a}, @var{b}) +## +## Return index vectors @var{ia} and @var{ib} such that @code{a(ia)} and +## @code{b(ib)} are disjoint sets whose union is @var{c}. +## +## @seealso{intersect, setdiff, unique} +## @end deftypefn + +## Author: jwe + +function [y, ia, ib] = union (a, b, varargin) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + [a, b] = validargs ("union", a, b, varargin{:}); + + if (nargin == 2) + y = [a(:); b(:)]; + na = numel (a); nb = numel (b); + if (size (a, 1) == 1 || size (b, 1) == 1) + y = y.'; + endif + else + y = [a; b]; + na = rows (a); nb = rows (b); + endif + + if (nargout == 1) + y = unique (y, varargin{:}); + else + [y, i] = unique (y, varargin{:}); + ia = i(i <= na); + ib = i(i > na) - na; + endif + +endfunction + +%!assert(all (all (union ([1, 2, 4], [2, 3, 5]) == [1, 2, 3, 4, 5]))); + +%!assert(all (all (union ([1; 2; 4], [2, 3, 5]) == [1, 2, 3, 4, 5]))); + +%!assert(all (all (union ([1, 2, 3], [5; 7; 9]) == [1, 2, 3, 5, 7, 9]))); + +%!error union (1); + +%!error union (1, 2, 3); + +%!test +%! a = [3, 1, 4, 1, 5]; b = [1, 2, 3, 4]; +%! [y, ia, ib] = union (a, b.'); +%! assert(y, [1, 2, 3, 4, 5]); +%! assert(y, sort([a(ia), b(ib)])); diff --git a/octave_packages/m/set/unique.m b/octave_packages/m/set/unique.m new file mode 100644 index 0000000..1f6b866 --- /dev/null +++ b/octave_packages/m/set/unique.m @@ -0,0 +1,214 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2008-2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unique (@var{x}) +## @deftypefnx {Function File} {} unique (@var{x}, "rows") +## @deftypefnx {Function File} {} unique (@dots{}, "first") +## @deftypefnx {Function File} {} unique (@dots{}, "last") +## @deftypefnx {Function File} {[@var{y}, @var{i}, @var{j}] =} unique (@dots{}) +## Return the unique elements of @var{x}, sorted in ascending order. +## If the input @var{x} is a vector then the output is also a vector with the +## same orientation (row or column) as the input. For a matrix input the +## output is always a column vector. @var{x} may also be a cell array of +## strings. +## +## If the optional argument @code{"rows"} is supplied, return the unique +## rows of @var{x}, sorted in ascending order. +## +## If requested, return index vectors @var{i} and @var{j} such that +## @code{x(i)==y} and @code{y(j)==x}. +## +## Additionally, if @var{i} is a requested output then one of @code{"first"} or +## @code{"last"} may be given as an input. If @code{"last"} is specified, +## return the highest possible indices in @var{i}, otherwise, if @code{"first"} +## is specified, return the lowest. The default is @code{"last"}. +## @seealso{union, intersect, setdiff, setxor, ismember} +## @end deftypefn + +function [y, i, j] = unique (x, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin > 1) + ## parse options + if (iscellstr (varargin)) + varargin = unique (varargin); + optfirst = strmatch ("first", varargin, "exact") > 0; + optlast = strmatch ("last", varargin, "exact") > 0; + optrows = strmatch ("rows", varargin, "exact") > 0; + if (optfirst && optlast) + error ('unique: cannot specify both "last" and "first"'); + elseif (optfirst + optlast + optrows != nargin-1) + error ("unique: invalid option"); + endif + else + error ("unique: options must be strings"); + endif + + if (optrows && iscell (x)) + warning ('unique: "rows" is ignored for cell arrays'); + optrows = false; + endif + else + optfirst = false; + optrows = false; + endif + + ## FIXME -- the operations + ## + ## match = (y(1:n-1) == y(2:n)); + ## y(idx) = []; + ## + ## are very slow on sparse matrices. Until they are fixed to be as + ## fast as for full matrices, operate on the nonzero elements of the + ## sparse array as long as we are not operating on rows. + + if (issparse (x) && ! optrows && nargout <= 1) + if (nnz (x) < numel (x)) + y = unique ([0; (full (nonzeros (x)))], varargin{:}); + else + ## Corner case where sparse matrix is actually full + y = unique (full (x), varargin{:}); + endif + return; + endif + + if (optrows) + n = rows (x); + dim = 1; + else + n = numel (x); + dim = (rows (x) == 1) + 1; + endif + + y = x; + ## Special cases 0 and 1 + if (n == 0) + if (! optrows && isempty (x) && any (size (x))) + if (iscell (y)) + y = cell (0, 1); + else + y = zeros (0, 1, class (y)); + endif + endif + i = j = []; + return; + elseif (n == 1) + i = j = 1; + return; + endif + + if (optrows) + if (nargout > 1) + [y, i] = sortrows (y); + else + y = sortrows (y); + endif + match = all (y(1:n-1,:) == y(2:n,:), 2); + idx = find (match); + y(idx,:) = []; + else + if (! isvector (y)) + y = y(:); + endif + if (nargout > 1) + [y, i] = sort (y); + else + y = sort (y); + endif + if (iscell (y)) + match = strcmp (y(1:n-1), y(2:n)); + else + match = (y(1:n-1) == y(2:n)); + endif + idx = find (match); + y(idx) = []; + endif + + if (isargout (3)) + j = i; + if (dim == 1) + j(i) = cumsum ([1; !match]); + else + j(i) = cumsum ([1, !match]); + endif + endif + + if (isargout (2)) + if (optfirst) + i(idx+1) = []; + else + i(idx) = []; + endif + endif + +endfunction + +%!assert(unique([1 1 2; 1 2 1; 1 1 2]),[1;2]) +%!assert(unique([1 1 2; 1 0 1; 1 1 2],'rows'),[1 0 1; 1 1 2]) +%!assert(unique([]),[]) +%!assert(unique([1]),[1]) +%!assert(unique([1 2]),[1 2]) +%!assert(unique([1;2]),[1;2]) +%!assert(unique([1,NaN,Inf,NaN,Inf]),[1,Inf,NaN,NaN]) +%!assert(unique({'Foo','Bar','Foo'}),{'Bar','Foo'}) +%!assert(unique({'Foo','Bar','FooBar'}'),{'Bar','Foo','FooBar'}') +%!assert(unique(zeros(1,0)), zeros(0,1)) +%!assert(unique(zeros(1,0), 'rows'), zeros(1,0)) +%!assert(unique(cell(1,0)), cell(0,1)) +%!assert(unique({}), {}) +%!assert(unique([1,2,2,3,2,4], 'rows'), [1,2,2,3,2,4]) +%!assert(unique([1,2,2,3,2,4]), [1,2,3,4]) +%!assert(unique([1,2,2,3,2,4]', 'rows'), [1,2,3,4]') +%!assert(unique(sparse([2,0;2,0])), [0,2]') +%!assert(unique(sparse([1,2;2,3])), [1,2,3]') +%!assert(unique([1,2,2,3,2,4]', 'rows'), [1,2,3,4]') +%!assert(unique(single([1,2,2,3,2,4]), 'rows'), single([1,2,2,3,2,4])) +%!assert(unique(single([1,2,2,3,2,4])), single([1,2,3,4])) +%!assert(unique(single([1,2,2,3,2,4]'), 'rows'), single([1,2,3,4]')) +%!assert(unique(uint8([1,2,2,3,2,4]), 'rows'), uint8([1,2,2,3,2,4])) +%!assert(unique(uint8([1,2,2,3,2,4])), uint8([1,2,3,4])) +%!assert(unique(uint8([1,2,2,3,2,4]'), 'rows'), uint8([1,2,3,4]')) +%!test +%! [a,i,j] = unique([1,1,2,3,3,3,4]); +%! assert(a,[1,2,3,4]) +%! assert(i,[2,3,6,7]) +%! assert(j,[1,1,2,3,3,3,4]) +%! +%!test +%! [a,i,j] = unique([1,1,2,3,3,3,4]','first'); +%! assert(a,[1,2,3,4]') +%! assert(i,[1,3,4,7]') +%! assert(j,[1,1,2,3,3,3,4]') +%! +%!test +%! [a,i,j] = unique({'z'; 'z'; 'z'}); +%! assert(a,{'z'}) +%! assert(i,[3]') +%! assert(j,[1,1,1]') +%! +%!test +%! A=[1,2,3;1,2,3]; +%! [a,i,j] = unique(A,'rows'); +%! assert(a,[1,2,3]) +%! assert(A(i,:),a) +%! assert(a(j,:),A) diff --git a/octave_packages/m/signal/arch_fit.m b/octave_packages/m/signal/arch_fit.m new file mode 100644 index 0000000..0e75b25 --- /dev/null +++ b/octave_packages/m/signal/arch_fit.m @@ -0,0 +1,118 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{a}, @var{b}] =} arch_fit (@var{y}, @var{x}, @var{p}, @var{iter}, @var{gamma}, @var{a0}, @var{b0}) +## Fit an ARCH regression model to the time series @var{y} using the +## scoring algorithm in Engle's original ARCH paper. The model is +## +## @example +## @group +## y(t) = b(1) * x(t,1) + @dots{} + b(k) * x(t,k) + e(t), +## h(t) = a(1) + a(2) * e(t-1)^2 + @dots{} + a(p+1) * e(t-p)^2 +## @end group +## @end example +## +## @noindent +## in which @math{e(t)} is @math{N(0, h(t))}, given a time-series vector +## @var{y} up to time @math{t-1} and a matrix of (ordinary) regressors +## @var{x} up to @math{t}. The order of the regression of the residual +## variance is specified by @var{p}. +## +## If invoked as @code{arch_fit (@var{y}, @var{k}, @var{p})} with a +## positive integer @var{k}, fit an ARCH(@var{k}, @var{p}) process, +## i.e., do the above with the @math{t}-th row of @var{x} given by +## +## @example +## [1, y(t-1), @dots{}, y(t-k)] +## @end example +## +## Optionally, one can specify the number of iterations @var{iter}, the +## updating factor @var{gamma}, and initial values @math{a0} and +## @math{b0} for the scoring algorithm. +## @end deftypefn + +## Author: KH +## Description: Fit an ARCH regression model + +function [a, b] = arch_fit (y, x, p, iter, gamma, a0, b0) + + if ((nargin < 3) || (nargin == 6) || (nargin > 7)) + print_usage (); + endif + + if (! (isvector (y))) + error ("arch_fit: Y must be a vector"); + endif + + T = length (y); + y = reshape (y, T, 1); + [rx, cx] = size (x); + if ((rx == 1) && (cx == 1)) + x = autoreg_matrix (y, x); + elseif (! (rx == T)) + error ("arch_fit: either rows (X) == length (Y), or X is a scalar"); + endif + + [T, k] = size (x); + + if (nargin == 7) + a = a0; + b = b0; + e = y - x * b; + else + [b, v_b, e] = ols (y, x); + a = [v_b, (zeros (1, p))]'; + if (nargin < 5) + gamma = 0.1; + if (nargin < 4) + iter = 50; + endif + endif + endif + + esq = e.^2; + Z = autoreg_matrix (esq, p); + + for i = 1 : iter; + h = Z * a; + tmp = esq ./ h.^2 - 1 ./ h; + s = 1 ./ h(1:T-p); + for j = 1 : p; + s = s - a(j+1) * tmp(j+1:T-p+j); + endfor + r = 1 ./ h(1:T-p); + for j = 1:p; + r = r + 2 * h(j+1:T-p+j).^2 .* esq(1:T-p); + endfor + r = sqrt (r); + X_tilde = x(1:T-p, :) .* (r * ones (1,k)); + e_tilde = e(1:T-p) .*s ./ r; + delta_b = inv (X_tilde' * X_tilde) * X_tilde' * e_tilde; + b = b + gamma * delta_b; + e = y - x * b; + esq = e .^ 2; + Z = autoreg_matrix (esq, p); + h = Z * a; + f = esq ./ h - ones(T,1); + Z_tilde = Z ./ (h * ones (1, p+1)); + delta_a = inv (Z_tilde' * Z_tilde) * Z_tilde' * f; + a = a + gamma * delta_a; + endfor + +endfunction diff --git a/octave_packages/m/signal/arch_rnd.m b/octave_packages/m/signal/arch_rnd.m new file mode 100644 index 0000000..20a609b --- /dev/null +++ b/octave_packages/m/signal/arch_rnd.m @@ -0,0 +1,102 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} arch_rnd (@var{a}, @var{b}, @var{t}) +## Simulate an ARCH sequence of length @var{t} with AR +## coefficients @var{b} and CH coefficients @var{a}. I.e., the result +## @math{y(t)} follows the model +## @c Set example in small font to prevent overfull line +## +## @smallexample +## y(t) = b(1) + b(2) * y(t-1) + @dots{} + b(lb) * y(t-lb+1) + e(t), +## @end smallexample +## +## @noindent +## where @math{e(t)}, given @var{y} up to time @math{t-1}, is +## @math{N(0, h(t))}, with +## @c Set example in small font to prevent overfull line +## +## @smallexample +## h(t) = a(1) + a(2) * e(t-1)^2 + @dots{} + a(la) * e(t-la+1)^2 +## @end smallexample +## @end deftypefn + +## Author: KH +## Description: Simulate an ARCH process + +function y = arch_rnd (a, b, t) + + if (nargin != 3) + print_usage (); + endif + + if (! ((min (size (a)) == 1) && (min (size (b)) == 1))) + error ("arch_rnd: A and B must both be scalars or vectors"); + endif + if (! (isscalar (t) && (t > 0) && (rem (t, 1) == 0))) + error ("arch_rnd: T must be a positive integer"); + endif + + if (! (a(1) > 0)) + error ("arch_rnd: A(1) must be positive"); + endif + ## perhaps add a test for the roots of a(z) here ... + + la = length (a); + a = reshape (a, 1, la); + if (la == 1) + a = [a, 0]; + la = la + 1; + endif + + lb = length (b); + b = reshape (b, 1, lb); + if (lb == 1) + b = [b, 0]; + lb = lb + 1; + endif + m = max([la, lb]); + + e = zeros (t, 1); + h = zeros (t, 1); + y = zeros (t, 1); + + h(1) = a(1); + e(1) = sqrt (h(1)) * randn; + y(1) = b(1) + e(1); + + for t = 2:m + ta = min ([t, la]); + h(t) = a(1) + a(2:ta) * e(t-ta+1:t-1).^2; + e(t) = sqrt (h(t)) * randn; + tb = min ([t, lb]); + y(t) = b(1) + b(2:tb) * y(t-tb+1:t-1) + e(t); + endfor + + if (t > m) + for t = m+1:t + h(t) = a(1) + a(2:la) * e(t-la+1:t-1).^2; + e(t) = sqrt (h(t)) * randn; + y(t) = b(1) + b(2:lb) * y(t-tb+1:t-1) + e(t); + endfor + endif + + y = y(1:t); + +endfunction diff --git a/octave_packages/m/signal/arch_test.m b/octave_packages/m/signal/arch_test.m new file mode 100644 index 0000000..a744296 --- /dev/null +++ b/octave_packages/m/signal/arch_test.m @@ -0,0 +1,96 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{lm}] =} arch_test (@var{y}, @var{x}, @var{p}) +## For a linear regression model +## +## @example +## y = x * b + e +## @end example +## +## @noindent +## perform a Lagrange Multiplier (LM) test of the null hypothesis of no +## conditional heteroscedascity against the alternative of CH(@var{p}). +## +## I.e., the model is +## +## @example +## y(t) = b(1) * x(t,1) + @dots{} + b(k) * x(t,k) + e(t), +## @end example +## +## @noindent +## given @var{y} up to @math{t-1} and @var{x} up to @math{t}, +## @math{e}(t) is @math{N(0, h(t))} with +## +## @example +## h(t) = v + a(1) * e(t-1)^2 + @dots{} + a(p) * e(t-p)^2, +## @end example +## +## @noindent +## and the null is @math{a(1)} == @dots{} == @math{a(p)} == 0. +## +## If the second argument is a scalar integer, @math{k}, perform the same +## test in a linear autoregression model of order @math{k}, i.e., with +## +## @example +## [1, y(t-1), @dots{}, y(t-@var{k})] +## @end example +## +## @noindent +## as the @math{t}-th row of @var{x}. +## +## Under the null, LM approximately has a chisquare distribution with +## @var{p} degrees of freedom and @var{pval} is the @math{p}-value (1 +## minus the CDF of this distribution at LM) of the test. +## +## If no output argument is given, the @math{p}-value is displayed. +## @end deftypefn + +## Author: KH +## Description: Test for conditional heteroscedascity + +function [pval, lm] = arch_test (y, x, p) + + if (nargin != 3) + error ("arch_test: 3 input arguments required"); + endif + + if (! (isvector (y))) + error ("arch_test: Y must be a vector"); + endif + T = length (y); + y = reshape (y, T, 1); + [rx, cx] = size (x); + if ((rx == 1) && (cx == 1)) + x = autoreg_matrix (y, x); + elseif (! (rx == T)) + error ("arch_test: either rows(X) == length(Y), or X is a scalar"); + endif + if (! (isscalar(p) && (rem(p, 1) == 0) && (p > 0))) + error ("arch_test: P must be a positive integer"); + endif + + [b, v_b, e] = ols (y, x); + Z = autoreg_matrix (e.^2, p); + f = e.^2 / v_b - ones (T, 1); + f = Z' * f; + lm = f' * inv (Z'*Z) * f / 2; + pval = 1 - chi2cdf (lm, p); + +endfunction diff --git a/octave_packages/m/signal/arma_rnd.m b/octave_packages/m/signal/arma_rnd.m new file mode 100644 index 0000000..df921ad --- /dev/null +++ b/octave_packages/m/signal/arma_rnd.m @@ -0,0 +1,81 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} arma_rnd (@var{a}, @var{b}, @var{v}, @var{t}, @var{n}) +## Return a simulation of the ARMA model +## +## @example +## @group +## x(n) = a(1) * x(n-1) + @dots{} + a(k) * x(n-k) +## + e(n) + b(1) * e(n-1) + @dots{} + b(l) * e(n-l) +## @end group +## @end example +## +## @noindent +## in which @var{k} is the length of vector @var{a}, @var{l} is the +## length of vector @var{b} and @var{e} is Gaussian white noise with +## variance @var{v}. The function returns a vector of length @var{t}. +## +## The optional parameter @var{n} gives the number of dummy +## @var{x}(@var{i}) used for initialization, i.e., a sequence of length +## @var{t}+@var{n} is generated and @var{x}(@var{n}+1:@var{t}+@var{n}) +## is returned. If @var{n} is omitted, @var{n} = 100 is used. +## @end deftypefn + +## Author: FL +## Description: Simulate an ARMA process + +function x = arma_rnd (a, b, v, t, n) + + if (nargin == 4) + n = 100; + elseif (nargin == 5) + if (!isscalar (n)) + error ("arma_rnd: N must be a scalar"); + endif + else + print_usage (); + endif + + if ((min (size (a)) > 1) || (min (size (b)) > 1)) + error ("arma_rnd: A and B must not be matrices"); + endif + + if (!isscalar (t)) + error ("arma_rnd: T must be a scalar"); + endif + + ar = length (a); + br = length (b); + + a = reshape (a, ar, 1); + b = reshape (b, br, 1); + + ## Apply our notational convention. + a = [1; -a]; + b = [1; b]; + + n = min (n, ar + br); + + e = sqrt (v) * randn (t + n, 1); + + x = filter (b, a, e); + x = x(n + 1 : t + n); + +endfunction diff --git a/octave_packages/m/signal/autoreg_matrix.m b/octave_packages/m/signal/autoreg_matrix.m new file mode 100644 index 0000000..d03a1bd --- /dev/null +++ b/octave_packages/m/signal/autoreg_matrix.m @@ -0,0 +1,62 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} autoreg_matrix (@var{y}, @var{k}) +## Given a time series (vector) @var{y}, return a matrix with ones in the +## first column and the first @var{k} lagged values of @var{y} in the +## other columns. I.e., for @var{t} > @var{k}, @code{[1, +## @var{y}(@var{t}-1), @dots{}, @var{y}(@var{t}-@var{k})]} is the t-th row +## of the result. The resulting matrix may be used as a regressor matrix +## in autoregressions. +## @end deftypefn + +## Author: KH +## Description: Design matrix for autoregressions + +function X = autoreg_matrix (y, k) + + if (nargin != 2) + print_usage (); + endif + + if (! (isvector (y))) + error ("autoreg_matrix: Y must be a vector"); + endif + + T = length (y); + y = reshape (y, T, 1); + X = ones (T, k+1); + for j = 1 : k; + X(:, j+1) = [(zeros (j, 1)); y(1:T-j)]; + endfor + +endfunction + + +%!test +%! K=4; +%! A = zeros(1,K+1); +%! A(1) = 1; +%! B = eye(K+1); +%! B(:,1) = 1; +%! assert (autoreg_matrix(A,K),B); + +%!error autoreg_matrix() +%!error autoreg_matrix(1) +%!error autoreg_matrix(ones(4,1),5) diff --git a/octave_packages/m/signal/bartlett.m b/octave_packages/m/signal/bartlett.m new file mode 100644 index 0000000..38e1382 --- /dev/null +++ b/octave_packages/m/signal/bartlett.m @@ -0,0 +1,63 @@ +## Copyright (C) 1995-2012 Andreas Weingessel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} bartlett (@var{m}) +## Return the filter coefficients of a Bartlett (triangular) window of +## length @var{m}. +## +## For a definition of the Bartlett window, see e.g., A. V. Oppenheim & +## R. W. Schafer, @cite{Discrete-Time Signal Processing}. +## @end deftypefn + +## Author: AW +## Description: Coefficients of the Bartlett (triangular) window + +function c = bartlett (m) + + if (nargin != 1) + print_usage (); + endif + + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) + error ("bartlett: M has to be an integer > 0"); + endif + + if (m == 1) + c = 1; + else + m = m - 1; + n = fix (m / 2); + c = [2*(0:n)/m, 2-2*(n+1:m)/m]'; + endif + +endfunction + +%!assert (bartlett (1), 1); +%!assert (bartlett (2), zeros (2,1)); +%!assert (bartlett (16), fliplr (bartlett (16))); +%!assert (bartlett (15), fliplr (bartlett (15))); +%!test +%! N = 9; +%! A = bartlett (N); +%! assert (A (ceil (N/2)), 1); + +%!error bartlett (); +%!error bartlett (0.5); +%!error bartlett (-1); +%!error bartlett (ones(1,4)); diff --git a/octave_packages/m/signal/blackman.m b/octave_packages/m/signal/blackman.m new file mode 100644 index 0000000..7339519 --- /dev/null +++ b/octave_packages/m/signal/blackman.m @@ -0,0 +1,63 @@ +## Copyright (C) 1995-2012 Andreas Weingessel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} blackman (@var{m}) +## Return the filter coefficients of a Blackman window of length @var{m}. +## +## For a definition of the Blackman window, see e.g., A. V. Oppenheim & +## R. W. Schafer, @cite{Discrete-Time Signal Processing}. +## @end deftypefn + +## Author: AW +## Description: Coefficients of the Blackman window + +function c = blackman (m) + + if (nargin != 1) + print_usage (); + endif + + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) + error ("blackman: M has to be an integer > 0"); + endif + + if (m == 1) + c = 1; + else + m = m - 1; + k = (0 : m)' / m; + c = 0.42 - 0.5 * cos (2 * pi * k) + 0.08 * cos (4 * pi * k); + endif + +endfunction + +%!assert (blackman (1), 1); +%!assert (blackman (2), zeros(2,1), 1e-6); +%!assert (blackman (16), fliplr (blackman (16))); +%!assert (blackman (15), fliplr (blackman (15))); +%!test +%! N = 9; +%! A = blackman (N); +%! assert (A (ceil (N/2)), 1, 1e-6); +%! assert ([A(1), A(length (A))], zeros (1, 2), 1e-6); + +%!error blackman (); +%!error blackman (0.5); +%!error blackman (-1); +%!error blackman (ones(1,4)); diff --git a/octave_packages/m/signal/detrend.m b/octave_packages/m/signal/detrend.m new file mode 100644 index 0000000..50ac4c4 --- /dev/null +++ b/octave_packages/m/signal/detrend.m @@ -0,0 +1,89 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} detrend (@var{x}, @var{p}) +## If @var{x} is a vector, @code{detrend (@var{x}, @var{p})} removes the +## best fit of a polynomial of order @var{p} from the data @var{x}. +## +## If @var{x} is a matrix, @code{detrend (@var{x}, @var{p})} does the same +## for each column in @var{x}. +## +## The second argument is optional. If it is not specified, a value of 1 +## is assumed. This corresponds to removing a linear trend. +## +## The order of the polynomial can also be given as a string, in which case +## @var{p} must be either @t{"constant"} (corresponds to @code{@var{p}=0}) or +## @t{"linear"} (corresponds to @code{@var{p}=1}). +## @seealso{polyfit} +## @end deftypefn + +## Author: KH +## Created: 11 October 1994 +## Adapted-By: jwe + +function y = detrend (x, p = 1) + ## Check input + if (nargin > 0 && isreal (x) && ndims (x) <= 2) + ## Check p + if (ischar (p) && strcmpi (p, "constant")) + p = 0; + elseif (ischar (p) && strcmpi (p, "linear")) + p = 1; + elseif (!isscalar (p) || p < 0 || p != fix (p)) + error ("detrend: second input argument must be 'constant', 'linear' or a positive integer"); + endif + else + error ("detrend: first input argument must be a real vector or matrix"); + endif + + [m, n] = size (x); + if (m == 1) + x = x'; + endif + + r = rows (x); + b = ((1 : r)' * ones (1, p + 1)) .^ (ones (r, 1) * (0 : p)); + y = x - b * (b \ x); + + if (m == 1) + y = y'; + endif + +endfunction + +%!test +%! N=32; +%! x = (0:1:N-1)/N + 2; +%! y = detrend(x); +%! assert(all (all (abs (y) < 20*eps))); + +%!test +%! N=32; +%! t = (0:1:N-1)/N; +%! x = t .* t + 2; +%! y = detrend(x,2); +%! assert(all (all (abs (y) < 30*eps))); + +%!test +%! N=32; +%! t = (0:1:N-1)/N; +%! x = [t;4*t-3]'; +%! y = detrend(x); +%! assert(all (all (abs (y) < 20*eps))); + diff --git a/octave_packages/m/signal/diffpara.m b/octave_packages/m/signal/diffpara.m new file mode 100644 index 0000000..ea939f5 --- /dev/null +++ b/octave_packages/m/signal/diffpara.m @@ -0,0 +1,88 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{d}, @var{dd}] =} diffpara (@var{x}, @var{a}, @var{b}) +## Return the estimator @var{d} for the differencing parameter of an +## integrated time series. +## +## The frequencies from @math{[2*pi*a/t, 2*pi*b/T]} are used for the +## estimation. If @var{b} is omitted, the interval +## @math{[2*pi/T, 2*pi*a/T]} is used. If both @var{b} and @var{a} are +## omitted then @math{a = 0.5 * sqrt (T)} and @math{b = 1.5 * sqrt (T)} +## is used, where @math{T} is the sample size. If @var{x} is a matrix, +## the differencing parameter of each column is estimated. +## +## The estimators for all frequencies in the intervals +## described above is returned in @var{dd}. The value of @var{d} is +## simply the mean of @var{dd}. +## +## Reference: P.J. Brockwell & R.A. Davis. @cite{Time Series: +## Theory and Methods}. Springer 1987. +## @end deftypefn + +## Author: FL +## Description: Estimate the fractional differencing parameter + +function [d, dd] = diffpara (x, a, b) + + if ((nargin < 1) || (nargin > 3)) + print_usage (); + else + if (isvector (x)) + n = length (x); + k = 1; + x = reshape (x, n, 1); + else + [n, k] = size(x); + endif + if (nargin == 1) + a = 0.5 * sqrt (n); + b = 1.5 * sqrt (n); + elseif (nargin == 2) + b = a; + a = 1; + endif + endif + + if (! (isscalar (a) && isscalar (b))) + error ("diffpara: A and B must be scalars"); + endif + + dd = zeros (b - a + 1, k); + + for l = 1:k + + w = 2 * pi * (1 : n-1) / n; + + x = 2 * log (abs (1 - exp (-i*w))); + y = log (periodogram (x(2:n,l))); + + x = center (x); + y = center (y); + + for m = a:b + dd(m-a+1) = - x(1:m) * y(1:m) / sumsq (x(1:m)); + endfor + + endfor + + d = mean (dd); + +endfunction + diff --git a/octave_packages/m/signal/durbinlevinson.m b/octave_packages/m/signal/durbinlevinson.m new file mode 100644 index 0000000..e06a3b6 --- /dev/null +++ b/octave_packages/m/signal/durbinlevinson.m @@ -0,0 +1,93 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} durbinlevinson (@var{c}, @var{oldphi}, @var{oldv}) +## Perform one step of the Durbin-Levinson algorithm. +## +## The vector @var{c} specifies the autocovariances @code{[gamma_0, @dots{}, +## gamma_t]} from lag 0 to @var{t}, @var{oldphi} specifies the +## coefficients based on @var{c}(@var{t}-1) and @var{oldv} specifies the +## corresponding error. +## +## If @var{oldphi} and @var{oldv} are omitted, all steps from 1 to +## @var{t} of the algorithm are performed. +## @end deftypefn + +## Author: FL +## Description: Perform one step of the Durbin-Levinson algorithm + +function [newphi, newv] = durbinlevinson (c, oldphi, oldv) + + if (! ((nargin == 1) || (nargin == 3))) + print_usage (); + endif + + if (columns (c) > 1) + c = c'; + endif + + newphi = 0; + newv = 0; + + if (nargin == 3) + + t = length (oldphi) + 1; + + if (length (c) < t+1) + error ("durbinlevinson: C too small"); + endif + + if (oldv == 0) + error ("durbinlevinson: OLDV = 0"); + endif + + if (rows (oldphi) > 1) + oldphi = oldphi'; + endif + + newphi = zeros (1, t); + newphi(1) = (c(t+1) - oldphi * c(2:t)) / oldv; + for i = 2 : t + newphi(i) = oldphi(i-1) - newphi(1) * oldphi(t-i+1); + endfor + newv = (1 - newphi(1)^2) * oldv; + + elseif(nargin == 1) + + tt = length (c)-1; + oldphi = c(2) / c(1); + oldv = (1 - oldphi^2) * c(1); + + for t = 2 : tt + + newphi = zeros (1, t); + newphi(1) = (c(t+1) - oldphi * c(2:t)) / oldv; + for i = 2 : t + newphi(i) = oldphi(i-1) - newphi(1) * oldphi(t-i+1); + endfor + newv = (1 - newphi(1)^2) * oldv; + + oldv = newv; + oldphi = newphi; + + endfor + + endif + +endfunction diff --git a/octave_packages/m/signal/fftconv.m b/octave_packages/m/signal/fftconv.m new file mode 100644 index 0000000..8f2d8d1 --- /dev/null +++ b/octave_packages/m/signal/fftconv.m @@ -0,0 +1,106 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fftconv (@var{x}, @var{y}) +## @deftypefnx {Function File} {} fftconv (@var{x}, @var{y}, @var{n}) +## Convolve two vectors using the FFT for computation. +## +## @code{c = fftconv (@var{x}, @var{y})} returns a vector of length equal to +## @code{length (@var{x}) + length (@var{y}) - 1}. +## If @var{x} and @var{y} are the coefficient vectors of two polynomials, the +## returned value is the coefficient vector of the product polynomial. +## +## The computation uses the FFT by calling the function @code{fftfilt}. If +## the optional argument @var{n} is specified, an N-point FFT is used. +## @seealso{deconv, conv, conv2} +## @end deftypefn + +## Author: KH +## Created: 3 September 1994 +## Adapted-By: jwe + +function c = fftconv (x, y, n) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (! (isvector (x) && isvector (y))) + error ("fftconv: both A and B must be vectors"); + endif + la = length (x); + lb = length (y); + if ((la == 1) || (lb == 1)) + c = x * y; + else + lc = la + lb - 1; + x(lc) = 0; + y(lc) = 0; + if (nargin == 2) + c = fftfilt (x, y); + else + if (! isscalar (n)) + error ("fftconv: N must be a scalar"); + endif + c = fftfilt (x, y, n); + endif + endif + +endfunction + + +%% FIXME: Borrow tests from conv.m. May need a tolerance on the assert comparison +%!test +%! x = ones(3,1); +%! y = ones(1,3); +%! b = 2; +%! c = 3; +%! assert (fftconv (x, x), [1; 2; 3; 2; 1], 5*eps); +%! assert (fftconv (y, y), [1, 2, 3, 2, 1], 5*eps); +%! assert (fftconv (x, y), [1, 2, 3, 2, 1], 5*eps); +%! assert (fftconv (y, x), [1; 2; 3; 2; 1], 5*eps); +%! assert (fftconv (c, x), [3; 3; 3], 5*eps); +%! assert (fftconv (c, y), [3, 3, 3], 5*eps); +%! assert (fftconv (x, c), [3; 3; 3], 5*eps); +%! assert (fftconv (y, c), [3, 3, 3], 5*eps); +%! assert (fftconv (b, c), 6, 5*eps); + +%!test +%! a = 1:10; +%! b = 1:3; +%! assert (size(conv(a,b)), [1, numel(a)+numel(b)-1]) +%! assert (size(conv(b,a)), [1, numel(a)+numel(b)-1]) + +%! a = (1:10).'; +%! b = 1:3; +%! assert (size(conv(a,b)), [numel(a)+numel(b)-1, 1]) +%! assert (size(conv(b,a)), [numel(a)+numel(b)-1, 1]) + +%!test +%! a = 1:10; +%! b = (1:3).'; +%! assert (size(conv(a,b)), [1, numel(a)+numel(b)-1]) +%! assert (size(conv(b,a)), [1, numel(a)+numel(b)-1]) + +%% Test input validation +%!error fftconv (1); +%!error fftconv (1,2,3,4); +%!error fftconv ([1, 2; 3, 4], 3); +%!error fftconv (2, []); +%!error fftconv ([1,1], [2,2] , [3, 4]); diff --git a/octave_packages/m/signal/fftfilt.m b/octave_packages/m/signal/fftfilt.m new file mode 100644 index 0000000..e2dda08 --- /dev/null +++ b/octave_packages/m/signal/fftfilt.m @@ -0,0 +1,151 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fftfilt (@var{b}, @var{x}, @var{n}) +## +## With two arguments, @code{fftfilt} filters @var{x} with the FIR filter +## @var{b} using the FFT. +## +## Given the optional third argument, @var{n}, @code{fftfilt} uses the +## overlap-add method to filter @var{x} with @var{b} using an N-point FFT. +## +## If @var{x} is a matrix, filter each column of the matrix. +## @seealso{filter, filter2} +## @end deftypefn + +## Author: Kurt Hornik +## Created: 3 September 1994 +## Adapted-By: jwe + +function y = fftfilt (b, x, n) + + ## If N is not specified explicitly, we do not use the overlap-add + ## method at all because loops are really slow. Otherwise, we only + ## ensure that the number of points in the FFT is the smallest power + ## of two larger than N and length(b). This could result in length + ## one blocks, but if the user knows better ... + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + transpose = (rows (x) == 1); + + if (transpose) + x = x.'; + endif + + [r_x, c_x] = size (x); + [r_b, c_b] = size (b); + + if (! isvector (b)) + error ("fftfilt: B must be a vector"); + endif + + if (ndims (x) != 2) + error ("fftfilt: X must be a 1-D or 2-D array"); + endif + + l_b = r_b * c_b; + b = reshape (b, l_b, 1); + + if (nargin == 2) + ## Use FFT with the smallest power of 2 which is >= length (x) + + ## length (b) - 1 as number of points ... + n = 2 ^ nextpow2 (r_x + l_b - 1); + B = fft (b, n); + y = ifft (fft (x, n) .* B(:, ones (1, c_x))); + else + ## Use overlap-add method ... + if (! (isscalar (n))) + error ("fftfilt: N has to be a scalar"); + endif + n = 2 ^ nextpow2 (max ([n, l_b])); + L = n - l_b + 1; + B = fft (b, n); + B = B(:, ones (c_x,1)); + R = ceil (r_x / L); + y = zeros (r_x, c_x); + for r = 1:R; + lo = (r - 1) * L + 1; + hi = min (r * L, r_x); + tmp = zeros (n, c_x); + tmp(1:(hi-lo+1),:) = x(lo:hi,:); + tmp = ifft (fft (tmp) .* B); + hi = min (lo+n-1, r_x); + y(lo:hi,:) = y(lo:hi,:) + tmp(1:(hi-lo+1),:); + endfor + endif + + y = y(1:r_x, :); + if (transpose) + y = y.'; + endif + + ## Final cleanups: If both x and b are real, y should be real. + ## If both x and b are integer, y should be integer. + + if (isreal (b) && isreal (x)) + y = real (y); + endif + if (! any (b - fix (b))) + idx = !any (x - fix (x)); + y(:, idx) = round (y(:, idx)); + endif + +endfunction + + +%!shared b, x, r +%!test +%! b = [1 1]; +%! x = [1, zeros(1,9)]; +%! assert(fftfilt(b, x ), [1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b, x.'), [1 1 0 0 0 0 0 0 0 0].', eps); +%! assert(fftfilt(b.',x ), [1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b.',x.'), [1 1 0 0 0 0 0 0 0 0].', eps); + +%!test +%! r = sqrt(1/2) * (1+i); +%! b = b*r; +%! assert(fftfilt(b, x ), r*[1 1 0 0 0 0 0 0 0 0] , eps); +%! assert(fftfilt(b, r*x), r*r*[1 1 0 0 0 0 0 0 0 0], eps); +%! assert(fftfilt(b, x.'), r*[1 1 0 0 0 0 0 0 0 0].', eps); + +%!test +%! b = [1 1]; +%! x = zeros (10,3); x(1,1)=-1; x(1,2)=1; +%! y0 = zeros (10,3); y0(1:2,1)=-1; y0(1:2,2)=1; +%! y = fftfilt (b, x); +%! assert (y,y0); + +%!test +%! b = rand (10, 1); +%! x = rand (10, 1); +%! y0 = filter (b, 1, x); +%! y = filter (b, 1, x); +%! assert (y, y0); + +%% Test input validation +%!error fftfilt (1) +%!error fftfilt (1, 2, 3, 4) +%!error fftfilt (ones (2), 1) +%!error fftfilt (2, ones (3,3,3)) +%!error fftfilt (2, 1, ones (2)) + diff --git a/octave_packages/m/signal/fftshift.m b/octave_packages/m/signal/fftshift.m new file mode 100644 index 0000000..ccd8194 --- /dev/null +++ b/octave_packages/m/signal/fftshift.m @@ -0,0 +1,131 @@ +## Copyright (C) 1997-2012 Vincent Cautaerts +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fftshift (@var{x}) +## @deftypefnx {Function File} {} fftshift (@var{x}, @var{dim}) +## Perform a shift of the vector @var{x}, for use with the @code{fft} +## and @code{ifft} functions, in order the move the frequency 0 to the +## center of the vector or matrix. +## +## If @var{x} is a vector of @math{N} elements corresponding to @math{N} +## time samples spaced by @math{dt}, then +## @code{fftshift (fft (@var{x}))} corresponds to frequencies +## +## @example +## f = [ -(ceil((N-1)/2):-1:1)*df 0 (1:floor((N-1)/2))*df ] +## @end example +## +## @noindent +## where @nospell{@math{df}} = 1 / @math{dt}. +## +## If @var{x} is a matrix, the same holds for rows and columns. If +## @var{x} is an array, then the same holds along each dimension. +## +## The optional @var{dim} argument can be used to limit the dimension +## along which the permutation occurs. +## @end deftypefn + +## Author: Vincent Cautaerts +## Created: July 1997 +## Adapted-By: jwe + +function retval = fftshift (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (nargin == 2) + if (! (isscalar (dim) && dim > 0 && dim == fix (dim))) + error ("fftshift: dimension DIM must be a positive integer"); + endif + nd = ndims (x); + sz = size (x); + sz2 = ceil (sz(dim) / 2); + idx = cell (); + idx = repmat ({':'}, nd, 1); + idx{dim} = [sz2+1:sz(dim), 1:sz2]; + retval = x(idx{:}); + else + if (isvector (x)) + xl = length (x); + xx = ceil (xl/2); + retval = x([xx+1:xl, 1:xx]); + elseif (ismatrix (x)) + nd = ndims (x); + sz = size (x); + sz2 = ceil (sz ./ 2); + idx = cell (); + for i = 1:nd + idx{i} = [sz2(i)+1:sz(i), 1:sz2(i)]; + endfor + retval = x(idx{:}); + else + error ("fftshift: expecting vector or matrix argument"); + endif + endif + +endfunction + + +%!test +%! x = [0:7]; +%! y = fftshift (x); +%! assert(y, [4 5 6 7 0 1 2 3]); +%! assert(fftshift (y), x); + +%!test +%! x = [0:6]; +%! y = fftshift (x); +%! assert(y, [4 5 6 0 1 2 3]); +%! assert(fftshift (y), [1 2 3 4 5 6 0]); + +%!test +%! x = [0:7]'; +%! y = fftshift (x); +%! assert(y, [4;5;6;7;0;1;2;3]); +%! assert(fftshift (y), x); + +%!test +%! x = [0:6]'; +%! y = fftshift (x); +%! assert(y, [4;5;6;0;1;2;3]); +%! assert(fftshift (y), [1;2;3;4;5;6;0]); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = fftshift (x); +%! assert(y, [[7 10 1 4];[9 13 1 5];[2 3 0 1];[4 6 0 2]]); +%! assert(fftshift (y), x); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = fftshift (x,1); +%! assert(y, [[1 4 7 10];[1 5 9 13];[0 1 2 3];[0 2 4 6]]); +%! assert(fftshift (y,1), x); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = fftshift (x,2); +%! assert(y, [[2 3 0 1];[4 6 0 2];[7 10 1 4];[9 13 1 5]]); +%! assert(fftshift (y,2), x); + diff --git a/octave_packages/m/signal/filter2.m b/octave_packages/m/signal/filter2.m new file mode 100644 index 0000000..04b8ca6 --- /dev/null +++ b/octave_packages/m/signal/filter2.m @@ -0,0 +1,58 @@ +## Copyright (C) 2001-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} filter2 (@var{b}, @var{x}) +## @deftypefnx {Function File} {@var{y} =} filter2 (@var{b}, @var{x}, @var{shape}) +## Apply the 2-D FIR filter @var{b} to @var{x}. If the argument +## @var{shape} is specified, return an array of the desired shape. +## Possible values are: +## +## @table @asis +## @item 'full' +## pad @var{x} with zeros on all sides before filtering. +## +## @item 'same' +## unpadded @var{x} (default) +## +## @item 'valid' +## trim @var{x} after filtering so edge effects are no included. +## @end table +## +## Note this is just a variation on convolution, with the parameters +## reversed and @var{b} rotated 180 degrees. +## @seealso{conv2} +## @end deftypefn + +## Author: Paul Kienzle +## 2001-02-08 +## * initial release + +function y = filter2 (b, x, shape) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + if (nargin < 3) + shape = "same"; + endif + + [nr, nc] = size(b); + y = conv2 (x, b(nr:-1:1, nc:-1:1), shape); +endfunction + diff --git a/octave_packages/m/signal/fractdiff.m b/octave_packages/m/signal/fractdiff.m new file mode 100644 index 0000000..26f9dd4 --- /dev/null +++ b/octave_packages/m/signal/fractdiff.m @@ -0,0 +1,69 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fractdiff (@var{x}, @var{d}) +## Compute the fractional differences @math{(1-L)^d x} where @math{L} +## denotes the lag-operator and @math{d} is greater than -1. +## @end deftypefn + +## Author: FL +## Description: Compute fractional differences + +function retval = fractdiff (x, d) + + if (nargin != 2) + print_usage (); + endif + + N = 100; + + if (! isvector (x)) + error ("fractdiff: X must be a vector"); + endif + + if (! isscalar (d)) + error ("fractdiff: D must be a scalar"); + endif + + + if (d >= 1) + for k = 1 : d + x = x(2 : length (x)) - x(1 : length (x) - 1); + endfor + endif + + if (d > -1) + + d = rem (d, 1); + + if (d != 0) + n = (0 : N)'; + w = real (gamma (-d+n) ./ gamma (-d) ./ gamma (n+1)); + retval = fftfilt (w, x); + retval = retval(1 : length (x)); + else + retval = x; + endif + + else + error ("fractdiff: D must be > -1"); + + endif + +endfunction diff --git a/octave_packages/m/signal/freqz.m b/octave_packages/m/signal/freqz.m new file mode 100644 index 0000000..4c21993 --- /dev/null +++ b/octave_packages/m/signal/freqz.m @@ -0,0 +1,197 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{h}, @var{w}] =} freqz (@var{b}, @var{a}, @var{n}, "whole") +## Return the complex frequency response @var{h} of the rational IIR filter +## whose numerator and denominator coefficients are @var{b} and @var{a}, +## respectively. The response is evaluated at @var{n} angular frequencies +## between 0 and +## @ifnottex +## 2*pi. +## @end ifnottex +## @tex +## $2\pi$. +## @end tex +## +## @noindent +## The output value @var{w} is a vector of the frequencies. +## +## If the fourth argument is omitted, the response is evaluated at +## frequencies between 0 and +## @ifnottex +## pi. +## @end ifnottex +## @tex +## $\pi$. +## @end tex +## +## If @var{n} is omitted, a value of 512 is assumed. +## +## If @var{a} is omitted, the denominator is assumed to be 1 (this +## corresponds to a simple FIR filter). +## +## For fastest computation, @var{n} should factor into a small number of +## small primes. +## +## @deftypefnx {Function File} {@var{h} =} freqz (@var{b}, @var{a}, @var{w}) +## Evaluate the response at the specific frequencies in the vector @var{w}. +## The values for @var{w} are measured in radians. +## +## @deftypefnx {Function File} {[@dots{}] =} freqz (@dots{}, @var{Fs}) +## Return frequencies in Hz instead of radians assuming a sampling rate +## @var{Fs}. If you are evaluating the response at specific frequencies +## @var{w}, those frequencies should be requested in Hz rather than radians. +## +## @deftypefnx {Function File} {} freqz (@dots{}) +## Plot the pass band, stop band and phase response of @var{h} rather +## than returning them. +## @end deftypefn + +## Author: jwe ??? + +function [h_r, f_r] = freqz (b, a, n, region, Fs) + + if (nargin < 1 || nargin > 5) + print_usage (); + elseif (nargin == 1) + ## Response of an FIR filter. + a = n = region = Fs = []; + elseif (nargin == 2) + ## Response of an IIR filter + n = region = Fs = []; + elseif (nargin == 3) + region = Fs = []; + elseif (nargin == 4) + Fs = []; + if (! ischar (region) && ! isempty (region)) + Fs = region; + region = []; + endif + endif + + if (isempty (b)) + b = 1; + endif + if (isempty (a)) + a = 1; + endif + if (isempty (n)) + n = 512; + endif + if (isempty (region)) + if (isreal (b) && isreal (a)) + region = "half"; + else + region = "whole"; + endif + endif + if (isempty (Fs)) + if (nargout == 0) + Fs = 2; + else + Fs = 2*pi; + endif + endif + + a = a(:); + b = b(:); + + if (! isscalar (n)) + ## Explicit frequency vector given + w = f = n; + if (nargin == 4) + ## Sampling rate Fs was specified + w = 2*pi*f/Fs; + endif + k = max (length (b), length (a)); + hb = polyval (postpad (b, k), exp (j*w)); + ha = polyval (postpad (a, k), exp (j*w)); + else + ## polyval(fliplr(P),exp(jw)) is O(p n) and fft(x) is O(n log(n)), + ## where p is the order of the polynomial P. For small p it + ## would be faster to use polyval but in practice the overhead for + ## polyval is much higher and the little bit of time saved isn't + ## worth the extra code. + k = max (length (b), length (a)); + if (k > n/2 && nargout == 0) + ## Ensure a causal phase response. + n = n * 2 .^ ceil (log2 (2*k/n)); + endif + + if (strcmp (region, "whole")) + N = n; + else + N = 2*n; + endif + + f = Fs * (0:n-1).' / N; + + pad_sz = N*ceil (k/N); + b = postpad (b, pad_sz); + a = postpad (a, pad_sz); + + hb = zeros (n, 1); + ha = zeros (n, 1); + + for i = 1:N:pad_sz + hb = hb + fft (postpad (b(i:i+N-1), N))(1:n); + ha = ha + fft (postpad (a(i:i+N-1), N))(1:n); + endfor + + endif + + h = hb ./ ha; + + if (nargout != 0) + ## Return values and don't plot. + h_r = h; + f_r = f; + else + ## Plot and don't return values. + freqz_plot (f, h); + endif + +endfunction + +%!test # correct values and fft-polyval consistency +%! # butterworth filter, order 2, cutoff pi/2 radians +%! b = [0.292893218813452 0.585786437626905 0.292893218813452]; +%! a = [1 0 0.171572875253810]; +%! [h,w] = freqz(b,a,32); +%! assert(h(1),1,10*eps); +%! assert(abs(h(17)).^2,0.5,10*eps); +%! assert(h,freqz(b,a,w),10*eps); # fft should be consistent with polyval + +%!test # whole-half consistency +%! b = [1 1 1]/3; # 3-sample average +%! [h,w] = freqz(b,1,32,'whole'); +%! assert(h(2:16),conj(h(32:-1:18)),20*eps); +%! [h2,w2] = freqz(b,1,16,'half'); +%! assert(h(1:16),h2,20*eps); +%! assert(w(1:16),w2,20*eps); + +%!test # Sampling frequency properly interpreted +%! b = [1 1 1]/3; a = [1 0.2]; +%! [h,f] = freqz(b,a,16,320); +%! assert(f,[0:15]'*10,10*eps); +%! [h2,f2] = freqz(b,a,[0:15]*10,320); +%! assert(f2,[0:15]*10,10*eps); +%! assert(h,h2.',20*eps); +%! [h3,f3] = freqz(b,a,32,'whole',320); +%! assert(f3,[0:31]'*10,10*eps); diff --git a/octave_packages/m/signal/freqz_plot.m b/octave_packages/m/signal/freqz_plot.m new file mode 100644 index 0000000..4ec9d66 --- /dev/null +++ b/octave_packages/m/signal/freqz_plot.m @@ -0,0 +1,66 @@ +## Copyright (C) 2002-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} freqz_plot (@var{w}, @var{h}) +## Plot the pass band, stop band and phase response of @var{h}. +## @end deftypefn + +## Author: Paul Kienzle + +function freqz_plot (w, h) + + if (nargin != 2) + print_usage (); + endif + + n = length (w); + + ## ## exclude zero-frequency + ## h = h (2 : length (h)); + ## w = w (2 : length (w)); + ## n = n-1; + + mag = 20 * log10 (abs (h)); + phase = unwrap (arg (h)); + maxmag = max (mag); + + subplot (3, 1, 1); + plot (w, mag); + grid ("on"); + legend ("Pass band (dB)"); + axis ([w(1), w(n), maxmag-3, maxmag], "labely"); + + subplot (3, 1, 2); + plot (w, mag); + grid ("on"); + legend ("Stop band (dB)"); + if (maxmag - min (mag) > 100) + axis ([w(1), w(n), maxmag-100, maxmag], "labely"); + else + axis ("autoy", "labely"); + endif + + subplot (3, 1, 3); + plot (w, phase*360/(2*pi)); + grid ("on"); + legend ("Phase (degrees)"); + xlabel ("Frequency"); + axis ([w(1), w(n)], "autoy", "label"); + +endfunction diff --git a/octave_packages/m/signal/hamming.m b/octave_packages/m/signal/hamming.m new file mode 100644 index 0000000..154b24f --- /dev/null +++ b/octave_packages/m/signal/hamming.m @@ -0,0 +1,61 @@ +## Copyright (C) 1995-2012 Andreas Weingessel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hamming (@var{m}) +## Return the filter coefficients of a Hamming window of length @var{m}. +## +## For a definition of the Hamming window, see e.g., A. V. Oppenheim & +## R. W. Schafer, @cite{Discrete-Time Signal Processing}. +## @end deftypefn + +## Author: AW +## Description: Coefficients of the Hamming window + +function c = hamming (m) + + if (nargin != 1) + print_usage (); + endif + + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) + error ("hamming: M has to be an integer > 0"); + endif + + if (m == 1) + c = 1; + else + m = m - 1; + c = 0.54 - 0.46 * cos (2 * pi * (0:m)' / m); + endif + +endfunction + +%!assert (hamming (1), 1); +%!assert (hamming (2), (0.54 - 0.46)*ones(2,1)); +%!assert (hamming (16), fliplr (hamming (16))); +%!assert (hamming (15), fliplr (hamming (15))); +%!test +%! N = 15; +%! A = hamming (N); +%! assert (A (ceil (N/2)), 1); + +%!error hamming (); +%!error hamming (0.5); +%!error hamming (-1); +%!error hamming (ones(1,4)); diff --git a/octave_packages/m/signal/hanning.m b/octave_packages/m/signal/hanning.m new file mode 100644 index 0000000..134d14c --- /dev/null +++ b/octave_packages/m/signal/hanning.m @@ -0,0 +1,61 @@ +## Copyright (C) 1995-2012 Andreas Weingessel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hanning (@var{m}) +## Return the filter coefficients of a Hanning window of length @var{m}. +## +## For a definition of this window type, see e.g., A. V. Oppenheim & +## R. W. Schafer, @cite{Discrete-Time Signal Processing}. +## @end deftypefn + +## Author: AW +## Description: Coefficients of the Hanning window + +function c = hanning (m) + + if (nargin != 1) + print_usage (); + endif + + if (! (isscalar (m) && (m == fix (m)) && (m > 0))) + error ("hanning: M has to be an integer > 0"); + endif + + if (m == 1) + c = 1; + else + m = m - 1; + c = 0.5 - 0.5 * cos (2 * pi * (0 : m)' / m); + endif + +endfunction + +%!assert (hanning (1), 1); +%!assert (hanning (2), zeros(2,1)); +%!assert (hanning (16), fliplr (hanning (16))); +%!assert (hanning (15), fliplr (hanning (15))); +%!test +%! N = 15; +%! A = hanning (N); +%! assert (A (ceil (N/2)), 1); + +%!error hanning (); +%!error hanning (0.5); +%!error hanning (-1); +%!error hanning (ones(1,4)); diff --git a/octave_packages/m/signal/hurst.m b/octave_packages/m/signal/hurst.m new file mode 100644 index 0000000..3d51821 --- /dev/null +++ b/octave_packages/m/signal/hurst.m @@ -0,0 +1,48 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hurst (@var{x}) +## Estimate the Hurst parameter of sample @var{x} via the rescaled range +## statistic. If @var{x} is a matrix, the parameter is estimated for +## every single column. +## @end deftypefn + +## Author: FL +## Description: Estimate the Hurst parameter + +function H = hurst (x) + + if (nargin != 1) + print_usage (); + endif + + if (isscalar (x)) + error ("hurst: X must not be a scalar"); + elseif (isvector (x)) + x = reshape (x, length (x), 1); + endif + + [xr, xc] = size (x); + + s = std (x); + w = cumsum (x - mean (x)); + RS = (max(w) - min(w)) ./ s; + H = log (RS) / log (xr); + +endfunction diff --git a/octave_packages/m/signal/ifftshift.m b/octave_packages/m/signal/ifftshift.m new file mode 100644 index 0000000..545a9c1 --- /dev/null +++ b/octave_packages/m/signal/ifftshift.m @@ -0,0 +1,116 @@ +## Copyright (C) 1997-2012 Vincent Cautaerts +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ifftshift (@var{x}) +## @deftypefnx {Function File} {} ifftshift (@var{x}, @var{dim}) +## Undo the action of the @code{fftshift} function. For even length +## @var{x}, @code{fftshift} is its own inverse, but odd lengths differ +## slightly. +## @end deftypefn + +## Author: Vincent Cautaerts +## Created: July 1997 +## Adapted-By: jwe +## Modified-By: Paul Kienzle, converted from fftshift +## Modified-By: David Bateman, add NDArray capability and option dim arg + +function retval = ifftshift (x, dim) + + retval = 0; + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (nargin == 2) + if (! isscalar (dim)) + error ("ifftshift: dimension must be an integer scalar"); + endif + nd = ndims (x); + sz = size (x); + sz2 = floor (sz(dim) / 2); + idx = repmat ({':'}, nd, 1); + idx{dim} = [sz2+1:sz(dim), 1:sz2]; + retval = x(idx{:}); + else + if (isvector (x)) + xl = length (x); + xx = floor (xl/2); + retval = x([xx+1:xl, 1:xx]); + elseif (ismatrix (x)) + nd = ndims (x); + sz = size (x); + sz2 = floor (sz ./ 2); + idx = cell (); + for i = 1:nd + idx{i} = [sz2(i)+1:sz(i), 1:sz2(i)]; + endfor + retval = x(idx{:}); + else + error ("ifftshift: expecting vector or matrix argument"); + endif + endif + +endfunction + +%!test +%! x = [0:7]; +%! y = ifftshift (x); +%! assert(y, [4 5 6 7 0 1 2 3]); +%! assert(ifftshift (y), x); + +%!test +%! x = [0:6]; +%! y = ifftshift (x); +%! assert(y, [3 4 5 6 0 1 2]); +%! assert(ifftshift (y), [6 0 1 2 3 4 5]); + +%!test +%! x = [0:7]'; +%! y = ifftshift (x); +%! assert(y, [4;5;6;7;0;1;2;3]); +%! assert(ifftshift (y), x); + +%!test +%! x = [0:6]'; +%! y = ifftshift (x); +%! assert(y, [3;4;5;6;0;1;2]); +%! assert(ifftshift (y), [6;0;1;2;3;4;5]); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = ifftshift (x); +%! assert(y, [[7 10 1 4];[9 13 1 5];[2 3 0 1];[4 6 0 2]]); +%! assert(ifftshift (y), x); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = ifftshift (x,1); +%! assert(y, [[1 4 7 10];[1 5 9 13];[0 1 2 3];[0 2 4 6]]); +%! assert(ifftshift (y,1), x); + +%!test +%! x = [0:3]; +%! x = [x;2*x;3*x+1;4*x+1]; +%! y = ifftshift (x,2); +%! assert(y, [[2 3 0 1];[4 6 0 2];[7 10 1 4];[9 13 1 5]]); +%! assert(ifftshift (y,2), x); + diff --git a/octave_packages/m/signal/periodogram.m b/octave_packages/m/signal/periodogram.m new file mode 100644 index 0000000..7c26ad4 --- /dev/null +++ b/octave_packages/m/signal/periodogram.m @@ -0,0 +1,190 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## Copyright (C) 2010 Alois Schloegl +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[Pxx, @var{w}] =} periodogram (@var{x}) +## For a data matrix @var{x} from a sample of size @var{n}, return the +## periodogram. The angular frequency is returned in @var{w}. +## +## [Pxx,w] = periodogram (@var{x}). +## +## [Pxx,w] = periodogram (@var{x},win). +## +## [Pxx,w] = periodogram (@var{x},win,nfft). +## +## [Pxx,f] = periodogram (@var{x},win,nfft,Fs). +## +## [Pxx,f] = periodogram (@var{x},win,nfft,Fs,"range"). +## +## @itemize +## @item x: data; if real-valued a one-sided spectrum is estimated, +## if complex-valued or range indicates "@nospell{twosided}", the full +## spectrum is estimated. +## +## @item win: weight data with window, x.*win is used for further computation, +## if window is empty, a rectangular window is used. +## +## @item nfft: number of frequency bins, default max(256, 2.^ceil(log2(length(x)))). +## +## @item Fs: sampling rate, default 1. +## +## @item range: "@nospell{onesided}" computes spectrum from [0..nfft/2+1]. +## "@nospell{twosided}" computes spectrum from [0..nfft-1]. These strings +## can appear at any position in the list input arguments after window. +## +## @item Pxx: one-, or two-sided power spectrum. +## +## @item w: angular frequency [0..2*pi) (two-sided) or [0..pi] one-sided. +## +## @item f: frequency [0..Fs) (two-sided) or [0..Fs/2] one-sided. +## @end itemize +## @end deftypefn + +## Author: FL +## Description: Compute the periodogram + +function [pxx, f] = periodogram (x, varargin) + + ## check input arguments + + if (nargin < 1 || nargin > 5) + print_usage (); + endif + + nfft = []; fs = []; range = []; window = []; + j = 1; + for k = 1:length (varargin) + if (ischar (varargin{k})) + range = varargin{k}; + else + switch (j) + case 1 + window = varargin{k}; + case 2 + nfft = varargin{k}; + case 3 + fs = varargin{k}; + case 4 + range = varargin{k}; + endswitch + j++; + endif + endfor + + [r, c] = size (x); + if (r == 1) + r = c; + endif + + if (ischar (window)) + range = window; + window = []; + endif; + if (ischar (nfft)) + range = nfft; + nfft = []; + endif; + if (ischar (fs)) + range = fs; + fs = []; + endif; + + if (! isempty (window)) + if (all (size (x) == size (window))) + x .*= window; + elseif (size (x, 1) == size (window, 1) && size (window, 2) == 1) + x .*= window (:,ones (1,c)); + endif; + endif + + if (numel (nfft)>1) + error ("nfft must be scalar"); + endif + if (isempty (nfft)) + nfft = max (256, 2.^ceil (log2 (r))); + endif + + if (strcmp (range, "onesided")) + range = 1; + elseif strcmp (range, "twosided") + range = 2; + else + range = 2-isreal (x); + endif + + ## compute periodogram + + if (r>nfft) + Pxx = 0; + rr = rem (length (x), nfft); + if (rr) + x = [x(:); (zeros (nfft-rr, 1))]; + endif + x = sum (reshape (x, nfft, []), 2); + endif + + if (isempty (window)) + n = r; + else + n = sumsq (window); + end; + Pxx = (abs (fft (x, nfft))) .^ 2 / n ; + + if (nargin<4) + Pxx /= 2*pi; + elseif (! isempty (fs)) + Pxx /= fs; + endif + + ## generate output arguments + + if (range == 1) # onesided + Pxx = Pxx(1:nfft/2+1) + [0; Pxx(end:-1:(nfft/2+2)); 0]; + endif + + if (nargout != 1) + if (range == 1) + f = (0:nfft/2)'/nfft; + elseif (range == 2) + f = (0:nfft-1)'/nfft; + endif + if (nargin<4) + f *= 2*pi; # generate w=2*pi*f + elseif (! isempty (fs)) + f *= fs; + endif + endif + + if (nargout == 0) + if (nargin<4) + plot (f/(2*pi), 10*log10 (Pxx)); + xlabel ("normalized frequency [x pi rad]"); + ylabel ("Power density [dB/rad/sample]"); + else + plot (f, 10*log10 (Pxx)); + xlabel ("frequency [Hz]"); + ylabel ("Power density [dB/Hz]"); + endif + grid on; + title ("Periodogram Power Spectral Density Estimate"); + else + pxx = Pxx; + endif + +endfunction diff --git a/octave_packages/m/signal/private/rectangle_lw.m b/octave_packages/m/signal/private/rectangle_lw.m new file mode 100644 index 0000000..44759ba --- /dev/null +++ b/octave_packages/m/signal/private/rectangle_lw.m @@ -0,0 +1,39 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rectangle_lw (@var{n}, @var{b}) +## Rectangular lag window. Subfunction used for spectral density +## estimation. +## @end deftypefn + +## Author: FL +## Description: Rectangular lag window + +function retval = rectangle_lw (n, b) + + if (nargin != 2) + print_usage (); + endif + + retval = zeros (n, 1); + t = floor (1 / b); + + retval (1:t, 1) = ones (t, 1); + +endfunction diff --git a/octave_packages/m/signal/private/rectangle_sw.m b/octave_packages/m/signal/private/rectangle_sw.m new file mode 100644 index 0000000..55607fa --- /dev/null +++ b/octave_packages/m/signal/private/rectangle_sw.m @@ -0,0 +1,72 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rectangle_sw (@var{n}, @var{b}) +## Rectangular spectral window. Subfunction used for spectral density +## estimation. +## @end deftypefn + +## Author: FL +## Description: Rectangular spectral window + +function retval = rectangle_sw (n, b) + + if (nargin != 2) + print_usage (); + endif + + retval = zeros (n, 1); + retval(1) = 2 / b + 1; + + l = (2:n)' - 1; + l = 2 * pi * l / n; + + retval(2:n) = sin ((2/b + 1) * l / 2) ./ sin (l / 2); + +endfunction + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/octave_packages/m/signal/private/triangle_lw.m b/octave_packages/m/signal/private/triangle_lw.m new file mode 100644 index 0000000..70fa377 --- /dev/null +++ b/octave_packages/m/signal/private/triangle_lw.m @@ -0,0 +1,38 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} triangle_lw (@var{n}, @var{b}) +## Triangular lag window. Subfunction used for spectral density +## estimation. +## @end deftypefn + +## Author: FL +## Description: Triangular lag window + +function retval = triangle_lw (n, b) + + if (nargin != 2) + print_usage (); + endif + + retval = 1 - (0 : n-1)' * b; + retval = max ([retval'; (zeros (1, n))])'; + +endfunction + diff --git a/octave_packages/m/signal/private/triangle_sw.m b/octave_packages/m/signal/private/triangle_sw.m new file mode 100644 index 0000000..3ea9d18 --- /dev/null +++ b/octave_packages/m/signal/private/triangle_sw.m @@ -0,0 +1,72 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} triangle_sw (@var{n}, @var{b}) +## Triangular spectral window. Subfunction used for spectral density +## estimation. +## @end deftypefn + +## Author: FL +## Description: Triangular spectral window + +function retval = triangle_sw (n, b) + + if (nargin != 2) + print_usage (); + endif + + retval = zeros(n,1); + retval(1) = 1 / b; + + l = (2:n)' - 1; + l = 2 * pi * l / n; + + retval(2:n) = b * (sin (l / (2*b)) ./ sin (l / 2)).^2; + +endfunction + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/octave_packages/m/signal/sinc.m b/octave_packages/m/signal/sinc.m new file mode 100644 index 0000000..972dad0 --- /dev/null +++ b/octave_packages/m/signal/sinc.m @@ -0,0 +1,54 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} sinc (@var{x}) +## Return +## @tex +## $ \sin (\pi x)/(\pi x)$. +## @end tex +## @ifnottex +## sin(pi*x)/(pi*x). +## @end ifnottex +## @end deftypefn + +## Author: jwe ??? + +function result = sinc (x) + + if (nargin != 1) + print_usage (); + endif + + result = ones (size (x)); + + i = (x != 0); + + if (any (i(:))) + t = pi * x(i); + result(i) = sin (t) ./ t; + endif + +endfunction + + +%!assert (sinc (0), 1); +%!assert (sinc (1), 0,1e-6); +%!assert (sinc (1/2), 2/pi, 1e-6) + +%!error sinc() diff --git a/octave_packages/m/signal/sinetone.m b/octave_packages/m/signal/sinetone.m new file mode 100644 index 0000000..e0a6de8 --- /dev/null +++ b/octave_packages/m/signal/sinetone.m @@ -0,0 +1,67 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} sinetone (@var{freq}, @var{rate}, @var{sec}, @var{ampl}) +## Return a sinetone of frequency @var{freq} with length of @var{sec} +## seconds at sampling rate @var{rate} and with amplitude @var{ampl}. +## The arguments @var{freq} and @var{ampl} may be vectors of common size. +## +## Defaults are @var{rate} = 8000, @var{sec} = 1 and @var{ampl} = 64. +## @end deftypefn + +## Author: FL +## Description: Compute a sine tone + +function retval = sinetone (freq, rate, sec, ampl) + + if (nargin == 1) + rate = 8000; + sec = 1; + ampl = 64; + elseif (nargin == 2) + sec = 1; + ampl = 64; + elseif (nargin == 3) + ampl = 64; + elseif ((nargin < 1) || (nargin > 4)) + print_usage (); + endif + + [err, freq, ampl] = common_size (freq, ampl); + if (err || ! isvector (freq)) + error ("sinetone: FREQ and AMPL must be vectors of common size"); + endif + + if (! (isscalar (rate) && isscalar (sec))) + error ("sinetone: RATE and SEC must be scalars"); + endif + + n = length (freq); + ns = round (rate * sec); + + retval = zeros (ns, n); + + for k = 1:n + retval (:, k) = ampl(k) * sin (2 * pi * (1:ns) / rate * freq(k))'; + endfor + +endfunction + + +%!assert (size (sinetone (18e6, 150e6, 19550/150e6, 1)), [19550, 1]); diff --git a/octave_packages/m/signal/sinewave.m b/octave_packages/m/signal/sinewave.m new file mode 100644 index 0000000..a5ab362 --- /dev/null +++ b/octave_packages/m/signal/sinewave.m @@ -0,0 +1,55 @@ +## Copyright (C) 1995-2012 Andreas Weingessel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} sinewave (@var{m}, @var{n}, @var{d}) +## Return an @var{m}-element vector with @var{i}-th element given by +## @code{sin (2 * pi * (@var{i}+@var{d}-1) / @var{n})}. +## +## The default value for @var{d} is 0 and the default value for @var{n} +## is @var{m}. +## @end deftypefn + +## Author: AW +## Description: Compute a sine wave + +function x = sinewave (m, n, d) + + if (nargin > 0 && nargin < 4) + if (nargin < 3) + d = 0; + endif + if (nargin < 2) + n = m; + endif + x = sin (((1 : m) + d - 1) * 2 * pi / n); + else + print_usage (); + endif + +endfunction + +%!assert (sinewave (1), 0); +%!assert (sinewave (1, 4, 1), 1); +%!assert (sinewave (1, 12, 1), 1/2, 1e-6); +%!assert (sinewave (1, 12, 2), sqrt (3)/2, 1e-6); +%!assert (sinewave (1, 20, 1), (sqrt (5)-1)/4, 1e-6); +%!assert (sinewave (1), sinewave (1, 1,0)); +%!assert (sinewave (3, 4), sinewave(3, 4, 0)); + +%!error sinewave (); diff --git a/octave_packages/m/signal/spectral_adf.m b/octave_packages/m/signal/spectral_adf.m new file mode 100644 index 0000000..f514f09 --- /dev/null +++ b/octave_packages/m/signal/spectral_adf.m @@ -0,0 +1,65 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} spectral_adf (@var{c}, @var{win}, @var{b}) +## Return the spectral density estimator given a vector of +## autocovariances @var{c}, window name @var{win}, and bandwidth, +## @var{b}. +## +## The window name, e.g., @code{"triangle"} or @code{"rectangle"} is +## used to search for a function called @code{@var{win}_sw}. +## +## If @var{win} is omitted, the triangle window is used. If @var{b} is +## omitted, @code{1 / sqrt (length (@var{x}))} is used. +## @end deftypefn + +## Author: FL +## Description: Spectral density estimation + +function retval = spectral_adf (c, win, b) + + cr = length (c); + + if (columns (c) > 1) + c = c'; + endif + + if (nargin < 3) + b = 1 / ceil (sqrt (cr)); + endif + + if (nargin == 1) + w = triangle_lw (cr, b); + else + win = str2func (cstrcat (win, "_lw")); + w = feval (win, cr, b); + endif + + c = c .* w; + + retval = 2 * real (fft (c)) - c(1); + retval = [(zeros (cr, 1)), retval]; + retval(:, 1) = (0 : cr-1)' / cr; + +endfunction + + + + + diff --git a/octave_packages/m/signal/spectral_xdf.m b/octave_packages/m/signal/spectral_xdf.m new file mode 100644 index 0000000..0e7111f --- /dev/null +++ b/octave_packages/m/signal/spectral_xdf.m @@ -0,0 +1,62 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} spectral_xdf (@var{x}, @var{win}, @var{b}) +## Return the spectral density estimator given a data vector @var{x}, +## window name @var{win}, and bandwidth, @var{b}. +## +## The window name, e.g., @code{"triangle"} or @code{"rectangle"} is +## used to search for a function called @code{@var{win}_sw}. +## +## If @var{win} is omitted, the triangle window is used. If @var{b} is +## omitted, @code{1 / sqrt (length (@var{x}))} is used. +## @end deftypefn + +## Author: FL +## Description: Spectral density estimation + +function retval = spectral_xdf (x, win, b) + + xr = length (x); + + if (columns (x) > 1) + x = x'; + endif + + if (nargin < 3) + b = 1 / ceil (sqrt (xr)); + endif + + if (nargin == 1) + w = triangle_sw (xr, b); + else + win = str2func (cstrcat (win, "_sw")); + w = feval (win, xr, b); + endif + + x = x - sum (x) / xr; + + retval = (abs (fft (x)) / xr).^2; + retval = real (ifft (fft(retval) .* fft(w))); + + retval = [(zeros (xr, 1)), retval]; + retval(:, 1) = (0 : xr-1)' / xr; + +endfunction + diff --git a/octave_packages/m/signal/spencer.m b/octave_packages/m/signal/spencer.m new file mode 100644 index 0000000..4ffd073 --- /dev/null +++ b/octave_packages/m/signal/spencer.m @@ -0,0 +1,53 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} spencer (@var{x}) +## Return Spencer's 15 point moving average of each column of +## @var{x}. +## @end deftypefn + +## Author: FL +## Description: Apply Spencer's 15-point MA filter + +function retval = spencer (x) + + if (nargin != 1) + print_usage (); + endif + + [xr, xc] = size(x); + + n = xr; + c = xc; + + if (isvector(x)) + n = length(x); + c = 1; + x = reshape(x, n, 1); + endif + + w = [-3, -6, -5, 3, 21, 46, 67, 74, 67, 46, 21, 3, -5, -6, -3] / 320; + + retval = fftfilt (w, x); + retval = [zeros(7,c); retval(15:n,:); zeros(7,c);]; + + retval = reshape(retval, xr, xc); + +endfunction + diff --git a/octave_packages/m/signal/stft.m b/octave_packages/m/signal/stft.m new file mode 100644 index 0000000..e3cc7e5 --- /dev/null +++ b/octave_packages/m/signal/stft.m @@ -0,0 +1,134 @@ +## Copyright (C) 1995-2012 Andreas Weingessel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{y}, @var{c}] =} stft (@var{x}, @var{win_size}, @var{inc}, @var{num_coef}, @var{win_type}) +## Compute the short-time Fourier transform of the vector @var{x} with +## @var{num_coef} coefficients by applying a window of @var{win_size} data +## points and an increment of @var{inc} points. +## +## Before computing the Fourier transform, one of the following windows +## is applied: +## +## @table @asis +## @item @nospell{hanning} +## win_type = 1 +## +## @item @nospell{hamming} +## win_type = 2 +## +## @item rectangle +## win_type = 3 +## @end table +## +## The window names can be passed as strings or by the @var{win_type} number. +## +## If not all arguments are specified, the following defaults are used: +## @var{win_size} = 80, @var{inc} = 24, @var{num_coef} = 64, and +## @var{win_type} = 1. +## +## @code{@var{y} = stft (@var{x}, @dots{})} returns the absolute values +## of the Fourier coefficients according to the @var{num_coef} positive +## frequencies. +## +## @code{[@var{y}, @var{c}] = stft (@code{x}, @dots{})} returns the +## entire STFT-matrix @var{y} and a 3-element vector @var{c} containing +## the window size, increment, and window type, which is needed by the +## synthesis function. +## @end deftypefn + +## Author: AW +## Description: Short-Time Fourier Transform + +function [y, c] = stft(x, win_size, inc, num_coef, win_type) + + ## Default values of unspecified arguments. + if (nargin < 5) + win_type = 1; + if (nargin < 4) + num_coef = 64; + if (nargin < 3) + inc = 24; + if (nargin < 2) + win_size = 80; + endif + endif + endif + elseif (nargin == 5) + if (ischar (win_type)) + if (strcmp (win_type, "hanning")) + win_type = 1; + elseif (strcmp (win_type, "hamming")) + win_type = 2; + elseif (strcmp (win_type, "rectangle")) + win_type = 3; + else + error ("stft: unknown window type `%s'", win_type); + endif + endif + else + print_usage (); + endif + + ## Check whether X is a vector. + [nr, nc] = size (x); + if (nc != 1) + if (nr == 1) + x = x'; + nr = nc; + else + error ("stft: X must be a vector"); + endif + endif + + ncoef = 2 * num_coef; + if (win_size > ncoef) + win_size = ncoef; + printf ("stft: window size adjusted to %f\n", win_size); + endif + num_win = fix ((nr - win_size) / inc); + + ## compute the window coefficients + if (win_type == 3) + ## Rectangular window. + win_coef = ones (win_size, 1); + elseif (win_type == 2) + ## Hamming window. + win_coef = hamming (win_size); + else + ## Hanning window. + win_coef = hanning (win_size); + endif + + ## Create a matrix Z whose columns contain the windowed time-slices. + z = zeros (ncoef, num_win + 1); + start = 1; + for i = 0:num_win + z(1:win_size, i+1) = x(start:start+win_size-1) .* win_coef; + start = start + inc; + endfor + + y = fft (z); + + if (nargout == 1) + y = abs (y(1:num_coef, :)); + else + c = [win_size, inc, win_type]; + endif + +endfunction diff --git a/octave_packages/m/signal/synthesis.m b/octave_packages/m/signal/synthesis.m new file mode 100644 index 0000000..49357ec --- /dev/null +++ b/octave_packages/m/signal/synthesis.m @@ -0,0 +1,72 @@ +## Copyright (C) 1995-2012 Andreas Weingessel +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} synthesis (@var{y}, @var{c}) +## Compute a signal from its short-time Fourier transform @var{y} and a +## 3-element vector @var{c} specifying window size, increment, and +## window type. +## +## The values @var{y} and @var{c} can be derived by +## +## @example +## [@var{y}, @var{c}] = stft (@var{x} , @dots{}) +## @end example +## @end deftypefn + +## Author: AW +## Description: Recover a signal from its short-term Fourier transform + +function x = synthesis (y, c) + + if (nargin != 2) + print_usage (); + endif + + [nr, nc] = size (c); + if (nr * nc != 3) + error ("synthesis: C must contain exactly 3 elements"); + endif + + w_size = c(1); + inc = c(2); + w_type = c(3); + + if (w_type == 1) + w_coeff = hanning (w_size); + elseif (w_type == 2) + w_coeff = hamming (w_size); + elseif (w_type == 3) + w_coeff = ones (w_size, 1); + else + error ("synthesis: window_type must be 1, 2, or 3"); + endif + + z = real (ifft (y)); + st = fix ((w_size-inc) / 2); + z = z(st:st+inc-1, :); + w_coeff = w_coeff(st:st+inc-1); + + nc = columns(z); + for i = 1:nc + z(:, i) = z(:, i) ./ w_coeff; + endfor + + x = reshape(z, inc * nc, 1); + +endfunction diff --git a/octave_packages/m/signal/unwrap.m b/octave_packages/m/signal/unwrap.m new file mode 100644 index 0000000..b4f39aa --- /dev/null +++ b/octave_packages/m/signal/unwrap.m @@ -0,0 +1,156 @@ +## Copyright (C) 2000-2012 Bill Lash +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{b} =} unwrap (@var{x}) +## @deftypefnx {Function File} {@var{b} =} unwrap (@var{x}, @var{tol}) +## @deftypefnx {Function File} {@var{b} =} unwrap (@var{x}, @var{tol}, @var{dim}) +## +## Unwrap radian phases by adding multiples of 2*pi as appropriate to +## remove jumps greater than @var{tol}. @var{tol} defaults to pi. +## +## Unwrap will work along the dimension @var{dim}. If @var{dim} +## is unspecified it defaults to the first non-singleton dimension. +## @end deftypefn + +## Author: Bill Lash + +function retval = unwrap (x, tol, dim) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (!isnumeric(x)) + error ("unwrap: X must be a numeric matrix or vector"); + endif + + if (nargin < 2 || isempty (tol)) + tol = pi; + endif + + ## Don't let anyone use a negative value for TOL. + tol = abs (tol); + + nd = ndims (x); + sz = size (x); + if (nargin == 3) + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("unwrap: DIM must be an integer and a valid dimension"); + endif + else + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + endif + + rng = 2*pi; + m = sz(dim); + + ## Handle case where we are trying to unwrap a scalar, or only have + ## one sample in the specified dimension. + if (m == 1) + retval = x; + return; + endif + + ## Take first order difference to see so that wraps will show up + ## as large values, and the sign will show direction. + idx = repmat ({':'}, nd, 1); + idx{dim} = [1,1:m-1]; + d = x(idx{:}) - x; + + ## Find only the peaks, and multiply them by the appropriate amount + ## of ranges so that there are kronecker deltas at each wrap point + ## multiplied by the appropriate amount of range values. + p = ceil(abs(d)./rng) .* rng .* (((d > tol) > 0) - ((d < -tol) > 0)); + + ## Now need to "integrate" this so that the deltas become steps. + r = cumsum (p, dim); + + ## Now add the "steps" to the original data and put output in the + ## same shape as originally. + retval = x + r; + +endfunction + +%!function t = __xassert(a,b,tol) +%! if (nargin == 1) +%! t = all(a(:)); +%! else +%! if (nargin == 2) +%! tol = 0; +%! endif +%! if (any (size(a) != size(b))) +%! t = 0; +%! elseif (any (abs(a(:) - b(:)) > tol)) +%! t = 0; +%! else +%! t = 1; +%! endif +%! endif +%!endfunction +%! +%!test +%! +%! i = 0; +%! t = []; +%! +%! r = [0:100]; # original vector +%! w = r - 2*pi*floor((r+pi)/(2*pi)); # wrapped into [-pi,pi] +%! tol = 1e3*eps; # maximum expected deviation +%! +%! t(++i) = __xassert(r, unwrap(w), tol); #unwrap single row +%! t(++i) = __xassert(r', unwrap(w'), tol); #unwrap single column +%! t(++i) = __xassert([r',r'], unwrap([w',w']), tol); #unwrap 2 columns +%! t(++i) = __xassert([r;r], unwrap([w;w],[],2), tol); #check that dim works +%! t(++i) = __xassert(r+10, unwrap(10+w), tol); #check r(1)>pi works +%! +%! t(++i) = __xassert(w', unwrap(w',[],2)); #unwrap col by rows should not change it +%! t(++i) = __xassert(w, unwrap(w,[],1)); #unwrap row by cols should not change it +%! t(++i) = __xassert([w;w], unwrap([w;w])); #unwrap 2 rows by cols should not change them +%! +%! ## verify that setting tolerance too low will cause bad results. +%! t(++i) = __xassert(any(abs(r - unwrap(w,0.8)) > 100)); +%! +%! assert(all(t)); +%! +%!test +%! A = [pi*(-4), pi*(-2+1/6), pi/4, pi*(2+1/3), pi*(4+1/2), pi*(8+2/3), pi*(16+1), pi*(32+3/2), pi*64]; +%! assert (unwrap(A), unwrap(A, pi)); +%! assert (unwrap(A, pi), unwrap(A, pi, 2)); +%! assert (unwrap(A', pi), unwrap(A', pi, 1)); +%! +%!test +%! A = [pi*(-4); pi*(2+1/3); pi*(16+1)]; +%! B = [pi*(-2+1/6); pi*(4+1/2); pi*(32+3/2)]; +%! C = [pi/4; pi*(8+2/3); pi*64]; +%! D = [pi*(-2+1/6); pi*(2+1/3); pi*(8+2/3)]; +%! E(:, :, 1) = [A, B, C, D]; +%! E(:, :, 2) = [A+B, B+C, C+D, D+A]; +%! F(:, :, 1) = [unwrap(A), unwrap(B), unwrap(C), unwrap(D)]; +%! F(:, :, 2) = [unwrap(A+B), unwrap(B+C), unwrap(C+D), unwrap(D+A)]; +%! assert (unwrap(E), F); +%! +%!test +%! A = [0, 2*pi, 4*pi, 8*pi, 16*pi, 65536*pi]; +%! B = [pi*(-2+1/6), pi/4, pi*(2+1/3), pi*(4+1/2), pi*(8+2/3), pi*(16+1), pi*(32+3/2), pi*64]; +%! assert (unwrap(A), zeros(1, length(A))); +%! assert (diff(unwrap(B), 1)<2*pi, true(1, length(B)-1)); +%! +%!error unwrap() diff --git a/octave_packages/m/signal/yulewalker.m b/octave_packages/m/signal/yulewalker.m new file mode 100644 index 0000000..66e34ed --- /dev/null +++ b/octave_packages/m/signal/yulewalker.m @@ -0,0 +1,60 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{a}, @var{v}] =} yulewalker (@var{c}) +## Fit an AR (p)-model with Yule-Walker estimates given a vector @var{c} +## of autocovariances @code{[gamma_0, @dots{}, gamma_p]}. +## +## Returns the AR coefficients, @var{a}, and the variance of white +## noise, @var{v}. +## @end deftypefn + +## Author: FL +## Description: Fit AR model by Yule-Walker method + +function [a, v] = yulewalker (c) + + if (nargin != 1) + print_usage (); + endif + + p = length (c) - 1; + + if (columns (c) > 1) + c = c'; + endif + + cp = c(2 : p+1); + CP = zeros(p, p); + + for i = 1:p + for j = 1:p + CP (i, j) = c (abs (i-j) + 1); + endfor + endfor + + a = inv (CP) * cp; + v = c(1) - a' * cp; + +endfunction + + + + + diff --git a/octave_packages/m/sparse/bicg.m b/octave_packages/m/sparse/bicg.m new file mode 100644 index 0000000..854c62b --- /dev/null +++ b/octave_packages/m/sparse/bicg.m @@ -0,0 +1,262 @@ +## Copyright (C) 2006 Sylvain Pelissier +## Copyright (C) 2012 Carlo de Falco +## +## This program is free software; you can redistribute it and/or modify +## it under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 2 of the License, or +## (at your option) any later version. +## +## This program is distributed in the hope that it will be useful, +## but WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +## GNU General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with this program; If not, see . + +## -*- texinfo -*- +## +## @deftypefn {Function File} {@var{x} =} bicg (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} bicg (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} bicg (@var{A}, @var{b}, @dots{}) +## Solve @code{A x = b} using the Bi-conjugate gradient iterative method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given +## or set to [] the default value 1e-6 is used. +## +## @item @var{maxit} the maximum number of outer iterations, +## if not given or set to [] the default value +## @code{min (20, numel (b))} is used. +## +## @item @var{x0} the initial guess, if not given or set to [] +## the default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x, "notransp") = A*x} +## and @code{f(x, "transp") = A'*x}. +## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as +## a function handle or inline function @code{g} such that +## @code{g(x, 'notransp') = M1 \ x} or @code{g(x, 'notransp') = M2 \ x} and +## @code{g(x, 'transp') = M1' \ x} or @code{g(x, 'transp') = M2' \ x}. +## +## If called with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## +## @item 1: the maximum number of iterations was reached before convergence +## +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## +## @item @var{relres} is the final value of the relative residual. +## +## @item @var{iter} is the number of iterations performed. +## +## @item @var{resvec} is a vector containing the relative residual at each iteration. +## @end itemize +## +## @seealso{bicgstab, cgs, gmres, pcg} +## +## @end deftypefn + + +function [x, flag, res1, k, resvec] = bicg (A, b, tol, maxit, M1, M2, x0) + + if (nargin >= 2 && isvector (full (b))) + + if (ischar (A)) + fun = str2func (A); + Ax = @(x) feval (fun, x, "notransp"); + Atx = @(x) feval (fun, x, "transp"); + elseif (ismatrix (A)) + Ax = @(x) A * x; + Atx = @(x) A' * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x, "notransp"); + Atx = @(x) feval (A, x, "transp"); + else + error (["bicg: first argument is expected to " ... + "be a function or a square matrix"]); + endif + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif + + if (nargin < 5 || isempty (M1)) + M1m1x = @(x, ignore) x; + M1tm1x = M1m1x; + elseif (ischar (M1)) + fun = str2func (M1); + M1m1x = @(x) feval (fun, x, "notransp"); + M1tm1x = @(x) feval (fun, x, "transp"); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + M1tm1x = @(x) M1' \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x, "notransp"); + M1tm1x = @(x) feval (M1, x, "transp"); + else + error (["bicg: preconditioner is expected to " ... + "be a function or matrix"]); + endif + + if (nargin < 6 || isempty (M2)) + M2m1x = @(x, ignore) x; + M2tm1x = M2m1x; + elseif (ischar (M2)) + fun = str2func (M2); + M2m1x = @(x) feval (fun, x, "notransp"); + M2tm1x = @(x) feval (fun, x, "transp"); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + M2tm1x = @(x) M2' \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x, "notransp"); + M2tm1x = @(x) feval (M2, x, "transp"); + else + error (["bicg: preconditioner is expected to " ... + "be a function or matrix"]); + endif + + Pm1x = @(x) M2m1x (M1m1x (x)); + Ptm1x = @(x) M1tm1x (M2tm1x (x)); + + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif + + y = x = x0; + c = b; + + r0 = b - Ax (x); + s0 = c - Atx (y); + + d = Pm1x (r0); + f = Ptm1x (s0); + + bnorm = norm (b); + res0 = Inf; + + if (any (r0 != 0)) + + for k = 1:maxit + + a = (s0' * Pm1x (r0)) ./ (f' * Ax (d)); + + x += a * d; + y += conj (a) * f; + + r1 = r0 - a * Ax (d); + s1 = s0 - conj (a) * Atx (f); + + beta = (s1' * Pm1x (r1)) ./ (s0' * Pm1x (r0)); + + d = Pm1x (r1) + beta * d; + f = Ptm1x (s1) + conj (beta) * f; + + r0 = r1; + s0 = s1; + + res1 = norm (b - Ax (x)) / bnorm; + if (res1 < tol) + flag = 0; + if (nargout < 2) + printf ("bicg converged at iteration %i ", k); + printf ("to a solution with relative residual %e\n", res1); + endif + break; + endif + + if (res0 <= res1) + flag = 3; + printf ("bicg stopped at iteration %i ", k); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the method stagnated.\n"); + printf ("The iterate returned (number %i) ", k-1); + printf ("has relative residual %e\n", res0); + break + endif + res0 = res1; + if (nargout > 4) + resvec(k) = res0; + endif + endfor + + if (k == maxit) + flag = 1; + printf ("bicg stopped at iteration %i ", maxit); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the maximum number of iterations was reached. "); + printf ("The iterate returned (number %i) has ", maxit); + printf ("relative residual %e\n", res1); + endif + + else + flag = 0; + if (nargout < 2) + printf ("bicg converged after 0 interations\n"); + endif + endif + + else + print_usage (); + endif + +endfunction; + + +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! [x, flag, relres, iter, resvec] = bicg (A, b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); +%! + +%!function y = afun (x, t, a) +%! switch t +%! case "notransp" +%! y = a * x; +%! case "transp" +%! y = a' * x; +%! endswitch +%!endfunction +%! +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! +%! [x, flag, relres, iter, resvec] = bicg (@(x, t) afun (x, t, A), +%! b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a' * a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = bicg (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7); diff --git a/octave_packages/m/sparse/bicgstab.m b/octave_packages/m/sparse/bicgstab.m new file mode 100644 index 0000000..3a585dc --- /dev/null +++ b/octave_packages/m/sparse/bicgstab.m @@ -0,0 +1,247 @@ +## Copyright (C) 2008-2012 Radek Salac +## Copyright (C) 2012 Carlo de Falco +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## +## @deftypefn {Function File} {@var{x} =} bicgstab (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} bicgstab (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} bicgstab (@var{A}, @var{b}, @dots{}) +## Solve @code{A x = b} using the stabilizied Bi-conjugate gradient iterative +## method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given or set to +## [] the default value 1e-6 is used. +## +## @item @var{maxit} the maximum number of outer iterations, if not +## given or set to [] the default value @code{min (20, numel (b))} is +## used. +## +## @item @var{x0} the initial guess, if not given or set to [] the +## default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x) = A*x}. +## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as a function +## handle or inline function @code{g} such that @code{g(x) = M1 \ x} or +## @code{g(x) = M2 \ x}. +## +## If called with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## +## @item 1: the maximum number of iterations was reached before convergence +## +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## +## @item @var{relres} is the final value of the relative residual. +## +## @item @var{iter} is the number of iterations performed. +## +## @item @var{resvec} is a vector containing the relative residual at each iteration. +## @end itemize +## +## @seealso{bicg, cgs, gmres, pcg} +## +## @end deftypefn + +function [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, + M1, M2, x0) + + if (nargin >= 2 && nargin <= 7 && isvector (full (b))) + + if (ischar (A)) + A = str2func (A); + elseif (ismatrix (A)) + Ax = @(x) A * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x); + else + error (["bicgstab: first argument is expected " ... + "to be a function or a square matrix"]); + endif + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif + + if (nargin < 5 || isempty (M1)) + M1m1x = @(x) x; + elseif (ischar (M1)) + M1m1x = str2func (M1); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x); + else + error (["bicgstab: preconditioner is " ... + "expected to be a function or matrix"]); + endif + + if (nargin < 6 || isempty (M2)) + M2m1x = @(x) x; + elseif (ischar (M2)) + M2m1x = str2func (M2); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x); + else + error (["bicgstab: preconditioner is "... + "expected to be a function or matrix"]); + endif + + precon = @(x) M2m1x (M1m1x (x)); + + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif + + ## specifies initial estimate x0 + if (nargin < 7) + x = zeros (rows (b), 1); + else + x = x0; + endif + + norm_b = norm (b); + + res = b - Ax (x); + rr = res; + + ## Vector of the residual norms for each iteration. + resvec = norm(res) / norm_b; + + ## Default behaviour we don't reach tolerance tol within maxit iterations. + flag = 1; + + for iter = 1:maxit + rho_1 = res' * rr; + + if (iter == 1) + p = res; + else + beta = (rho_1 / rho_2) * (alpha / omega); + p = res + beta * (p - omega * v); + endif + + phat = precon (p); + + v = Ax (phat); + alpha = rho_1 / (rr' * v); + s = res - alpha * v; + + shat = precon (s); + + t = Ax (shat); + omega = (t' * s) / (t' * t); + x = x + alpha * phat + omega * shat; + res = s - omega * t; + rho_2 = rho_1; + + relres = norm (res) / norm_b; + resvec = [resvec; relres]; + + if (relres <= tol) + ## We reach tolerance tol within maxit iterations. + flag = 0; + break; + elseif (resvec(end) == resvec(end - 1)) + ## The method stagnates. + flag = 3; + break; + endif + endfor + + if (nargout < 2) + if (flag == 0) + printf ("bicgstab converged at iteration %i ", iter); + printf ("to a solution with relative residual %e\n", relres); + elseif (flag == 3) + printf ("bicgstab stopped at iteration %i ", iter); + printf ("without converging to the desired tolerance %e\n", tol); + printf ("because the method stagnated.\n"); + printf ("The iterate returned (number %i) ", iter); + printf ("has relative residual %e\n", relres); + else + printf ("bicgstab stopped at iteration %i ", iter); + printf ("without converging to the desired toleranc %e\n", tol); + printf ("because the maximum number of iterations was reached.\n"); + printf ("The iterate returned (number %i) ", iter); + printf ("has relative residual %e\n", relres); + endif + endif + + else + print_usage (); + endif + +endfunction + +%!demo +%! % Solve system of A*x=b +%! A = [5 -1 3;-1 2 -2;3 -2 3] +%! b = [7;-1;4] +%! [x, flag, relres, iter, resvec] = bicgstab(A, b) + +%!shared A, b, n, M1, M2 +%! +%!test +%! n = 100; +%! A = spdiags ([-2*ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 15; +%! M1 = spdiags ([ones(n,1)/(-2) ones(n,1)],-1:0, n, n); +%! M2 = spdiags ([4*ones(n,1) -ones(n,1)], 0:1, n, n); +%! [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); +%! +%!test +%!function y = afun (x, a) +%! y = a * x; +%!endfunction +%! +%! tol = 1e-8; +%! maxit = 15; +%! +%! [x, flag, relres, iter, resvec] = bicgstab (@(x) afun (x, A), b, +%! tol, maxit, M1, M2); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a'*a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = bicgstab (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7); diff --git a/octave_packages/m/sparse/cgs.m b/octave_packages/m/sparse/cgs.m new file mode 100644 index 0000000..9704c12 --- /dev/null +++ b/octave_packages/m/sparse/cgs.m @@ -0,0 +1,225 @@ +## Copyright (C) 2008-2012 Radek Salac +## Copyright (C) 2012 Carlo de Falco +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## +## @deftypefn {Function File} {@var{x} =} cgs (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} cgs (@var{A}, @var{b}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} cgs (@var{A}, @var{b}, @dots{}) +## Solve @code{A x = b}, where @var{A} is a square matrix, using the +## Conjugate Gradients Squared method. +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, if not given or set to [] +## the default value 1e-6 is used. +## +## @item @var{maxit} the maximum number of outer iterations, if not +## given or set to [] the default value @code{min (20, numel (b))} is +## used. +## +## @item @var{x0} the initial guess, if not given or set to [] the +## default value @code{zeros (size (b))} is used. +## @end itemize +## +## @var{A} can be passed as a matrix or as a function handle or +## inline function @code{f} such that @code{f(x) = A*x}. +## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix or as a function +## handle or inline function @code{g} such that @code{g(x) = M1 \ x} or +## @code{g(x) = M2 \ x}. +## +## If called with more than one output parameter +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @itemize @minus +## @item 0: iteration converged to the within the chosen tolerance +## +## @item 1: the maximum number of iterations was reached before convergence +## +## @item 3: the algorithm reached stagnation +## @end itemize +## (the value 2 is unused but skipped for compatibility). +## +## @item @var{relres} is the final value of the relative residual. +## +## @item @var{iter} is the number of iterations performed. +## +## @item @var{resvec} is a vector containing the relative residual at +## each iteration. +## @end itemize +## +## @seealso{pcg, bicgstab, bicg, gmres} +## @end deftypefn + +function [x, flag, relres, iter, resvec] = cgs (A, b, tol, maxit, M1, M2, x0) + + if (nargin >= 2 && nargin <= 7 && isvector (full (b))) + + if (ischar (A)) + A = str2func (A); + elseif (ismatrix (A)) + Ax = @(x) A * x; + elseif (isa (A, "function_handle")) + Ax = @(x) feval (A, x); + else + error (["cgs: first argument is expected to "... + "be a function or a square matrix"]); + endif + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = min (rows (b), 20); + endif + + if (nargin < 5 || isempty (M1)) + M1m1x = @(x) x; + elseif (ischar (M1)) + M1m1x = str2func (M1); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + elseif (isa (M1, "function_handle")) + M1m1x = @(x) feval (M1, x); + else + error ("cgs: preconditioner is expected to be a function or matrix"); + endif + + if (nargin < 6 || isempty (M2)) + M2m1x = @(x) x; + elseif (ischar (M2)) + M2m1x = str2func (M2); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + elseif (isa (M2, "function_handle")) + M2m1x = @(x) feval (M2, x); + else + error ("cgs: preconditioner is expected to be a function or matrix"); + endif + + precon = @(x) M2m1x (M1m1x (x)); + + if (nargin < 7 || isempty (x0)) + x0 = zeros (size (b)); + endif + + + x = x0; + + res = b - Ax (x); + norm_b = norm (b); + ## Vector of the residual norms for each iteration. + resvec = norm (res) / norm_b; + ro = 0; + ## Default behavior we don't reach tolerance tol within maxit iterations. + flag = 1; + for iter = 1:maxit + + z = precon (res); + + ## Cache. + ro_old = ro; + ro = res' * z; + if (iter == 1) + p = z; + else + beta = ro / ro_old; + p = z + beta * p; + endif + ## Cache. + q = Ax (p); + alpha = ro / (p' * q); + x = x + alpha * p; + + res = res - alpha * q; + relres = norm (res) / norm_b; + resvec = [resvec; relres]; + + if (relres <= tol) + ## We reach tolerance tol within maxit iterations. + flag = 0; + break + elseif (resvec (end) == resvec (end - 1)) + ## The method stagnates. + flag = 3; + break + endif + endfor + + if (nargout < 1) + if (flag == 0) + printf ("cgs converged at iteration %i to a solution with relative residual %e\n", + iter, relres); + elseif (flag == 3) + printf (["cgs stopped at iteration %i without converging to the desired tolerance %e\n", + "because the method stagnated.\n", + "The iterate returned (number %i) has relative residual %e\n"], + iter, tol, iter, relres); + else + printf (["cgs stopped at iteration %i without converging to the desired tolerance %e\n", + "because the maximum number of iterations was reached.\n", + "The iterate returned (number %i) has relative residual %e\n"], + iter, tol, iter, relres); + endif + endif + + else + print_usage (); + endif + +endfunction + + + +%!demo +%! % Solve system of A*x=b +%! A=[5 -1 3;-1 2 -2;3 -2 3] +%! b=[7;-1;4] +%! [a,b,c,d,e]=cgs(A,b) + +%!shared A, b, n, M +%! +%!test +%! n = 100; +%! A = spdiags ([-ones(n,1) 4*ones(n,1) -ones(n,1)], -1:1, n, n); +%! b = sum (A, 2); +%! tol = 1e-8; +%! maxit = 1000; +%! M = 4*eye (n); +%! [x, flag, relres, iter, resvec] = cgs (A, b, tol, maxit, M); +%! assert (x, ones (size (b)), 1e-7); +%! +%!test +%! tol = 1e-8; +%! maxit = 15; +%! +%! [x, flag, relres, iter, resvec] = cgs (@(x) A * x, b, tol, maxit, M); +%! assert (x, ones (size (b)), 1e-7); + +%!test +%! n = 100; +%! tol = 1e-8; +%! a = sprand (n, n, .1); +%! A = a'*a + 100 * eye (n); +%! b = sum (A, 2); +%! [x, flag, relres, iter, resvec] = cgs (A, b, tol, [], diag (diag (A))); +%! assert (x, ones (size (b)), 1e-7); diff --git a/octave_packages/m/sparse/colperm.m b/octave_packages/m/sparse/colperm.m new file mode 100644 index 0000000..0960e95 --- /dev/null +++ b/octave_packages/m/sparse/colperm.m @@ -0,0 +1,37 @@ +## Copyright (C) 2004-2012 David Bateman and Andy Adler +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} colperm (@var{s}) +## Return the column permutations such that the columns of +## @code{@var{s} (:, @var{p})} are ordered in terms of increase number +## of non-zero elements. If @var{s} is symmetric, then @var{p} is chosen +## such that @code{@var{s} (@var{p}, @var{p})} orders the rows and +## columns with increasing number of non zeros elements. +## @end deftypefn + +function p = colperm (s) + + if (nargin != 1) + print_usage (); + endif + + [i, j] = find (s); + idx = find (diff ([j; Inf]) != 0); + [dummy, p] = sort (idx - [0; idx(1:(end-1))]); +endfunction diff --git a/octave_packages/m/sparse/etreeplot.m b/octave_packages/m/sparse/etreeplot.m new file mode 100644 index 0000000..4111c1d --- /dev/null +++ b/octave_packages/m/sparse/etreeplot.m @@ -0,0 +1,36 @@ +## Copyright (C) 2005-2012 Ivana Varekova +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} etreeplot (@var{A}) +## @deftypefnx {Function File} {} etreeplot (@var{A}, @var{node_style}, @var{edge_style}) +## Plot the elimination tree of the matrix @var{A} or +## @xcode{@var{A}+@var{A}'} if @var{A} in not symmetric. The optional +## parameters @var{node_style} and @var{edge_style} define the output +## style. +## @seealso{treeplot, gplot} +## @end deftypefn + +function etreeplot (A, varargin) + + if (nargin < 1) + print_usage (); + endif + + treeplot (etree (A+A'), varargin{:}); +endfunction diff --git a/octave_packages/m/sparse/gmres.m b/octave_packages/m/sparse/gmres.m new file mode 100644 index 0000000..350c944 --- /dev/null +++ b/octave_packages/m/sparse/gmres.m @@ -0,0 +1,218 @@ +## Copyright (C) 2009-2012 Carlo de Falco +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by the +## Free Software Foundation; either version 3 of the License, or (at your +## option) any later version. +## +## Octave is distributed in the hope that it will be useful, but WITHOUT +## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +## FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +## for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} gmres (@var{A}, @var{b}, @var{m}, @var{rtol}, @var{maxit}, @var{M1}, @var{M2}, @var{x0}) +## @deftypefnx {Function File} {@var{x} =} gmres (@var{A}, @var{b}, @var{m}, @var{rtol}, @var{maxit}, @var{P}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} gmres (@dots{}) +## Solve @code{A x = b} using the Preconditioned GMRES iterative method +## with restart, a.k.a. PGMRES(m). +## +## @itemize @minus +## @item @var{rtol} is the relative tolerance, +## if not given or set to [] the default value 1e-6 is used. +## +## @item @var{maxit} is the maximum number of outer iterations, +## if not given or set to [] the default value +## @code{min (10, numel (b) / restart)} is used. +## +## @item @var{x0} is the initial guess, +## if not given or set to [] the default value @code{zeros(size (b))} is used. +## +## @item @var{m} is the restart parameter, +## if not given or set to [] the default value @code{numel (b)} is used. +## @end itemize +## +## Argument @var{A} can be passed as a matrix, function handle, or +## inline function @code{f} such that @code{f(x) = A*x}. +## +## The preconditioner @var{P} is given as @code{P = M1 * M2}. +## Both @var{M1} and @var{M2} can be passed as a matrix, function handle, or +## inline function @code{g} such that @code{g(x) = M1\x} or @code{g(x) = M2\x}. +## +## Besides the vector @var{x}, additional outputs are: +## +## @itemize @minus +## @item @var{flag} indicates the exit status: +## @table @asis +## @item 0 : iteration converged to within the specified tolerance +## +## @item 1 : maximum number of iterations exceeded +## +## @item 2 : unused, but skipped for compatibility +## +## @item 3 : algorithm reached stagnation +## @end table +## +## @item @var{relres} is the final value of the relative residual. +## +## @item @var{iter} is a vector containing the number of outer iterations and +## total iterations performed. +## +## @item @var{resvec} is a vector containing the relative residual at each +## iteration. +## @end itemize +## +## @seealso{bicg, bicgstab, cgs, pcg} +## @end deftypefn + +function [x, flag, presn, it, resids] = gmres (A, b, restart, rtol, maxit, M1, M2, x0) + + if (nargin < 2 || nargin > 8) + print_usage (); + endif + + if (ischar (A)) + Ax = str2func (A); + elseif (ismatrix (A)) + Ax = @(x) A*x; + elseif (isa (A, "function_handle")) + Ax = A; + else + error ("gmres: A must be a function or matrix"); + endif + + if (nargin < 3 || isempty (restart)) + restart = rows (b); + endif + + if (nargin < 4 || isempty (rtol)) + rtol = 1e-6; + endif + + if (nargin < 5 || isempty (maxit)) + maxit = min (rows (b)/restart, 10); + endif + + if (nargin < 6 || isempty (M1)) + M1m1x = @(x) x; + elseif (ischar (M1)) + M1m1x = str2func (M1); + elseif (ismatrix (M1)) + M1m1x = @(x) M1 \ x; + elseif (isa (M1, "function_handle")) + M1m1x = M1; + else + error ("gmres: preconditioner M1 must be a function or matrix"); + endif + + if (nargin < 7 || isempty (M2)) + M2m1x = @(x) x; + elseif (ischar (M2)) + M2m1x = str2func (M2); + elseif (ismatrix (M2)) + M2m1x = @(x) M2 \ x; + elseif (isa (M2, "function_handle")) + M2m1x = M2; + else + error ("gmres: preconditioner M2 must be a function or matrix"); + endif + + Pm1x = @(x) M2m1x (M1m1x (x)); + + if (nargin < 8 || isempty (x0)) + x0 = zeros (size (b)); + endif + + x_old = x0; + x = x_old; + prec_res = Pm1x (b - Ax (x_old)); + presn = norm (prec_res, 2); + + B = zeros (restart + 1, 1); + V = zeros (rows (x), restart); + H = zeros (restart + 1, restart); + + ## begin loop + iter = 1; + restart_it = restart + 1; + resids = zeros (maxit, 1); + resids(1) = presn; + prec_b_norm = norm (Pm1x (b), 2); + flag = 1; + + while (iter <= maxit * restart && presn > rtol * prec_b_norm) + + ## restart + if (restart_it > restart) + restart_it = 1; + x_old = x; + prec_res = Pm1x (b - Ax (x_old)); + presn = norm (prec_res, 2); + B(1) = presn; + H(:) = 0; + V(:, 1) = prec_res / presn; + endif + + ## basic iteration + tmp = Pm1x (Ax (V(:, restart_it))); + [V(:,restart_it+1), H(1:restart_it+1, restart_it)] = ... + mgorth (tmp, V(:,1:restart_it)); + + Y = (H(1:restart_it+1, 1:restart_it) \ B (1:restart_it+1)); + + little_res = B(1:restart_it+1) - ... + H(1:restart_it+1, 1:restart_it) * Y(1:restart_it); + + presn = norm (little_res, 2); + + x = x_old + V(:, 1:restart_it) * Y(1:restart_it); + + resids(iter) = presn; + if (norm (x - x_old, inf) <= eps) + flag = 3; + break + endif + + restart_it++ ; + iter++; + endwhile + + if (presn > rtol * prec_b_norm) + flag = 0; + endif + + resids = resids(1:iter-1); + it = [ceil(iter / restart), rem(iter, restart)]; + +endfunction + + +%!shared A, b, dim +%! dim = 100; +%!test +%! A = spdiags ([-ones(dim,1) 2*ones(dim,1) ones(dim,1)], [-1:1], dim, dim); +%! b = ones(dim, 1); +%! x = gmres (A, b, 10, 1e-10, dim, @(x) x./diag(A), [], b); +%! assert(x, A\b, 1e-9*norm(x,inf)); +%! +%!test +%! x = gmres (A, b, dim, 1e-10, 1e4, @(x) diag(diag(A))\x, [], b); +%! assert(x, A\b, 1e-7*norm(x,inf)); +%! +%!test +%! A = spdiags ([[1./(2:2:2*(dim-1)) 0]; 1./(1:2:2*dim-1); [0 1./(2:2:2*(dim-1))]]', -1:1, dim, dim); +%! A = A'*A; +%! b = rand (dim, 1); +%! [x, resids] = gmres (@(x) A*x, b, dim, 1e-10, dim, @(x) x./diag(A), [], []); +%! assert(x, A\b, 1e-9*norm(x,inf)) +%! x = gmres (@(x) A*x, b, dim, 1e-10, 1e6, @(x) diag(diag(A))\x, [], []); +%! assert(x, A\b, 1e-9*norm(x,inf)); +%!test +%! x = gmres (@(x) A*x, b, dim, 1e-10, 1e6, @(x) x./diag(A), [], []); +%! assert(x, A\b, 1e-7*norm(x,inf)); diff --git a/octave_packages/m/sparse/gplot.m b/octave_packages/m/sparse/gplot.m new file mode 100644 index 0000000..68b3be2 --- /dev/null +++ b/octave_packages/m/sparse/gplot.m @@ -0,0 +1,84 @@ +## Copyright (C) 2005-2012 Ivana Varekova +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gplot (@var{A}, @var{xy}) +## @deftypefnx {Function File} {} gplot (@var{A}, @var{xy}, @var{line_style}) +## @deftypefnx {Function File} {[@var{x}, @var{y}] =} gplot (@var{A}, @var{xy}) +## Plot a graph defined by @var{A} and @var{xy} in the graph theory +## sense. @var{A} is the adjacency matrix of the array to be plotted +## and @var{xy} is an @var{n}-by-2 matrix containing the coordinates of +## the nodes of the graph. +## +## The optional parameter @var{line_style} defines the output style for +## the plot. Called with no output arguments the graph is plotted +## directly. Otherwise, return the coordinates of the plot in @var{x} +## and @var{y}. +## @seealso{treeplot, etreeplot, spy} +## @end deftypefn + +function [x, y] = gplot (A, xy, line_style) + + if (nargin < 2 || nargin > 3 || nargout > 2) + print_usage (); + endif + + if (nargin == 2) + line_style = "-"; + endif + + [i, j] = find (A); + xcoord = [xy(i,1), xy(j,1), NaN(length(i),1) ]'(:); + ycoord = [xy(i,2), xy(j,2), NaN(length(i),1) ]'(:); + + if (nargout == 0) + plot (xcoord, ycoord, line_style); + else + x = xcoord; + y = ycoord; + endif + +endfunction + + +%!demo +%! ## Binary Tree Representation +%! A = [0 1 0 0 0 0 0 +%! 1 0 1 1 0 0 0 +%! 0 1 0 0 0 0 0 +%! 0 1 0 0 1 0 0 +%! 0 0 0 1 0 1 1 +%! 0 0 0 0 1 0 0 +%! 0 0 0 0 1 0 0]; +%! +%! xy = [1, 0 +%! 1.5, 1 +%! 2, 0 +%! 2.5, 2 +%! 3.5, 1 +%! 3, 0 +%! 4, 0]; +%! +%! clf; +%! gplot (A, xy, "o-"); +%! set (get (gca, ("children")), "markersize", 12); +%! title ("gplot() of Binary Tree Adjacency matrix"); + +%% Mark graphical function as tested by demo block +%!assert (1); + diff --git a/octave_packages/m/sparse/nonzeros.m b/octave_packages/m/sparse/nonzeros.m new file mode 100644 index 0000000..aeb6fdc --- /dev/null +++ b/octave_packages/m/sparse/nonzeros.m @@ -0,0 +1,40 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nonzeros (@var{s}) +## Return a vector of the non-zero values of the sparse matrix @var{s}. +## @end deftypefn + +function t = nonzeros (s) + + if (nargin != 1) + print_usage (); + endif + + [~, ~, t] = find (s); + + t = t(:); + +endfunction + + +%!assert(nonzeros([1,2;3,0]),[1;3;2]) +%!assert(nonzeros([1,2,3,0]),[1;2;3]) +%!assert(nonzeros(sparse([1,2;3,0])),[1;3;2]) +%!assert(nonzeros(sparse([1,2,3,0])),[1;2;3]) diff --git a/octave_packages/m/sparse/pcg.m b/octave_packages/m/sparse/pcg.m new file mode 100644 index 0000000..da2f49e --- /dev/null +++ b/octave_packages/m/sparse/pcg.m @@ -0,0 +1,532 @@ +## Copyright (C) 2004-2012 Piotr Krzyzanowski +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} pcg (@var{A}, @var{b}, @var{tol}, @var{maxit}, @var{m1}, @var{m2}, @var{x0}, @dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}, @var{eigest}] =} pcg (@dots{}) +## +## Solve the linear system of equations @code{@var{A} * @var{x} = @var{b}} +## by means of the Preconditioned Conjugate Gradient iterative +## method. The input arguments are +## +## @itemize +## @item +## @var{A} can be either a square (preferably sparse) matrix or a +## function handle, inline function or string containing the name +## of a function which computes @code{@var{A} * @var{x}}. In principle +## @var{A} should be symmetric and positive definite; if @code{pcg} +## finds @var{A} to not be positive definite, you will get a warning +## message and the @var{flag} output parameter will be set. +## +## @item +## @var{b} is the right hand side vector. +## +## @item +## @var{tol} is the required relative tolerance for the residual error, +## @code{@var{b} - @var{A} * @var{x}}. The iteration stops if +## @code{norm (@var{b} - @var{A} * @var{x}) <= +## @var{tol} * norm (@var{b} - @var{A} * @var{x0})}. +## If @var{tol} is empty or is omitted, the function sets +## @code{@var{tol} = 1e-6} by default. +## +## @item +## @var{maxit} is the maximum allowable number of iterations; if +## @code{[]} is supplied for @code{maxit}, or @code{pcg} has less +## arguments, a default value equal to 20 is used. +## +## @item +## @var{m} = @var{m1} * @var{m2} is the (left) preconditioning matrix, so that +## the iteration is (theoretically) equivalent to solving by @code{pcg} +## @code{@var{P} * +## @var{x} = @var{m} \ @var{b}}, with @code{@var{P} = @var{m} \ @var{A}}. +## Note that a proper choice of the preconditioner may dramatically +## improve the overall performance of the method. Instead of matrices +## @var{m1} and @var{m2}, the user may pass two functions which return +## the results of applying the inverse of @var{m1} and @var{m2} to +## a vector (usually this is the preferred way of using the preconditioner). +## If @code{[]} is supplied for @var{m1}, or @var{m1} is omitted, no +## preconditioning is applied. If @var{m2} is omitted, @var{m} = @var{m1} +## will be used as preconditioner. +## +## @item +## @var{x0} is the initial guess. If @var{x0} is empty or omitted, the +## function sets @var{x0} to a zero vector by default. +## @end itemize +## +## The arguments which follow @var{x0} are treated as parameters, and +## passed in a proper way to any of the functions (@var{A} or @var{m}) +## which are passed to @code{pcg}. See the examples below for further +## details. The output arguments are +## +## @itemize +## @item +## @var{x} is the computed approximation to the solution of +## @code{@var{A} * @var{x} = @var{b}}. +## +## @item +## @var{flag} reports on the convergence. @code{@var{flag} = 0} means +## the solution converged and the tolerance criterion given by @var{tol} +## is satisfied. @code{@var{flag} = 1} means that the @var{maxit} limit +## for the iteration count was reached. @code{@var{flag} = 3} reports that +## the (preconditioned) matrix was found not positive definite. +## +## @item +## @var{relres} is the ratio of the final residual to its initial value, +## measured in the Euclidean norm. +## +## @item +## @var{iter} is the actual number of iterations performed. +## +## @item +## @var{resvec} describes the convergence history of the method. +## @code{@var{resvec} (i,1)} is the Euclidean norm of the residual, and +## @code{@var{resvec} (i,2)} is the preconditioned residual norm, +## after the (@var{i}-1)-th iteration, @code{@var{i} = +## 1, 2, @dots{}, @var{iter}+1}. The preconditioned residual norm +## is defined as +## @code{norm (@var{r}) ^ 2 = @var{r}' * (@var{m} \ @var{r})} where +## @code{@var{r} = @var{b} - @var{A} * @var{x}}, see also the +## description of @var{m}. If @var{eigest} is not required, only +## @code{@var{resvec} (:,1)} is returned. +## +## @item +## @var{eigest} returns the estimate for the smallest @code{@var{eigest} +## (1)} and largest @code{@var{eigest} (2)} eigenvalues of the +## preconditioned matrix @code{@var{P} = @var{m} \ @var{A}}. In +## particular, if no preconditioning is used, the estimates for the +## extreme eigenvalues of @var{A} are returned. @code{@var{eigest} (1)} +## is an overestimate and @code{@var{eigest} (2)} is an underestimate, +## so that @code{@var{eigest} (2) / @var{eigest} (1)} is a lower bound +## for @code{cond (@var{P}, 2)}, which nevertheless in the limit should +## theoretically be equal to the actual value of the condition number. +## The method which computes @var{eigest} works only for symmetric positive +## definite @var{A} and @var{m}, and the user is responsible for +## verifying this assumption. +## @end itemize +## +## Let us consider a trivial problem with a diagonal matrix (we exploit the +## sparsity of A) +## +## @example +## @group +## n = 10; +## A = diag (sparse (1:n)); +## b = rand (n, 1); +## [l, u, p, q] = luinc (A, 1.e-3); +## @end group +## @end example +## +## @sc{Example 1:} Simplest use of @code{pcg} +## +## @example +## x = pcg (A,b) +## @end example +## +## @sc{Example 2:} @code{pcg} with a function which computes +## @code{@var{A} * @var{x}} +## +## @example +## @group +## function y = apply_a (x) +## y = [1:N]' .* x; +## endfunction +## +## x = pcg ("apply_a", b) +## @end group +## @end example +## +## @sc{Example 3:} @code{pcg} with a preconditioner: @var{l} * @var{u} +## +## @example +## x = pcg (A, b, 1.e-6, 500, l*u) +## @end example +## +## @sc{Example 4:} @code{pcg} with a preconditioner: @var{l} * @var{u}. +## Faster than @sc{Example 3} since lower and upper triangular matrices +## are easier to invert +## +## @example +## x = pcg (A, b, 1.e-6, 500, l, u) +## @end example +## +## @sc{Example 5:} Preconditioned iteration, with full diagnostics. The +## preconditioner (quite strange, because even the original matrix +## @var{A} is trivial) is defined as a function +## +## @example +## @group +## function y = apply_m (x) +## k = floor (length (x) - 2); +## y = x; +## y(1:k) = x(1:k) ./ [1:k]'; +## endfunction +## +## [x, flag, relres, iter, resvec, eigest] = ... +## pcg (A, b, [], [], "apply_m"); +## semilogy (1:iter+1, resvec); +## @end group +## @end example +## +## @sc{Example 6:} Finally, a preconditioner which depends on a +## parameter @var{k}. +## +## @example +## @group +## function y = apply_M (x, varargin) +## K = varargin@{1@}; +## y = x; +## y(1:K) = x(1:K) ./ [1:K]'; +## endfunction +## +## [x, flag, relres, iter, resvec, eigest] = ... +## pcg (A, b, [], [], "apply_m", [], [], 3) +## @end group +## @end example +## +## References: +## +## @enumerate +## @item +## C.T. Kelley, @cite{Iterative Methods for Linear and Nonlinear Equations}, +## SIAM, 1995. (the base PCG algorithm) +## +## @item +## Y. Saad, @cite{Iterative Methods for Sparse Linear Systems}, PWS 1996. +## (condition number estimate from PCG) Revised version of this book is +## available online at @url{http://www-users.cs.umn.edu/~saad/books.html} +## @end enumerate +## +## @seealso{sparse, pcr} +## @end deftypefn + +## Author: Piotr Krzyzanowski +## Modified by: Vittoria Rezzonico +## - Add the ability to provide the pre-conditioner as two separate matrices + +function [x, flag, relres, iter, resvec, eigest] = pcg (A, b, tol, maxit, m1, m2, x0, varargin) + + ## M = M1*M2 + + if (nargin < 7 || isempty (x0)) + x = zeros (size (b)); + else + x = x0; + endif + + if (nargin < 5 || isempty (m1)) + exist_m1 = 0; + else + exist_m1 = 1; + endif + + if (nargin < 6 || isempty (m2)) + exist_m2 = 0; + else + exist_m2 = 1; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = min (size (b, 1), 20); + endif + + maxit += 2; + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + preconditioned_residual_out = false; + if (nargout > 5) + T = zeros (maxit, maxit); + preconditioned_residual_out = true; + endif + + ## Assume A is positive definite. + matrix_positive_definite = true; + + p = zeros (size (b)); + oldtau = 1; + if (isnumeric (A)) + ## A is a matrix. + r = b - A*x; + else + ## A should be a function. + r = b - feval (A, x, varargin{:}); + endif + + resvec(1,1) = norm (r); + alpha = 1; + iter = 2; + + while (resvec (iter-1,1) > tol * resvec (1,1) && iter < maxit) + if (exist_m1) + if(isnumeric (m1)) + y = m1 \ r; + else + y = feval (m1, r, varargin{:}); + endif + else + y = r; + endif + if (exist_m2) + if (isnumeric (m2)) + z = m2 \ y; + else + z = feval (m2, y, varargin{:}); + endif + else + z = y; + endif + tau = z' * r; + resvec (iter-1,2) = sqrt (tau); + beta = tau / oldtau; + oldtau = tau; + p = z + beta * p; + if (isnumeric (A)) + ## A is a matrix. + w = A * p; + else + ## A should be a function. + w = feval (A, p, varargin{:}); + endif + ## Needed only for eigest. + oldalpha = alpha; + alpha = tau / (p'*w); + if (alpha <= 0.0) + ## Negative matrix. + matrix_positive_definite = false; + endif + x += alpha * p; + r -= alpha * w; + if (nargout > 5 && iter > 2) + T(iter-1:iter, iter-1:iter) = T(iter-1:iter, iter-1:iter) + ... + [1 sqrt(beta); sqrt(beta) beta]./oldalpha; + ## EVS = eig(T(2:iter-1,2:iter-1)); + ## fprintf(stderr,"PCG condest: %g (iteration: %d)\n", max(EVS)/min(EVS),iter); + endif + resvec (iter,1) = norm (r); + iter++; + endwhile + + if (nargout > 5) + if (matrix_positive_definite) + if (iter > 3) + T = T(2:iter-2,2:iter-2); + l = eig (T); + eigest = [min(l), max(l)]; + ## fprintf (stderr, "pcg condest: %g\n", eigest(2)/eigest(1)); + else + eigest = [NaN, NaN]; + warning ("pcg: eigenvalue estimate failed: iteration converged too fast"); + endif + else + eigest = [NaN, NaN]; + endif + + ## Apply the preconditioner once more and finish with the precond + ## residual. + if (exist_m1) + if (isnumeric (m1)) + y = m1 \ r; + else + y = feval (m1, r, varargin{:}); + endif + else + y = r; + endif + if (exist_m2) + if (isnumeric (m2)) + z = m2 \ y; + else + z = feval (m2, y, varargin{:}); + endif + else + z = y; + endif + + resvec (iter-1,2) = sqrt (r' * z); + else + resvec = resvec(:,1); + endif + + flag = 0; + relres = resvec (iter-1,1) ./ resvec(1,1); + iter -= 2; + if (iter >= maxit - 2) + flag = 1; + if (nargout < 2) + warning ("pcg: maximum number of iterations (%d) reached\n", iter); + warning ("the initial residual norm was reduced %g times.\n", ... + 1.0 / relres); + endif + elseif (nargout < 2) + fprintf (stderr, "pcg: converged in %d iterations. ", iter); + fprintf (stderr, "the initial residual norm was reduced %g times.\n",... + 1.0/relres); + endif + + if (! matrix_positive_definite) + flag = 3; + if (nargout < 2) + warning ("pcg: matrix not positive definite?\n"); + endif + endif +endfunction + +%!demo +%! +%! # Simplest usage of pcg (see also 'help pcg') +%! +%! N = 10; +%! A = diag ([1:N]); b = rand (N, 1); y = A \ b; #y is the true solution +%! x = pcg (A, b); +%! printf('The solution relative error is %g\n', norm (x - y) / norm (y)); +%! +%! # You shouldn't be afraid if pcg issues some warning messages in this +%! # example: watch out in the second example, why it takes N iterations +%! # of pcg to converge to (a very accurate, by the way) solution +%!demo +%! +%! # Full output from pcg, except for the eigenvalue estimates +%! # We use this output to plot the convergence history +%! +%! N = 10; +%! A = diag ([1:N]); b = rand (N, 1); X = A \ b; #X is the true solution +%! [x, flag, relres, iter, resvec] = pcg (A, b); +%! printf('The solution relative error is %g\n', norm (x - X) / norm (X)); +%! title('Convergence history'); xlabel('Iteration'); ylabel('log(||b-Ax||/||b||)'); +%! semilogy([0:iter], resvec / resvec(1),'o-g'); +%! legend('relative residual'); +%!demo +%! +%! # Full output from pcg, including the eigenvalue estimates +%! # Hilbert matrix is extremely ill conditioned, so pcg WILL have problems +%! +%! N = 10; +%! A = hilb (N); b = rand (N, 1); X = A \ b; #X is the true solution +%! [x, flag, relres, iter, resvec, eigest] = pcg (A, b, [], 200); +%! printf('The solution relative error is %g\n', norm (x - X) / norm (X)); +%! printf('Condition number estimate is %g\n', eigest(2) / eigest (1)); +%! printf('Actual condition number is %g\n', cond (A)); +%! title('Convergence history'); xlabel('Iteration'); ylabel('log(||b-Ax||)'); +%! semilogy([0:iter], resvec,['o-g';'+-r']); +%! legend('absolute residual','absolute preconditioned residual'); +%!demo +%! +%! # Full output from pcg, including the eigenvalue estimates +%! # We use the 1-D Laplacian matrix for A, and cond(A) = O(N^2) +%! # and that's the reasone we need some preconditioner; here we take +%! # a very simple and not powerful Jacobi preconditioner, +%! # which is the diagonal of A +%! +%! N = 100; +%! A = zeros (N, N); +%! for i=1 : N - 1 # form 1-D Laplacian matrix +%! A (i:i+1, i:i+1) = [2 -1; -1 2]; +%! endfor +%! b = rand (N, 1); X = A \ b; #X is the true solution +%! maxit = 80; +%! printf('System condition number is %g\n', cond (A)); +%! # No preconditioner: the convergence is very slow! +%! +%! [x, flag, relres, iter, resvec, eigest] = pcg (A, b, [], maxit); +%! printf('System condition number estimate is %g\n', eigest(2) / eigest(1)); +%! title('Convergence history'); xlabel('Iteration'); ylabel('log(||b-Ax||)'); +%! semilogy([0:iter], resvec(:,1), 'o-g'); +%! legend('NO preconditioning: absolute residual'); +%! +%! pause(1); +%! # Test Jacobi preconditioner: it will not help much!!! +%! +%! M = diag (diag (A)); # Jacobi preconditioner +%! [x, flag, relres, iter, resvec, eigest] = pcg (A, b, [], maxit, M); +%! printf('JACOBI preconditioned system condition number estimate is %g\n', eigest(2) / eigest(1)); +%! hold on; +%! semilogy([0:iter], resvec(:,1), 'o-r'); +%! legend('NO preconditioning: absolute residual', ... +%! 'JACOBI preconditioner: absolute residual'); +%! +%! pause(1); +%! # Test nonoverlapping block Jacobi preconditioner: it will help much! +%! +%! M = zeros (N, N); k = 4; +%! for i = 1 : k : N # form 1-D Laplacian matrix +%! M (i:i+k-1, i:i+k-1) = A (i:i+k-1, i:i+k-1); +%! endfor +%! [x, flag, relres, iter, resvec, eigest] = pcg (A, b, [], maxit, M); +%! printf('BLOCK JACOBI preconditioned system condition number estimate is %g\n', eigest(2) / eigest(1)); +%! semilogy ([0:iter], resvec(:,1),'o-b'); +%! legend('NO preconditioning: absolute residual', ... +%! 'JACOBI preconditioner: absolute residual', ... +%! 'BLOCK JACOBI preconditioner: absolute residual'); +%! hold off; +%!test +%! +%! #solve small diagonal system +%! +%! N = 10; +%! A = diag ([1:N]); b = rand (N, 1); X = A \ b; #X is the true solution +%! [x, flag] = pcg (A, b, [], N+1); +%! assert(norm (x - X) / norm (X), 0, 1e-10); +%! assert(flag, 0); +%! +%!test +%! +%! #solve small indefinite diagonal system +%! #despite A is indefinite, the iteration continues and converges +%! #indefiniteness of A is detected +%! +%! N = 10; +%! A = diag([1:N] .* (-ones(1, N) .^ 2)); b = rand (N, 1); X = A \ b; #X is the true solution +%! [x, flag] = pcg (A, b, [], N+1); +%! assert(norm (x - X) / norm (X), 0, 1e-10); +%! assert(flag, 3); +%! +%!test +%! +%! #solve tridiagonal system, do not converge in default 20 iterations +%! +%! N = 100; +%! A = zeros (N, N); +%! for i = 1 : N - 1 # form 1-D Laplacian matrix +%! A (i:i+1, i:i+1) = [2 -1; -1 2]; +%! endfor +%! b = ones (N, 1); X = A \ b; #X is the true solution +%! [x, flag, relres, iter, resvec, eigest] = pcg (A, b, 1e-12); +%! assert(flag); +%! assert(relres > 1.0); +%! assert(iter, 20); #should perform max allowable default number of iterations +%! +%!test +%! +%! #solve tridiagonal system with 'prefect' preconditioner +%! #converges in one iteration, so the eigest does not work +%! #and issues a warning +%! +%! N = 100; +%! A = zeros (N, N); +%! for i = 1 : N - 1 # form 1-D Laplacian matrix +%! A (i:i+1, i:i+1) = [2 -1; -1 2]; +%! endfor +%! b = ones (N, 1); X = A \ b; #X is the true solution +%! [x, flag, relres, iter, resvec, eigest] = pcg (A, b, [], [], A, [], b); +%! assert(norm (x - X) / norm (X), 0, 1e-6); +%! assert(flag, 0); +%! assert(iter, 1); #should converge in one iteration +%! assert(isnan (eigest), isnan ([NaN, NaN])); +%! diff --git a/octave_packages/m/sparse/pcr.m b/octave_packages/m/sparse/pcr.m new file mode 100644 index 0000000..1edb73f --- /dev/null +++ b/octave_packages/m/sparse/pcr.m @@ -0,0 +1,432 @@ +## Copyright (C) 2004-2012 Piotr Krzyzanowski +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} pcr (@var{A}, @var{b}, @var{tol}, @var{maxit}, @var{m}, @var{x0}, @dots{}) +## @deftypefnx {Function File} {[@var{x}, @var{flag}, @var{relres}, @var{iter}, @var{resvec}] =} pcr (@dots{}) +## +## Solve the linear system of equations @code{@var{A} * @var{x} = @var{b}} +## by means of the Preconditioned Conjugate Residuals iterative +## method. The input arguments are +## +## @itemize +## @item +## @var{A} can be either a square (preferably sparse) matrix or a +## function handle, inline function or string containing the name +## of a function which computes @code{@var{A} * @var{x}}. In principle +## @var{A} should be symmetric and non-singular; if @code{pcr} +## finds @var{A} to be numerically singular, you will get a warning +## message and the @var{flag} output parameter will be set. +## +## @item +## @var{b} is the right hand side vector. +## +## @item +## @var{tol} is the required relative tolerance for the residual error, +## @code{@var{b} - @var{A} * @var{x}}. The iteration stops if +## @code{norm (@var{b} - @var{A} * @var{x}) <= +## @var{tol} * norm (@var{b} - @var{A} * @var{x0})}. +## If @var{tol} is empty or is omitted, the function sets +## @code{@var{tol} = 1e-6} by default. +## +## @item +## @var{maxit} is the maximum allowable number of iterations; if +## @code{[]} is supplied for @code{maxit}, or @code{pcr} has less +## arguments, a default value equal to 20 is used. +## +## @item +## @var{m} is the (left) preconditioning matrix, so that the iteration is +## (theoretically) equivalent to solving by @code{pcr} @code{@var{P} * +## @var{x} = @var{m} \ @var{b}}, with @code{@var{P} = @var{m} \ @var{A}}. +## Note that a proper choice of the preconditioner may dramatically +## improve the overall performance of the method. Instead of matrix +## @var{m}, the user may pass a function which returns the results of +## applying the inverse of @var{m} to a vector (usually this is the +## preferred way of using the preconditioner). If @code{[]} is supplied +## for @var{m}, or @var{m} is omitted, no preconditioning is applied. +## +## @item +## @var{x0} is the initial guess. If @var{x0} is empty or omitted, the +## function sets @var{x0} to a zero vector by default. +## @end itemize +## +## The arguments which follow @var{x0} are treated as parameters, and +## passed in a proper way to any of the functions (@var{A} or @var{m}) +## which are passed to @code{pcr}. See the examples below for further +## details. The output arguments are +## +## @itemize +## @item +## @var{x} is the computed approximation to the solution of +## @code{@var{A} * @var{x} = @var{b}}. +## +## @item +## @var{flag} reports on the convergence. @code{@var{flag} = 0} means +## the solution converged and the tolerance criterion given by @var{tol} +## is satisfied. @code{@var{flag} = 1} means that the @var{maxit} limit +## for the iteration count was reached. @code{@var{flag} = 3} reports t +## @code{pcr} breakdown, see [1] for details. +## +## @item +## @var{relres} is the ratio of the final residual to its initial value, +## measured in the Euclidean norm. +## +## @item +## @var{iter} is the actual number of iterations performed. +## +## @item +## @var{resvec} describes the convergence history of the method, +## so that @code{@var{resvec} (i)} contains the Euclidean norms of the +## residual after the (@var{i}-1)-th iteration, @code{@var{i} = +## 1,2, @dots{}, @var{iter}+1}. +## @end itemize +## +## Let us consider a trivial problem with a diagonal matrix (we exploit the +## sparsity of A) +## +## @example +## @group +## n = 10; +## A = sparse (diag (1:n)); +## b = rand (N, 1); +## @end group +## @end example +## +## @sc{Example 1:} Simplest use of @code{pcr} +## +## @example +## x = pcr (A, b) +## @end example +## +## @sc{Example 2:} @code{pcr} with a function which computes +## @code{@var{A} * @var{x}}. +## +## @example +## @group +## function y = apply_a (x) +## y = [1:10]' .* x; +## endfunction +## +## x = pcr ("apply_a", b) +## @end group +## @end example +## +## @sc{Example 3:} Preconditioned iteration, with full diagnostics. The +## preconditioner (quite strange, because even the original matrix +## @var{A} is trivial) is defined as a function +## +## @example +## @group +## function y = apply_m (x) +## k = floor (length (x) - 2); +## y = x; +## y(1:k) = x(1:k) ./ [1:k]'; +## endfunction +## +## [x, flag, relres, iter, resvec] = ... +## pcr (A, b, [], [], "apply_m") +## semilogy ([1:iter+1], resvec); +## @end group +## @end example +## +## @sc{Example 4:} Finally, a preconditioner which depends on a +## parameter @var{k}. +## +## @example +## @group +## function y = apply_m (x, varargin) +## k = varargin@{1@}; +## y = x; +## y(1:k) = x(1:k) ./ [1:k]'; +## endfunction +## +## [x, flag, relres, iter, resvec] = ... +## pcr (A, b, [], [], "apply_m"', [], 3) +## @end group +## @end example +## +## References: +## +## [1] W. Hackbusch, @cite{Iterative Solution of Large Sparse Systems of +## Equations}, section 9.5.4; Springer, 1994 +## +## @seealso{sparse, pcg} +## @end deftypefn + +## Author: Piotr Krzyzanowski + +function [x, flag, relres, iter, resvec] = pcr (A, b, tol, maxit, m, x0, varargin) + + breakdown = false; + + if (nargin < 6 || isempty (x0)) + x = zeros (size (b)); + else + x = x0; + endif + + if (nargin < 5) + m = []; + endif + + if (nargin < 4 || isempty (maxit)) + maxit = 20; + endif + + maxit += 2; + + if (nargin < 3 || isempty (tol)) + tol = 1e-6; + endif + + if (nargin < 2) + print_usage (); + endif + + ## init + if (isnumeric (A)) # is A a matrix? + r = b - A*x; + else # then A should be a function! + r = b - feval (A, x, varargin{:}); + endif + + if (isnumeric (m)) # is M a matrix? + if (isempty (m)) # if M is empty, use no precond + p = r; + else # otherwise, apply the precond + p = m \ r; + endif + else # then M should be a function! + p = feval (m, r, varargin{:}); + endif + + iter = 2; + + b_bot_old = 1; + q_old = p_old = s_old = zeros (size (x)); + + if (isnumeric (A)) # is A a matrix? + q = A * p; + else # then A should be a function! + q = feval (A, p, varargin{:}); + endif + + resvec(1) = abs (norm (r)); + + ## iteration + while (resvec(iter-1) > tol*resvec(1) && iter < maxit) + + if (isnumeric (m)) # is M a matrix? + if (isempty (m)) # if M is empty, use no precond + s = q; + else # otherwise, apply the precond + s = m \ q; + endif + else # then M should be a function! + s = feval (m, q, varargin{:}); + endif + b_top = r' * s; + b_bot = q' * s; + + if (b_bot == 0.0) + breakdown = true; + break; + endif + lambda = b_top / b_bot; + + x += lambda*p; + r -= lambda*q; + + if (isnumeric(A)) # is A a matrix? + t = A*s; + else # then A should be a function! + t = feval (A, s, varargin{:}); + endif + + alpha0 = (t'*s) / b_bot; + alpha1 = (t'*s_old) / b_bot_old; + + p_temp = p; + q_temp = q; + + p = s - alpha0*p - alpha1*p_old; + q = t - alpha0*q - alpha1*q_old; + + s_old = s; + p_old = p_temp; + q_old = q_temp; + b_bot_old = b_bot; + + resvec(iter) = abs (norm (r)); + iter++; + endwhile + + flag = 0; + relres = resvec(iter-1) ./ resvec(1); + iter -= 2; + if (iter >= maxit-2) + flag = 1; + if (nargout < 2) + warning ("pcr: maximum number of iterations (%d) reached\n", iter); + warning ("the initial residual norm was reduced %g times.\n", 1.0/relres); + endif + elseif (nargout < 2 && ! breakdown) + fprintf (stderr, "pcr: converged in %d iterations. \n", iter); + fprintf (stderr, "the initial residual norm was reduced %g times.\n", + 1.0 / relres); + endif + + if (breakdown) + flag = 3; + if (nargout < 2) + warning ("pcr: breakdown occurred:\n"); + warning ("system matrix singular or preconditioner indefinite?\n"); + endif + endif + +endfunction + +%!demo +%! +%! # Simplest usage of PCR (see also 'help pcr') +%! +%! N = 20; +%! A = diag(linspace(-3.1,3,N)); b = rand(N,1); y = A\b; #y is the true solution +%! x = pcr(A,b); +%! printf('The solution relative error is %g\n', norm(x-y)/norm(y)); +%! +%! # You shouldn't be afraid if PCR issues some warning messages in this +%! # example: watch out in the second example, why it takes N iterations +%! # of PCR to converge to (a very accurate, by the way) solution +%!demo +%! +%! # Full output from PCR +%! # We use this output to plot the convergence history +%! +%! N = 20; +%! A = diag(linspace(-3.1,30,N)); b = rand(N,1); X = A\b; #X is the true solution +%! [x, flag, relres, iter, resvec] = pcr(A,b); +%! printf('The solution relative error is %g\n', norm(x-X)/norm(X)); +%! title('Convergence history'); xlabel('Iteration'); ylabel('log(||b-Ax||/||b||)'); +%! semilogy([0:iter],resvec/resvec(1),'o-g;relative residual;'); +%!demo +%! +%! # Full output from PCR +%! # We use indefinite matrix based on the Hilbert matrix, with one +%! # strongly negative eigenvalue +%! # Hilbert matrix is extremely ill conditioned, so is ours, +%! # and that's why PCR WILL have problems +%! +%! N = 10; +%! A = hilb(N); A(1,1)=-A(1,1); b = rand(N,1); X = A\b; #X is the true solution +%! printf('Condition number of A is %g\n', cond(A)); +%! [x, flag, relres, iter, resvec] = pcr(A,b,[],200); +%! if (flag == 3) +%! printf('PCR breakdown. System matrix is [close to] singular\n'); +%! end +%! title('Convergence history'); xlabel('Iteration'); ylabel('log(||b-Ax||)'); +%! semilogy([0:iter],resvec,'o-g;absolute residual;'); +%!demo +%! +%! # Full output from PCR +%! # We use an indefinite matrix based on the 1-D Laplacian matrix for A, +%! # and here we have cond(A) = O(N^2) +%! # That's the reason we need some preconditioner; here we take +%! # a very simple and not powerful Jacobi preconditioner, +%! # which is the diagonal of A +%! +%! # Note that we use here indefinite preconditioners! +%! +%! N = 100; +%! A = zeros(N,N); +%! for i=1:N-1 # form 1-D Laplacian matrix +%! A(i:i+1,i:i+1) = [2 -1; -1 2]; +%! endfor +%! A = [A, zeros(size(A)); zeros(size(A)), -A]; +%! b = rand(2*N,1); X = A\b; #X is the true solution +%! maxit = 80; +%! printf('System condition number is %g\n',cond(A)); +%! # No preconditioner: the convergence is very slow! +%! +%! [x, flag, relres, iter, resvec] = pcr(A,b,[],maxit); +%! title('Convergence history'); xlabel('Iteration'); ylabel('log(||b-Ax||)'); +%! semilogy([0:iter],resvec,'o-g;NO preconditioning: absolute residual;'); +%! +%! pause(1); +%! # Test Jacobi preconditioner: it will not help much!!! +%! +%! M = diag(diag(A)); # Jacobi preconditioner +%! [x, flag, relres, iter, resvec] = pcr(A,b,[],maxit,M); +%! hold on; +%! semilogy([0:iter],resvec,'o-r;JACOBI preconditioner: absolute residual;'); +%! +%! pause(1); +%! # Test nonoverlapping block Jacobi preconditioner: this one should give +%! # some convergence speedup! +%! +%! M = zeros(N,N);k=4; +%! for i=1:k:N # get k x k diagonal blocks of A +%! M(i:i+k-1,i:i+k-1) = A(i:i+k-1,i:i+k-1); +%! endfor +%! M = [M, zeros(size(M)); zeros(size(M)), -M]; +%! [x, flag, relres, iter, resvec] = pcr(A,b,[],maxit,M); +%! semilogy([0:iter],resvec,'o-b;BLOCK JACOBI preconditioner: absolute residual;'); +%! hold off; +%!test +%! +%! #solve small indefinite diagonal system +%! +%! N = 10; +%! A = diag(linspace(-10.1,10,N)); b = ones(N,1); X = A\b; #X is the true solution +%! [x, flag] = pcr(A,b,[],N+1); +%! assert(norm(x-X)/norm(X)<1e-10); +%! assert(flag,0); +%! +%!test +%! +%! #solve tridiagonal system, do not converge in default 20 iterations +%! #should perform max allowable default number of iterations +%! +%! N = 100; +%! A = zeros(N,N); +%! for i=1:N-1 # form 1-D Laplacian matrix +%! A(i:i+1,i:i+1) = [2 -1; -1 2]; +%! endfor +%! b = ones(N,1); X = A\b; #X is the true solution +%! [x, flag, relres, iter, resvec] = pcr(A,b,1e-12); +%! assert(flag,1); +%! assert(relres>0.6); +%! assert(iter,20); +%! +%!test +%! +%! #solve tridiagonal system with 'prefect' preconditioner +%! #converges in one iteration +%! +%! N = 100; +%! A = zeros(N,N); +%! for i=1:N-1 # form 1-D Laplacian matrix +%! A(i:i+1,i:i+1) = [2 -1; -1 2]; +%! endfor +%! b = ones(N,1); X = A\b; #X is the true solution +%! [x, flag, relres, iter] = pcr(A,b,[],[],A,b); +%! assert(norm(x-X)/norm(X)<1e-6); +%! assert(relres<1e-6); +%! assert(flag,0); +%! assert(iter,1); #should converge in one iteration +%! diff --git a/octave_packages/m/sparse/private/__sprand_impl__.m b/octave_packages/m/sparse/private/__sprand_impl__.m new file mode 100644 index 0000000..682a82d --- /dev/null +++ b/octave_packages/m/sparse/private/__sprand_impl__.m @@ -0,0 +1,63 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## Copyright (C) 2012 Jordi Gutiérrez Hermoso +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} __sprand_impl__ (@var{s}, @var{randfun}) +## @deftypefnx {Function File} {} __sprand_impl__ (@var{m}, @var{n}, @var{d}, @var{funname}, @var{randfun}) +## Undocumented internal function. +## @end deftypefn + +## Actual implementation of sprand and sprandn happens here. + +function S = __sprand_impl__ (varargin) + + if (nargin == 2) + m = varargin{1}; + randfun = varargin{2}; + [i, j] = find (m); + [nr, nc] = size (m); + S = sparse (i, j, randfun (size (i)), nr, nc); + return; + endif + + [m, n, d, funname, randfun] = deal(varargin{:}); + + if (!(isscalar (m) && m == fix (m) && m > 0)) + error ("%s: M must be an integer greater than 0", funname); + endif + + if (!(isscalar (n) && n == fix (n) && n > 0)) + error ("%s: N must be an integer greater than 0", funname); + endif + + if (d < 0 || d > 1) + error ("%s: density D must be between 0 and 1", funname); + endif + + mn = m*n; + k = round (d*mn); + idx = randperm (mn, k); + + [i, j] = ind2sub ([m, n], idx); + S = sparse (i, j, randfun (k, 1), m, n); + +endfunction \ No newline at end of file diff --git a/octave_packages/m/sparse/spaugment.m b/octave_packages/m/sparse/spaugment.m new file mode 100644 index 0000000..b23ecc5 --- /dev/null +++ b/octave_packages/m/sparse/spaugment.m @@ -0,0 +1,101 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{s} =} spaugment (@var{A}, @var{c}) +## Create the augmented matrix of @var{A}. This is given by +## +## @example +## @group +## [@var{c} * eye(@var{m}, @var{m}), @var{A}; +## @var{A}', zeros(@var{n}, @var{n})] +## @end group +## @end example +## +## @noindent +## This is related to the least squares solution of +## @code{@var{A} \ @var{b}}, by +## +## @example +## @group +## @var{s} * [ @var{r} / @var{c}; x] = [ @var{b}, zeros(@var{n}, columns(@var{b})) ] +## @end group +## @end example +## +## @noindent +## where @var{r} is the residual error +## +## @example +## @var{r} = @var{b} - @var{A} * @var{x} +## @end example +## +## As the matrix @var{s} is symmetric indefinite it can be factorized +## with @code{lu}, and the minimum norm solution can therefore be found +## without the need for a @code{qr} factorization. As the residual +## error will be @code{zeros (@var{m}, @var{m})} for under determined +## problems, and example can be +## +## @example +## @group +## m = 11; n = 10; mn = max (m, n); +## A = spdiags ([ones(mn,1), 10*ones(mn,1), -ones(mn,1)], +## [-1, 0, 1], m, n); +## x0 = A \ ones (m,1); +## s = spaugment (A); +## [L, U, P, Q] = lu (s); +## x1 = Q * (U \ (L \ (P * [ones(m,1); zeros(n,1)]))); +## x1 = x1(end - n + 1 : end); +## @end group +## @end example +## +## To find the solution of an overdetermined problem needs an estimate +## of the residual error @var{r} and so it is more complex to formulate +## a minimum norm solution using the @code{spaugment} function. +## +## In general the left division operator is more stable and faster than +## using the @code{spaugment} function. +## @end deftypefn + +function s = spaugment (A, c) + if (nargin < 2) + if (issparse (A)) + c = max (max (abs (A))) / 1000; + else + if (ndims (A) != 2) + error ("spaugment: expecting 2-dimenisional matrix"); + else + c = max (abs (A(:))) / 1000; + endif + endif + elseif (!isscalar (c)) + error ("spaugment: C must be a scalar"); + endif + + [m, n] = size (A); + s = [ c * speye(m, m), A; A', sparse(n, n)]; +endfunction + +%!testif HAVE_UMFPACK +%! m = 11; n = 10; mn = max(m ,n); +%! A = spdiags ([ones(mn,1), 10*ones(mn,1), -ones(mn,1)],[-1,0,1], m, n); +%! x0 = A \ ones (m,1); +%! s = spaugment (A); +%! [L, U, P, Q] = lu (s); +%! x1 = Q * (U \ (L \ (P * [ones(m,1); zeros(n,1)]))); +%! x1 = x1(end - n + 1 : end); +%! assert (x1, x0, 1e-6) diff --git a/octave_packages/m/sparse/spconvert.m b/octave_packages/m/sparse/spconvert.m new file mode 100644 index 0000000..5e43e34 --- /dev/null +++ b/octave_packages/m/sparse/spconvert.m @@ -0,0 +1,67 @@ +## Copyright (C) 2004-2012 David Bateman and Andy Adler +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} spconvert (@var{m}) +## This function converts for a simple sparse matrix format easily +## produced by other programs into Octave's internal sparse format. The +## input @var{x} is either a 3 or 4 column real matrix, containing +## the row, column, real and imaginary parts of the elements of the +## sparse matrix. An element with a zero real and imaginary part can +## be used to force a particular matrix size. +## @end deftypefn + +function s = spconvert (m) + + if (issparse (m)) + s = m; + else + sz = size (m); + if (nargin != 1 || ! ismatrix (m) || ! isreal (m) + || length (sz) != 2 || (sz(2) != 3 && sz(2) != 4)) + error ("spconvert: argument must be sparse or real matrix with 3 or 4 columns"); + elseif (sz(2) == 3) + s = sparse (m(:,1), m(:,2), m(:,3)); + else + s = sparse (m(:,1), m(:,2), m(:,3) + 1i*m(:,4)); + endif + endif + +endfunction + + +%!test +%! i = [1; 3; 5]; +%! j = [2; 4; 6]; +%! v = [7; 8; 9]; +%! s = spconvert ([i, j, v]); +%! assert (issparse (s)); +%! [fi, fj, fv] = find (s); +%! assert (isequal (i, fi) && isequal (j, fj) && isequal (v, fv)); +%! s = spconvert ([i, j, v, j]); +%! [fi, fj, fv] = find (s); +%! assert (isequal (i, fi) && isequal (j, fj) && isequal (complex (v, j), fv)); +%! assert (size (spconvert ([1, 1, 3; 5, 15, 0])), [5, 15]); + +%% Test input validation +%!error spconvert () +%!error spconvert (1, 2) +%!error spconvert ({[1 2 3]}) +%!error spconvert ([1 2]) +%!error spconvert ([1 2 3i]) +%!error spconvert ([1 2 3 4 5]) diff --git a/octave_packages/m/sparse/spdiags.m b/octave_packages/m/sparse/spdiags.m new file mode 100644 index 0000000..ea23062 --- /dev/null +++ b/octave_packages/m/sparse/spdiags.m @@ -0,0 +1,94 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{b}, @var{c}] =} spdiags (@var{A}) +## @deftypefnx {Function File} {@var{b} =} spdiags (@var{A}, @var{c}) +## @deftypefnx {Function File} {@var{b} =} spdiags (@var{v}, @var{c}, @var{A}) +## @deftypefnx {Function File} {@var{b} =} spdiags (@var{v}, @var{c}, @var{m}, @var{n}) +## A generalization of the function @code{diag}. Called with a single +## input argument, the non-zero diagonals @var{c} of @var{A} are extracted. +## With two arguments the diagonals to extract are given by the vector +## @var{c}. +## +## The other two forms of @code{spdiags} modify the input matrix by +## replacing the diagonals. They use the columns of @var{v} to replace +## the columns represented by the vector @var{c}. If the sparse matrix +## @var{A} is defined then the diagonals of this matrix are replaced. +## Otherwise a matrix of @var{m} by @var{n} is created with the +## diagonals given by @var{v}. +## +## Negative values of @var{c} represent diagonals below the main +## diagonal, and positive values of @var{c} diagonals above the main +## diagonal. +## +## For example: +## +## @example +## @group +## spdiags (reshape (1:12, 4, 3), [-1 0 1], 5, 4) +## @result{} 5 10 0 0 +## 1 6 11 0 +## 0 2 7 12 +## 0 0 3 8 +## 0 0 0 4 +## @end group +## @end example +## +## @end deftypefn + +function [A, c] = spdiags (v, c, m, n) + + if (nargin == 1 || nargin == 2) + ## extract nonzero diagonals of v into A,c + [nr, nc] = size (v); + [i, j, v] = find (v); + + if (nargin == 1) + ## c contains the active diagonals + c = unique (j-i); + endif + ## FIXME: we can do this without a loop if we are clever + offset = max (min (c, nc-nr), 0); + A = zeros (min (nr, nc), length (c)); + for k = 1:length (c) + idx = find (j-i == c(k)); + A(j(idx)-offset(k),k) = v(idx); + endfor + elseif (nargin == 3) + ## Replace specific diagonals c of m with v,c + [nr, nc] = size (m); + B = spdiags (m, c); + A = m - spdiags (B, c, nr, nc) + spdiags (v, c, nr, nc); + else + ## Create new matrix of size mxn using v,c + [j, i, v] = find (v); + offset = max (min (c(:), n-m), 0); + j = j + offset(i); + i = j-c(:)(i); + idx = i > 0 & i <= m & j > 0 & j <= n; + A = sparse (i(idx), j(idx), v(idx), m, n); + endif + +endfunction + +%!test +%assert(spdiags(zeros(1,0),1,1,1),0) + +%!test +%assert(spdiags(zeros(0,1),1,1,1),0) diff --git a/octave_packages/m/sparse/speye.m b/octave_packages/m/sparse/speye.m new file mode 100644 index 0000000..5ccb418 --- /dev/null +++ b/octave_packages/m/sparse/speye.m @@ -0,0 +1,57 @@ +## Copyright (C) 2004-2012 David Bateman and Andy Adler +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} speye (@var{m}) +## @deftypefnx {Function File} {@var{y} =} speye (@var{m}, @var{n}) +## @deftypefnx {Function File} {@var{y} =} speye (@var{sz}) +## Return a sparse identity matrix. This is significantly more +## efficient than @code{sparse (eye (@var{m}))} as the full matrix +## is not constructed. +## +## Called with a single argument a square matrix of size @var{m} by +## @var{m} is created. Otherwise a matrix of @var{m} by @var{n} is +## created. If called with a single vector argument, this argument +## is taken to be the size of the matrix to create. +## @end deftypefn + +function s = speye (m, n) + if (nargin == 1) + if (isvector (m) && length(m) == 2) + n = m(2); + m = m(1); + elseif (isscalar (m)) + n = m; + else + error ("speye: invalid matrix dimension"); + endif + else + if (! isscalar (m) || ! isscalar (n)) + error ("speye: invalid matrix dimension"); + endif + endif + + lo = min ([m, n]); + s = sparse (1:lo, 1:lo, 1, m, n); +endfunction + +%!assert(issparse(speye(4))) +%!assert(speye(4),sparse(1:4,1:4,1)) +%!assert(speye(2,4),sparse(1:2,1:2,1,2,4)) +%!assert(speye(4,2),sparse(1:2,1:2,1,4,2)) +%!assert(speye([4,2]),sparse(1:2,1:2,1,4,2)) diff --git a/octave_packages/m/sparse/spfun.m b/octave_packages/m/sparse/spfun.m new file mode 100644 index 0000000..a8dce30 --- /dev/null +++ b/octave_packages/m/sparse/spfun.m @@ -0,0 +1,49 @@ +## Copyright (C) 2004-2012 David Bateman and Andy Adler +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{y} =} spfun (@var{f}, @var{S}) +## Compute @code{f(@var{S})} for the non-zero values of @var{S}. +## This results in a sparse matrix with the same structure as +## @var{S}. The function @var{f} can be passed as a string, a +## function handle, or an inline function. +## @seealso{arrayfun, cellfun, structfun} +## @end deftypefn + +function y = spfun (f, S) + + if (nargin != 2) + print_usage (); + endif + + [i, j, v] = find (S); + [m, n] = size (S); + + if (isa (f, "function_handle") || isa (f, "inline function")) + y = sparse (i, j, f(v), m, n); + else + y = sparse(i, j, feval (f, v), m, n); + endif + +endfunction + +%!assert(spfun('exp',[1,2;3,0]),sparse([exp(1),exp(2);exp(3),0])) +%!assert(spfun('exp',sparse([1,2;3,0])),sparse([exp(1),exp(2);exp(3),0])) +%!assert(spfun(@exp,[1,2;3,0]),sparse([exp(1),exp(2);exp(3),0])) +%!assert(spfun(@exp,sparse([1,2;3,0])),sparse([exp(1),exp(2);exp(3),0])) + diff --git a/octave_packages/m/sparse/spones.m b/octave_packages/m/sparse/spones.m new file mode 100644 index 0000000..99f33c1 --- /dev/null +++ b/octave_packages/m/sparse/spones.m @@ -0,0 +1,40 @@ +## Copyright (C) 2004-2012 David Bateman and Andy Adler +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{r} =} spones (@var{S}) +## Replace the non-zero entries of @var{S} with ones. This creates a +## sparse matrix with the same structure as @var{S}. +## @end deftypefn + +function r = spones (S) + + if (nargin != 1) + print_usage (); + endif + + [i, j, v] = find (S); + [m, n] = size (S); + + r = sparse (i, j, 1, m, n); + +endfunction + +%!assert(issparse(spones([1,2;3,0]))) +%!assert(spones([1,2;3,0]),sparse([1,1;1,0])) +%!assert(spones(sparse([1,2;3,0])),sparse([1,1;1,0])) diff --git a/octave_packages/m/sparse/sprand.m b/octave_packages/m/sparse/sprand.m new file mode 100644 index 0000000..8bb8d81 --- /dev/null +++ b/octave_packages/m/sparse/sprand.m @@ -0,0 +1,82 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} sprand (@var{m}, @var{n}, @var{d}) +## @deftypefnx {Function File} {} sprand (@var{s}) +## Generate a random sparse matrix. The size of the matrix will be +## @var{m} by @var{n}, with a density of values given by @var{d}. +## @var{d} should be between 0 and 1. Values will be uniformly +## distributed between 0 and 1. +## +## If called with a single matrix argument, a random sparse matrix is +## generated wherever the matrix @var{S} is non-zero. +## @seealso{sprandn, sprandsym} +## @end deftypefn + +## Author: Paul Kienzle +## +## Changelog: +## +## Piotr Krzyzanowski +## 2004-09-27 use Paul's hint to allow larger random matrices +## at the price of sometimes lower density than desired +## David Bateman +## 2004-10-20 Texinfo help and copyright message + +function S = sprand (m, n, d) + + if (nargin == 1 ) + S = __sprand_impl__ (m, @rand); + elseif ( nargin == 3) + S = __sprand_impl__ (m, n, d, "sprand", @rand); + else + print_usage (); + endif + +endfunction + +%!test +%! s = sprand (4, 10, 0.1); +%! assert (size (s), [4, 10]); +%! assert (nnz (s) / numel (s), 0.1); + +%% Test 1-input calling form +%!test +%! s = sprand (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j, v] = find (s); +%! assert (sort (i), [1 2 3]'); +%! assert (sort (j), [2 3 3]'); +%! assert (all (v > 0 & v < 1)); + +%% Test input validation +%!error sprand () +%!error sprand (1, 2) +%!error sprand (1, 2, 3, 4) +%!error sprand (ones(3), 3, 0.5) +%!error sprand (3.5, 3, 0.5) +%!error sprand (0, 3, 0.5) +%!error sprand (3, ones(3), 0.5) +%!error sprand (3, 3.5, 0.5) +%!error sprand (3, 0, 0.5) +%!error sprand (3, 3, -1) +%!error sprand (3, 3, 2) + diff --git a/octave_packages/m/sparse/sprandn.m b/octave_packages/m/sparse/sprandn.m new file mode 100644 index 0000000..c8d96cb --- /dev/null +++ b/octave_packages/m/sparse/sprandn.m @@ -0,0 +1,74 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} sprandn (@var{m}, @var{n}, @var{d}) +## @deftypefnx {Function File} {} sprandn (@var{s}) +## Generate a random sparse matrix. The size of the matrix will be +## @var{m} by @var{n}, with a density of values given by @var{d}. +## @var{d} should be between 0 and 1. Values will be normally +## distributed with mean of zero and variance 1. +## +## If called with a single matrix argument, a random sparse matrix is +## generated wherever the matrix @var{S} is non-zero. +## @seealso{sprand, sprandsym} +## @end deftypefn + +## Author: Paul Kienzle + +function S = sprandn (m, n, d) + + if (nargin == 1 ) + S = __sprand_impl__ (m, @randn); + elseif ( nargin == 3) + S = __sprand_impl__ (m, n, d, "sprandn", @randn); + else + print_usage (); + endif + +endfunction + + +%!test +%! s = sprandn (4, 10, 0.1); +%! assert (size (s), [4, 10]); +%! assert (nnz (s) / numel (s), 0.1); + +%% Test 1-input calling form +%!test +%! s = sprandn (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j] = find (s); +%! assert (sort (i), [1 2 3]'); +%! assert (sort (j), [2 3 3]'); + +%% Test input validation +%!error sprandn () +%!error sprandn (1, 2) +%!error sprandn (1, 2, 3, 4) +%!error sprandn (ones(3), 3, 0.5) +%!error sprandn (3.5, 3, 0.5) +%!error sprandn (0, 3, 0.5) +%!error sprandn (3, ones(3), 0.5) +%!error sprandn (3, 3.5, 0.5) +%!error sprandn (3, 0, 0.5) +%!error sprandn (3, 3, -1) +%!error sprandn (3, 3, 2) + diff --git a/octave_packages/m/sparse/sprandsym.m b/octave_packages/m/sparse/sprandsym.m new file mode 100644 index 0000000..fae6c72 --- /dev/null +++ b/octave_packages/m/sparse/sprandsym.m @@ -0,0 +1,176 @@ +## Copyright (C) 2004-2012 David Bateman and Andy Adler +## Copyright (C) 2012 Jordi Gutiérrez Hermoso +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} sprandsym (@var{n}, @var{d}) +## @deftypefnx {Function File} {} sprandsym (@var{s}) +## Generate a symmetric random sparse matrix. The size of the matrix will be +## @var{n} by @var{n}, with a density of values given by @var{d}. +## @var{d} should be between 0 and 1. Values will be normally +## distributed with mean of zero and variance 1. +## +## If called with a single matrix argument, a random sparse matrix is +## generated wherever the matrix @var{S} is non-zero in its lower +## triangular part. +## @seealso{sprand, sprandn} +## @end deftypefn + +function S = sprandsym (n, d) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (nargin == 1) + [i, j] = find (tril (n)); + [nr, nc] = size (n); + S = sparse (i, j, randn (size (i)), nr, nc); + S = S + tril (S, -1)'; + return; + endif + + if (!(isscalar (n) && n == fix (n) && n > 0)) + error ("sprandsym: N must be an integer greater than 0"); + endif + + if (d < 0 || d > 1) + error ("sprandsym: density D must be between 0 and 1"); + endif + + ## Actual number of nonzero entries + k = round (n^2*d); + + ## Diagonal nonzero entries, same parity as k + r = pick_rand_diag (n, k); + + ## Off diagonal nonzero entries + m = (k - r)/2; + + ondiag = randperm (n, r); + offdiag = randperm (n*(n - 1)/2, m); + + ## Row index + i = lookup (cumsum (0:n), offdiag - 1) + 1; + + ## Column index + j = offdiag - (i - 1).*(i - 2)/2; + + diagvals = randn (1, r); + offdiagvals = randn (1, m); + + S = sparse ([ondiag, i, j], [ondiag, j, i], + [diagvals, offdiagvals, offdiagvals], n, n); + +endfunction + +function r = pick_rand_diag (n, k) + ## Pick a random number R of entries for the diagonal of a sparse NxN + ## symmetric square matrix with exactly K nonzero entries, ensuring + ## that this R is chosen uniformly over all such matrices. + ## + ## Let D be the number of diagonal entries and M the number of + ## off-diagonal entries. Then K = D + 2*M. Let A = N*(N-1)/2 be the + ## number of available entries in the upper triangle of the matrix. + ## Then, by a simple counting argument, there is a total of + ## + ## T = nchoosek (N, D) * nchoosek (A, M) + ## + ## symmetric NxN matrices with a total of K nonzero entries and D on + ## the diagonal. Letting D range from mod (K,2) through min (N,K), and + ## dividing by this sum, we obtain the probability P for D to be each + ## of those values. + ## + ## However, we cannot use this form for computation, as the binomial + ## coefficients become unmanageably large. Instead, we use the + ## successive quotients Q(i) = T(i+1)/T(i), which we easily compute to + ## be + ## + ## (N - D)*(N - D - 1)*M + ## Q = ------------------------------- + ## (D + 2)*(D + 1)*(A - M + 1) + ## + ## Then, after prepending 1, the cumprod of these quotients is + ## + ## C = [ T(1)/T(1), T(2)/T(1), T(3)/T(1), ..., T(N)/T(1) ] + ## + ## Their sum is thus S = sum (T)/T(1), and then C(i)/S is the desired + ## probability P(i) for i=1:N. The cumsum will finally give the + ## distribution function for computing the random number of entries on + ## the diagonal R. + ## + ## Thanks to Zsbán Ambrus for most of the ideas + ## of the implementation here, especially how to do the computation + ## numerically to avoid overflow. + + ## Degenerate case + if k == 1 + r = 1; + return + endif + + ## Compute the stuff described above + a = n*(n - 1)/2; + d = [mod(k,2):2:min(n,k)-2]; + m = (k - d)/2; + q = (n - d).*(n - d - 1).*m ./ (d + 2)./(d + 1)./(a - m + 1); + + ## Slight modification from discussion above: pivot around the max in + ## order to avoid overflow (underflow is fine, just means effectively + ## zero probabilities). + [~, midx] = max (cumsum (log (q))) ; + midx++; + lc = fliplr (cumprod (1./q(midx-1:-1:1))); + rc = cumprod (q(midx:end)); + + ## Now c = t(i)/t(midx), so c > 1 == []. + c = [lc, 1, rc]; + s = sum (c); + p = c/s; + + ## Add final d + d(end+1) = d(end) + 2; + + ## Pick a random r using this distribution + r = d(sum (cumsum (p) < rand) + 1); + +endfunction + +%!test +%! s = sprandsym (10, 0.1); +%! assert (issparse (s)); +%! assert (issymmetric (s)); +%! assert (size (s), [10, 10]); +%! assert (nnz (s) / numel (s), 0.1, .01); + +%% Test 1-input calling form +%!test +%! s = sprandsym (sparse ([1 2 3], [3 2 3], [2 2 2])); +%! [i, j] = find (s); +%! assert (sort (i), [2 3]'); +%! assert (sort (j), [2 3]'); + +%% Test input validation +%!error sprandsym () +%!error sprandsym (1, 2, 3) +%!error sprandsym (ones(3), 0.5) +%!error sprandsym (3.5, 0.5) +%!error sprandsym (0, 0.5) +%!error sprandsym (3, -1) +%!error sprandsym (3, 2) + diff --git a/octave_packages/m/sparse/spstats.m b/octave_packages/m/sparse/spstats.m new file mode 100644 index 0000000..7d82d45 --- /dev/null +++ b/octave_packages/m/sparse/spstats.m @@ -0,0 +1,65 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{count}, @var{mean}, @var{var}] =} spstats (@var{S}) +## @deftypefnx {Function File} {[@var{count}, @var{mean}, @var{var}] =} spstats (@var{S}, @var{j}) +## Return the stats for the non-zero elements of the sparse matrix @var{S}. +## @var{count} is the number of non-zeros in each column, @var{mean} +## is the mean of the non-zeros in each column, and @var{var} is the +## variance of the non-zeros in each column. +## +## Called with two input arguments, if @var{S} is the data and @var{j} +## is the bin number for the data, compute the stats for each bin. In +## this case, bins can contain data values of zero, whereas with +## @code{spstats (@var{S})} the zeros may disappear. +## @end deftypefn + +function [count, mean, var] = spstats (S, j) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1) + [i, j, v] = find (S); + else + v = S; + i = 1:length (v); + S = sparse (i, j, v); + endif + [n, m] = size (S); + + count = sum (sparse (i, j, 1, n, m)); + if (nargout > 1) + mean = sum (S) ./ count; + endif + if (nargout > 2) + ## FIXME Variance with count = 0 or 1? + diff = S - sparse (i, j, mean(j), n, m); + var = sum (diff .* diff) ./ (count - 1); + endif + +endfunction + + +%!test +%! [n,m,v] = spstats([1 2 1 2 3 4],[2 2 1 1 1 1]); +%! assert(n,sparse([4,2])); +%! assert(m,sparse([10/4,3/2]),10*eps); +%! assert(v,sparse([5/3,1/2]),10*eps); diff --git a/octave_packages/m/sparse/spy.m b/octave_packages/m/sparse/spy.m new file mode 100644 index 0000000..8e49b88 --- /dev/null +++ b/octave_packages/m/sparse/spy.m @@ -0,0 +1,75 @@ +## Copyright (C) 1998-2012 Andy Adler +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} spy (@var{x}) +## @deftypefnx {Function File} {} spy (@dots{}, @var{markersize}) +## @deftypefnx {Function File} {} spy (@dots{}, @var{line_spec}) +## Plot the sparsity pattern of the sparse matrix @var{x}. If the argument +## @var{markersize} is given as a scalar value, it is used to determine the +## point size in the plot. If the string @var{line_spec} is given it is +## passed to @code{plot} and determines the appearance of the plot. +## @seealso{plot} +## @end deftypefn + +function spy (x, varargin) + + if (nargin < 1) + print_usage (); + endif + + markersize = NaN; + if (numel (x) < 1000) + line_spec = "*"; + else + line_spec = "."; + endif + for i = 1:length (varargin) + if (ischar (varargin{i})) + if (length (varargin{i}) == 1) + line_spec = [line_spec, varargin{i}]; + else + line_spec = varargin{i}; + endif + elseif (isscalar (varargin{i})) + markersize = varargin{i}; + else + error ("spy: expected markersize or linespec"); + endif + endfor + + [i, j, s] = find (x); + [m, n] = size (x); + + if (isnan (markersize)) + plot (j, i, line_spec); + else + plot (j, i, line_spec, "markersize", markersize); + endif + + axis ([0, n+1, 0, m+1], "ij"); + +endfunction + + +%!demo +%! clf; +%! spy (sprand (10,10, 0.2)); + +%% Mark graphical function as tested by demo block +%!assert (1); diff --git a/octave_packages/m/sparse/svds.m b/octave_packages/m/sparse/svds.m new file mode 100644 index 0000000..f13858c --- /dev/null +++ b/octave_packages/m/sparse/svds.m @@ -0,0 +1,296 @@ +## Copyright (C) 2006-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{s} =} svds (@var{A}) +## @deftypefnx {Function File} {@var{s} =} svds (@var{A}, @var{k}) +## @deftypefnx {Function File} {@var{s} =} svds (@var{A}, @var{k}, @var{sigma}) +## @deftypefnx {Function File} {@var{s} =} svds (@var{A}, @var{k}, @var{sigma}, @var{opts}) +## @deftypefnx {Function File} {[@var{u}, @var{s}, @var{v}] =} svds (@dots{}) +## @deftypefnx {Function File} {[@var{u}, @var{s}, @var{v}, @var{flag}] =} svds (@dots{}) +## +## Find a few singular values of the matrix @var{A}. The singular values +## are calculated using +## +## @example +## @group +## [@var{m}, @var{n}] = size (@var{A}); +## @var{s} = eigs ([sparse(@var{m}, @var{m}), @var{A}; +## @var{A}', sparse(@var{n}, @var{n})]) +## @end group +## @end example +## +## The eigenvalues returned by @code{eigs} correspond to the singular values +## of @var{A}. The number of singular values to calculate is given by @var{k} +## and defaults to 6. +## +## The argument @var{sigma} specifies which singular values to find. When +## @var{sigma} is the string 'L', the default, the largest singular values of +## @var{A} are found. Otherwise, @var{sigma} must be a real scalar and the +## singular values closest to @var{sigma} are found. As a corollary, +## @code{@var{sigma} = 0} finds the smallest singular values. Note that for +## relatively small values of @var{sigma}, there is a chance that the requested +## number of singular values will not be found. In that case @var{sigma} +## should be increased. +## +## @var{opts} is a structure defining options that @code{svds} will pass +## to @code{eigs}. The possible fields of this structure are documented in +## @code{eigs}. By default, @code{svds} sets the following three fields: +## +## @table @code +## @item tol +## The required convergence tolerance for the singular values. The default +## value is 1e-10. @code{eigs} is passed @code{@var{tol} / sqrt(2)}. +## +## @item maxit +## The maximum number of iterations. The default is 300. +## +## @item disp +## The level of diagnostic printout (0|1|2). If @code{disp} is 0 then +## diagnostics are disabled. The default value is 0. +## @end table +## +## If more than one output is requested then @code{svds} will return an +## approximation of the singular value decomposition of @var{A} +## +## @example +## @var{A}_approx = @var{u}*@var{s}*@var{v}' +## @end example +## +## @noindent +## where @var{A}_approx is a matrix of size @var{A} but only rank @var{k}. +## +## @var{flag} returns 0 if the algorithm has succesfully converged, and 1 +## otherwise. The test for convergence is +## +## @example +## @group +## norm (@var{A}*@var{v} - @var{u}*@var{s}, 1) <= @var{tol} * norm (@var{A}, 1) +## @end group +## @end example +## +## @code{svds} is best for finding only a few singular values from a large +## sparse matrix. Otherwise, @code{svd (full(@var{A}))} will likely be more +## efficient. +## @end deftypefn +## @seealso{svd, eigs} + +function [u, s, v, flag] = svds (A, k, sigma, opts) + + persistent root2 = sqrt (2); + + if (nargin < 1 || nargin > 4) + print_usage (); + endif + + if (ndims(A) > 2) + error ("svds: A must be a 2D matrix"); + endif + + if (nargin < 4) + opts.tol = 1e-10 / root2; + opts.disp = 0; + opts.maxit = 300; + else + if (!isstruct (opts)) + error ("svds: OPTS must be a structure"); + endif + if (!isfield (opts, "tol")) + opts.tol = 1e-10 / root2; + else + opts.tol = opts.tol / root2; + endif + if (isfield (opts, "v0")) + if (!isvector (opts.v0) || (length (opts.v0) != sum (size (A)))) + error ("svds: OPTS.v0 must be a vector with rows(A)+columns(A) entries"); + endif + endif + endif + + if (nargin < 3 || strcmp (sigma, "L")) + if (isreal (A)) + sigma = "LA"; + else + sigma = "LR"; + endif + elseif (isscalar (sigma) && isnumeric (sigma) && isreal (sigma)) + if (sigma < 0) + error ("svds: SIGMA must be a positive real value"); + endif + else + error ("svds: SIGMA must be a positive real value or the string 'L'"); + endif + + [m, n] = size (A); + max_a = max (abs (A(:))); + if (max_a == 0) + s = zeros (k, 1); # special case of zero matrix + else + if (nargin < 2) + k = min ([6, m, n]); + else + k = min ([k, m, n]); + endif + + ## Scale everything by the 1-norm to make things more stable. + b = A / max_a; + b_opts = opts; + ## Call to eigs is always a symmetric matrix by construction + b_opts.issym = true; + b_opts.tol = opts.tol / max_a; + b_sigma = sigma; + if (!ischar (b_sigma)) + b_sigma = b_sigma / max_a; + endif + + if (b_sigma == 0) + ## Find the smallest eigenvalues + ## The eigenvalues returns by eigs for sigma=0 are symmetric about 0. + ## As we are only interested in the positive eigenvalues, we have to + ## double k and then throw out the k negative eigenvalues. + ## Separately, if sigma is non-zero, but smaller than the smallest + ## singular value, ARPACK may not return k eigenvalues. However, as + ## computation scales with k we'd like to avoid doubling k for all + ## scalar values of sigma. + b_k = 2 * k; + else + b_k = k; # Normal case, find just the k largest eigenvalues + endif + + if (nargout > 1) + [V, s, flag] = eigs ([sparse(m,m), b; b', sparse(n,n)], + b_k, b_sigma, b_opts); + s = diag (s); + else + s = eigs ([sparse(m,m), b; b', sparse(n,n)], b_k, b_sigma, b_opts); + endif + + if (ischar (sigma)) + norma = max (s); + else + norma = normest (A); + endif + ## We wish to exclude all eigenvalues that are less than zero as these + ## are artifacts of the way the matrix passed to eigs is formed. There + ## is also the possibility that the value of sigma chosen is exactly + ## a singular value, and in that case we're dead!! So have to rely on + ## the warning from eigs. We exclude the singular values which are + ## less than or equal to zero to within some tolerance scaled by the + ## norm since if we don't we might end up with too many singular + ## values. + tol = norma * opts.tol; + ind = find(s > tol); + if (length (ind) < k) + ## Too few eigenvalues returned. Add in any zero eigenvalues of B, + ## including the nominally negative ones. + zind = find (abs (s) <= tol); + p = min (length (zind), k - length (ind)); + ind = [ind; zind(1:p)]; + elseif (length (ind) > k) + ## Too many eigenvalues returned. Select according to criterium. + if (b_sigma == 0) + ind = ind(end+1-k:end); # smallest eigenvalues + else + ind = ind(1:k); # largest eigenvalues + endif + endif + s = s(ind); + + if (length (s) < k) + warning ("returning fewer singular values than requested"); + if (!ischar (sigma)) + warning ("try increasing the value of sigma"); + endif + endif + + s = s * max_a; + endif + + if (nargout < 2) + u = s; + else + if (max_a == 0) + u = eye (m, k); + s = diag (s); + v = eye (n, k); + else + u = root2 * V(1:m,ind); + s = diag (s); + v = root2 * V(m+1:end,ind); + endif + + if (nargout > 3) + flag = norm (A*v - u*s, 1) > root2 * opts.tol * norm (A, 1); + endif + endif + +endfunction + +%!shared n, k, A, u, s, v, opts, rand_state, randn_state +%! n = 100; +%! k = 7; +%! A = sparse ([3:n,1:n,1:(n-2)],[1:(n-2),1:n,3:n],[ones(1,n-2),0.4*n*ones(1,n),ones(1,n-2)]); +%! [u,s,v] = svd (full (A)); +%! s = diag (s); +%! [~, idx] = sort (abs(s)); +%! s = s(idx); +%! u = u(:, idx); +%! v = v(:, idx); +%! randn_state = randn ("state"); +%! rand_state = rand ("state"); +%! randn ("state", 42); % Initialize to make normest function reproducible +%! rand ("state", 42); +%! opts.v0 = rand (2*n,1); % Initialize eigs ARPACK starting vector +%! % to guarantee reproducible results +%! +%!testif HAVE_ARPACK +%! [u2,s2,v2,flag] = svds (A,k); +%! s2 = diag (s2); +%! assert (flag, !1); +%! assert (s2, s(end:-1:end-k+1), 1e-10); +%! +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! [u2,s2,v2,flag] = svds (A,k,0,opts); +%! s2 = diag (s2); +%! assert (flag, !1); +%! assert (s2, s(k:-1:1), 1e-10); +%! +%!testif HAVE_ARPACK, HAVE_UMFPACK +%! idx = floor(n/2); +%! % Don't put sigma right on a singular value or there are convergence issues +%! sigma = 0.99*s(idx) + 0.01*s(idx+1); +%! [u2,s2,v2,flag] = svds (A,k,sigma,opts); +%! s2 = diag (s2); +%! assert (flag, !1); +%! assert (s2, s((idx+floor(k/2)):-1:(idx-floor(k/2))), 1e-10); +%! +%!testif HAVE_ARPACK +%! [u2,s2,v2,flag] = svds (zeros (10), k); +%! assert (u2, eye (10, k)); +%! assert (s2, zeros (k)); +%! assert (v2, eye (10, 7)); +%! +%!testif HAVE_ARPACK +%! s = svds (speye (10)); +%! assert (s, ones (6, 1), 2*eps); + +%!test +%! ## Restore random number generator seeds at end of tests +%! rand ("state", rand_state); +%! randn ("state", randn_state); + diff --git a/octave_packages/m/sparse/treelayout.m b/octave_packages/m/sparse/treelayout.m new file mode 100644 index 0000000..fbe0d0a --- /dev/null +++ b/octave_packages/m/sparse/treelayout.m @@ -0,0 +1,227 @@ +## Copyright (C) 2008-2012 Ivana Varekova & Radek Salac +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} treelayout (@var{tree}) +## @deftypefnx {Function File} {} treelayout (@var{tree}, @var{permutation}) +## treelayout lays out a tree or a forest. The first argument @var{tree} is a +## vector of +## predecessors, optional parameter @var{permutation} is an optional postorder +## permutation. +## The complexity of the algorithm is O(n) in +## terms of time and memory requirements. +## @seealso{etreeplot, gplot, treeplot} +## @end deftypefn + +function [x_coordinate, y_coordinate, height, s] = treelayout (tree, permutation) + if (nargin < 1 || nargin > 2 || nargout > 4) + print_usage (); + elseif (! isvector (tree) || rows (tree) != 1 || ! isnumeric (tree) + || any (tree > length (tree)) || any (tree < 0)) + error ("treelayout: the first input argument must be a vector of predecessors"); + else + ## Make it a row vector. + tree = tree(:)'; + + ## The count of nodes of the graph. + num_nodes = length (tree); + ## The number of children. + num_children = zeros (1, num_nodes + 1); + + ## Checking vector of predecessors. + for i = 1 : num_nodes + if (tree(i) < i) + ## This part of graph was checked before. + continue; + endif + + ## Try to find cicle in this part of graph using modified Floyd's + ## cycle-finding algorithm. + tortoise = tree(i); + hare = tree(tortoise); + + while (tortoise != hare) + ## End after finding a cicle or reaching a checked part of graph. + + if (hare < i) + ## This part of graph was checked before. + break + endif + + tortoise = tree(tortoise); + ## Hare will move faster than tortoise so in cicle hare must + ## reach tortoise. + hare = tree(tree(hare)); + + endwhile + + if (tortoise == hare) + ## If hare reach tortoise we found circle. + error ("treelayout: vector of predecessors has bad format"); + endif + + endfor + ## Vector of predecessors has right format. + + for i = 1:num_nodes + ## vec_of_child is helping vector which is used to speed up the + ## choice of descendant nodes. + + num_children(tree(i)+1) = num_children(tree(i)+1) + 1; + endfor + + pos = 1; + start = zeros (1, num_nodes+1); + xhelp = zeros (1, num_nodes+1); + stop = zeros (1, num_nodes+1); + for i = 1 : num_nodes + 1 + start(i) = pos; + xhelp(i) = pos; + pos += num_children(i); + stop(i) = pos; + endfor + + if (nargin == 1) + for i = 1:num_nodes + vec_of_child(xhelp(tree(i)+1)) = i; + xhelp(tree(i)+1) = xhelp(tree(i)+1) + 1; + endfor + else + vec_of_child = permutation; + endif + + ## The number of "parent" (actual) node (it's descendants will be + ## browse in the next iteration). + par_number = 0; + + ## The x-coordinate of the left most descendant of "parent node" + ## this value is increased in each leaf. + left_most = 0; + + ## The level of "parent" node (root level is num_nodes). + level = num_nodes; + + ## num_nodes - max_ht is the height of this graph. + max_ht = num_nodes; + + ## Main stack - each item consists of two numbers - the number of + ## node and the number it's of parent node on the top of stack + ## there is "parent node". + stk = [-1, 0]; + + ## Number of vertices s in the top-level separator. + s = 0; + ## Flag which says if we are in top level separator. + top_level = 1; + ## The top of the stack. + while (par_number != -1) + if (start(par_number+1) < stop(par_number+1)) + idx = vec_of_child(start(par_number+1) : stop(par_number+1) - 1); + else + idx = zeros (1, 0); + endif + + ## Add to idx the vector of parent descendants. + stk = [stk; [idx', ones(fliplr(size(idx))) * par_number]]; + + ## We are in top level separator when we have one child and the + ## flag is 1 + if (columns(idx) == 1 && top_level == 1) + s++; + else + # We aren't in top level separator now. + top_level = 0; + endif + ## If there is not any descendant of "parent node": + if (stk(end,2) != par_number) + left_most++; + x_coordinate_r(par_number) = left_most; + max_ht = min (max_ht, level); + if (length(stk) > 1 && find ((shift(stk,1)-stk) == 0) > 1 + && stk(end,2) != stk(end-1,2)) + ## Return to the nearest branching the position to return + ## position is the position on the stack, where should be + ## started further search (there are two nodes which has the + ## same parent node). + + position = (find ((shift (stk(:,2), 1) - stk(:,2)) == 0))(end) + 1; + par_number_vec = stk(position:end,2); + + ## The vector of removed nodes (the content of stack form + ## position to end). + + level += length (par_number_vec); + + ## The level have to be decreased. + + x_coordinate_r(par_number_vec) = left_most; + stk(position:end,:) = []; + endif + + ## Remove the next node from "searched branch". + + stk(end,:) = []; + ## Choose new "parent node". + par_number = stk(end,1); + ## If there is another branch start to search it. + if (par_number != -1) + y_coordinate(par_number) = level; + x_coordinate_l(par_number) = left_most + 1; + endif + else + + ## There were descendants of "parent nod" choose the last of + ## them and go on through it. + level--; + par_number = stk(end,1); + y_coordinate(par_number) = level; + x_coordinate_l(par_number) = left_most + 1; + endif + endwhile + + ## Calculate the x coordinates (the known values are the position + ## of most left and most right descendants). + x_coordinate = (x_coordinate_l + x_coordinate_r) / 2; + + height = num_nodes - max_ht - 1; + endif +endfunction + +%!test +%! % Compute a simple tree layout +%! [x, y, h, s] = treelayout ([0, 1, 2, 2]); +%! assert (x, [1.5, 1.5, 2, 1]); +%! assert (y, [3, 2, 1, 1]); +%! assert (h, 2); +%! assert (s, 2); + +%!test +%! % Compute a simple tree layout with defined postorder permutation +%! [x, y, h, s] = treelayout ([0, 1, 2, 2], [1, 2, 4, 3]); +%! assert (x, [1.5, 1.5, 1, 2]); +%! assert (y, [3, 2, 1, 1]); +%! assert (h, 2); +%! assert (s, 2); + +%!test +%! % Compute a simple tree layout with defined postorder permutation +%! [x, y, h, s] = treelayout ([0, 1, 2, 2], [4, 2, 3, 1]); +%! assert (x, [0, 0, 0, 1]); +%! assert (y, [0, 0, 0, 3]); +%! assert (h, 0); +%! assert (s, 1); diff --git a/octave_packages/m/sparse/treeplot.m b/octave_packages/m/sparse/treeplot.m new file mode 100644 index 0000000..20bff86 --- /dev/null +++ b/octave_packages/m/sparse/treeplot.m @@ -0,0 +1,205 @@ +## Copyright (C) 2005-2012 Ivana Varekova +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} treeplot (@var{tree}) +## @deftypefnx {Function File} {} treeplot (@var{tree}, @var{node_style}, @var{edge_style}) +## Produce a graph of tree or forest. The first argument is vector of +## predecessors, optional parameters @var{node_style} and @var{edge_style} +## define the output style. The complexity of the algorithm is O(n) in +## terms of is time and memory requirements. +## @seealso{etreeplot, gplot} +## @end deftypefn + +function treeplot (tree, node_style = "ko", edge_style = "r") + + if (nargin < 1 || nargin > 3 || nargout > 0) + print_usage (); + endif + + if (! ismatrix (tree) || rows (tree) != 1 || ! isnumeric (tree) + || ! isvector (tree) || any (tree > length (tree))) + error ("treeplot: TREE must be a vector of predecessors"); + endif + + ## Verify node_style + if (nargin > 1) + if (isempty (regexp (node_style, '[ox+*]', 'once'))) + node_style = [node_style, "o"]; + endif + endif + + ## Make it a row vector. + tree = tree(:)'; + + ## The count of nodes of the graph. + num_nodes = length (tree); + + ## The number of children. + num_children = zeros (1, num_nodes+1); + + for i = 1:num_nodes + ## VEC_OF_CHILD is helping vector which is used to speed up the + ## choose of descendant nodes. + + num_children(tree(i)+1) = num_children(tree(i)+1) + 1; + endfor + pos = 1; + start = zeros (1, num_nodes+1); + xhelp = zeros (1, num_nodes+1); + stop = zeros (1, num_nodes+1); + for i = 1:num_nodes+1 + start(i) = pos; + xhelp(i) = pos; + pos += num_children(i); + stop(i) = pos; + endfor + for i = 1:num_nodes + vec_of_child(xhelp(tree(i)+1)) = i; + xhelp(tree(i)+1) = xhelp(tree(i)+1)+1; + endfor + + ## The number of "parent" (actual) node (it's descendants will be + ## browse in the next iteration). + par_number = 0; + + ## The x-coordinate of the left most descendant of "parent node" + ## this value is increased in each leaf. + left_most = 0; + + ## The level of "parent" node (root level is num_nodes). + level = num_nodes; + + ## Num_nodes - max_ht is the height of this graph. + max_ht = num_nodes; + + ## Main stack - each item consists of two numbers - the number of + ## node and the number it's of parent node on the top of stack + ## there is "parent node". + stk = [-1, 0]; + + ## Stack which is use to draw the graph edge (it have to be + ## uninterupted line). + skelet = 0; + + ## The top of the stack. + while (par_number != -1) + if (start(par_number+1) < stop(par_number+1)) + idx = vec_of_child(start(par_number+1):stop(par_number+1)-1); + else + idx = zeros (1, 0); + endif + ## Add to idx the vector of parent descendants. + stk = [stk; [idx', ones(fliplr(size(idx)))*par_number]]; + ## Add to stack the records relevant to parent descandant s. + if (par_number != 0) + skelet = [skelet; ([ones(size(idx))*par_number; idx])(:)]; + endif + + ## If there is not any descendant of "parent node": + if (stk(end,2) != par_number) + left_most++; + x_coordinate_r(par_number) = left_most; + max_ht = min (max_ht, level); + if (length(stk) > 1 && find ((shift(stk,1)-stk) == 0) > 1 + && stk(end,2) != stk(end-1,2)) + ## Return to the nearest branching the position to return + ## position is the position on the stack, where should be + ## started further search (there are two nodes which has the + ## same parent node). + position = (find ((shift(stk(:,2),1)-stk(:,2)) == 0))(end) + 1; + par_number_vec = stk(position:end,2); + ## The vector of removed nodes (the content of stack form + ## position to end). + skelet = [skelet; flipud(par_number_vec)]; + level += length (par_number_vec); + ## The level have to be decreased. + x_coordinate_r(par_number_vec) = left_most; + stk(position:end,:) = []; + endif + ## Remove the next node from "searched branch". + stk(end,:) = []; + ## Choose new "parent node". + par_number = stk(end,1); + ## If there is another branch start to search it. + if (par_number != -1) + skelet = [skelet; stk(end,2); par_number]; + y_coordinate(par_number) = level; + x_coordinate_l(par_number) = left_most + 1; + endif + else + ## There were descendants of "parent nod" choose the last of + ## them and go on through it. + level--; + par_number = stk(end,1); + y_coordinate(par_number) = level; + x_coordinate_l(par_number) = left_most + 1; + endif + endwhile + + ## Calculate the x coordinates (the known values are the position + ## of most left and most right descendants). + x_coordinate = (x_coordinate_l + x_coordinate_r) / 2; + + ## FIXME -- we should probably stuff all the arguments into a cell + ## array and make a single call to plot here so we can avoid + ## setting the hold state... + + hold_is_on = ishold (); + unwind_protect + ## Plot graph nodes. + plot (x_coordinate, y_coordinate, node_style); + + ## Helping command - usable for plotting edges + skelet = [skelet; 0]; + + ## Draw graph edges. + idx = find (skelet == 0); + + hold ("on"); + ## Plot each tree component in one loop. + for i = 2:length(idx) + ## Tree component start. + istart = idx(i-1) + 1; + ## Tree component end. + istop = idx(i) - 1; + if (istop - istart < 1) + continue; + endif + plot (x_coordinate(skelet(istart:istop)), + y_coordinate(skelet(istart:istop)), edge_style); + endfor + + ## Set axis and graph size. + axis ([0.5, left_most+0.5, max_ht-0.5, num_nodes-0.5], "nolabel"); + + unwind_protect_cleanup + if (! hold_is_on) + hold ("off"); + endif + end_unwind_protect + +endfunction + +%!demo +%! % Plot a simple tree plot +%! treeplot([2 4 2 0 6 4 6]) + +%!demo +%! % Plot a simple tree plot defining the edge and node styles +%! treeplot([2 4 2 0 6 4 6], "b+", "g") diff --git a/octave_packages/m/specfun/bessel.m b/octave_packages/m/specfun/bessel.m new file mode 100644 index 0000000..ee70433 --- /dev/null +++ b/octave_packages/m/specfun/bessel.m @@ -0,0 +1,94 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Loadable Function} {[@var{j}, @var{ierr}] =} besselj (@var{alpha}, @var{x}, @var{opt}) +## @deftypefnx {Loadable Function} {[@var{y}, @var{ierr}] =} bessely (@var{alpha}, @var{x}, @var{opt}) +## @deftypefnx {Loadable Function} {[@var{i}, @var{ierr}] =} besseli (@var{alpha}, @var{x}, @var{opt}) +## @deftypefnx {Loadable Function} {[@var{k}, @var{ierr}] =} besselk (@var{alpha}, @var{x}, @var{opt}) +## @deftypefnx {Loadable Function} {[@var{h}, @var{ierr}] =} besselh (@var{alpha}, @var{k}, @var{x}, @var{opt}) +## Compute Bessel or Hankel functions of various kinds: +## +## @table @code +## @item besselj +## Bessel functions of the first kind. If the argument @var{opt} is supplied, +## the result is multiplied by @code{exp(-abs(imag(x)))}. +## +## @item bessely +## Bessel functions of the second kind. If the argument @var{opt} is supplied, +## the result is multiplied by @code{exp(-abs(imag(x)))}. +## +## @item besseli +## Modified Bessel functions of the first kind. If the argument @var{opt} is +## supplied, +## the result is multiplied by @code{exp(-abs(real(x)))}. +## +## @item besselk +## Modified Bessel functions of the second kind. If the argument @var{opt} is +## supplied, +## the result is multiplied by @code{exp(x)}. +## +## @item besselh +## Compute Hankel functions of the first (@var{k} = 1) or second (@var{k} +## = 2) kind. If the argument @var{opt} is supplied, the result is multiplied +## by +## @code{exp (-I*@var{x})} for @var{k} = 1 or @code{exp (I*@var{x})} for +## @var{k} = 2. +## @end table +## +## If @var{alpha} is a scalar, the result is the same size as @var{x}. +## If @var{x} is a scalar, the result is the same size as @var{alpha}. +## If @var{alpha} is a row vector and @var{x} is a column vector, the +## result is a matrix with @code{length (@var{x})} rows and +## @code{length (@var{alpha})} columns. Otherwise, @var{alpha} and +## @var{x} must conform and the result will be the same size. +## +## The value of @var{alpha} must be real. The value of @var{x} may be +## complex. +## +## If requested, @var{ierr} contains the following status information +## and is the same size as the result. +## +## @enumerate 0 +## @item +## Normal return. +## +## @item +## Input error, return @code{NaN}. +## +## @item +## Overflow, return @code{Inf}. +## +## @item +## Loss of significance by argument reduction results in less than +## half of machine accuracy. +## +## @item +## Complete loss of significance by argument reduction, return @code{NaN}. +## +## @item +## Error---no computation, algorithm termination condition not met, +## return @code{NaN}. +## @end enumerate +## @end deftypefn + +function bessel () + error ("bessel: you must use besselj, bessely, besseli, or besselk"); +endfunction + +%!error bessel () diff --git a/octave_packages/m/specfun/beta.m b/octave_packages/m/specfun/beta.m new file mode 100644 index 0000000..e8c7548 --- /dev/null +++ b/octave_packages/m/specfun/beta.m @@ -0,0 +1,82 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} beta (@var{a}, @var{b}) +## For real inputs, return the Beta function, +## @tex +## $$ +## B (a, b) = {\Gamma (a) \Gamma (b) \over \Gamma (a + b)}. +## $$ +## @end tex +## @ifnottex +## +## @example +## beta (a, b) = gamma (a) * gamma (b) / gamma (a + b). +## @end example +## +## @end ifnottex +## @end deftypefn + +## Author: KH +## Created: 13 June 1993 +## Adapted-By: jwe + +function retval = beta (a, b) + + if (nargin != 2) + print_usage (); + endif + + if (any (size (a) != size (b)) && numel (a) != 1 && numel (b) != 1) + error ("beta: inputs A and B have inconsistent sizes"); + endif + + if (! isreal (a) || ! isreal (b)) + error ("beta: inputs A and B must be real"); + endif + + retval = real (exp (gammaln (a) + gammaln (b) - gammaln (a+b))); + +endfunction + +%!test +%! a=[1, 1.5, 2, 3]; +%! b=[4, 3, 2, 1]; +%! v1=beta(a,b); +%! v2=beta(b,a); +%! v3=gamma(a).*gamma(b)./gamma(a+b); +%! assert(all(abs(v1-v2). + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} betaln (@var{a}, @var{b}) +## Return the natural logarithm of the Beta function, +## @tex +## $$ +## {\rm betaln} (a, b) = \ln (B (a,b)) \equiv \ln ({\Gamma (a) \Gamma (b) \over \Gamma (a + b)}). +## $$ +## @end tex +## @ifnottex +## +## @example +## betaln (a, b) = log (beta (a, b)) +## @end example +## +## @end ifnottex +## calculated in a way to reduce the occurrence of underflow. +## @seealso{beta, betainc, gammaln} +## @end deftypefn + +## Author: Nicol N. Schraudolph +## Created: 06 Aug 1998 +## Keywords: log beta special function + +function retval = betaln (a, b) + + if (nargin != 2) + print_usage (); + endif + + retval = gammaln (a) + gammaln (b) - gammaln (a + b); + +endfunction + + +%!assert (betaln (3,4), log (beta(3,4)),eps); + +%% Test input validation +%!error (betaln (1)) +%!error (betaln (1,2,3)) diff --git a/octave_packages/m/specfun/factor.m b/octave_packages/m/specfun/factor.m new file mode 100644 index 0000000..9653b32 --- /dev/null +++ b/octave_packages/m/specfun/factor.m @@ -0,0 +1,95 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{p} =} factor (@var{q}) +## @deftypefnx {Function File} {[@var{p}, @var{n}] =} factor (@var{q}) +## +## Return prime factorization of @var{q}. That is, +## @code{prod (@var{p}) == @var{q}} and every element of @var{p} is a prime +## number. If @code{@var{q} == 1}, return 1. +## +## With two output arguments, return the unique primes @var{p} and +## their multiplicities. That is, @code{prod (@var{p} .^ @var{n}) == +## @var{q}}. +## @seealso{gcd, lcm} +## @end deftypefn + +## Author: Paul Kienzle + +## 2002-01-28 Paul Kienzle +## * remove recursion; only check existing primes for multiplicity > 1 +## * return multiplicity as suggested by Dirk Laurie +## * add error handling + +function [x, n] = factor (q) + + if (nargin < 1) + print_usage (); + endif + + if (! isscalar (q) || q != fix (q)) + error ("factor: Q must be a scalar integer"); + endif + + ## Special case of no primes less than sqrt(q). + if (q < 4) + x = q; + n = 1; + return; + endif + + x = []; + ## There is at most one prime greater than sqrt(q), and if it exists, + ## it has multiplicity 1, so no need to consider any factors greater + ## than sqrt(q) directly. [If there were two factors p1, p2 > sqrt(q), + ## then q >= p1*p2 > sqrt(q)*sqrt(q) == q. Contradiction.] + p = primes (sqrt (q)); + while (q > 1) + ## Find prime factors in remaining q. + p = p (rem (q, p) == 0); + if (isempty (p)) + ## Can't be reduced further, so q must itself be a prime. + p = q; + endif + x = [x, p]; + ## Reduce q. + q = q / prod (p); + endwhile + x = sort (x); + + ## Determine muliplicity. + if (nargout > 1) + idx = find ([0, x] != [x, 0]); + x = x(idx(1:length(idx)-1)); + n = diff (idx); + endif + +endfunction + +%!test +%! assert(factor(1),1); +%! for i=2:20 +%! p = factor(i); +%! assert(prod(p),i); +%! assert(all(isprime(p))); +%! [p,n] = factor(i); +%! assert(prod(p.^n),i); +%! assert(all([0,p]!=[p,0])); +%! endfor + diff --git a/octave_packages/m/specfun/factorial.m b/octave_packages/m/specfun/factorial.m new file mode 100644 index 0000000..f42a5a5 --- /dev/null +++ b/octave_packages/m/specfun/factorial.m @@ -0,0 +1,42 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} factorial (@var{n}) +## Return the factorial of @var{n} where @var{n} is a positive integer. If +## @var{n} is a scalar, this is equivalent to @code{prod (1:@var{n})}. For +## vector or matrix arguments, return the factorial of each element in the +## array. For non-integers see the generalized factorial function +## @code{gamma}. +## @seealso{prod, gamma} +## @end deftypefn + +function x = factorial (n) + if (nargin != 1) + print_usage (); + elseif (any (n(:) < 0 | n(:) != fix (n(:)))) + error ("factorial: N must all be non-negative integers"); + endif + x = round (gamma (n+1)); +endfunction + +%!assert (factorial(5), prod(1:5)) +%!assert (factorial([1,2;3,4]), [1,2;6,24]) +%!assert (factorial(70), exp(sum(log(1:70))), -128*eps) +%!fail ('factorial(5.5)', "must all be non-negative integers") +%!fail ('factorial(-3)', "must all be non-negative integers") diff --git a/octave_packages/m/specfun/isprime.m b/octave_packages/m/specfun/isprime.m new file mode 100644 index 0000000..496bfcb --- /dev/null +++ b/octave_packages/m/specfun/isprime.m @@ -0,0 +1,87 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isprime (@var{x}) +## Return a logical array which is true where the elements of @var{x} are +## prime numbers and false where they are not. +## +## If the maximum value in @var{x} is very large, then you should be using +## special purpose factorization code. +## +## @example +## @group +## isprime (1:6) +## @result{} [0, 1, 1, 0, 1, 0] +## @end group +## @end example +## @seealso{primes, factor, gcd, lcm} +## @end deftypefn + +function t = isprime (x) + + if (nargin == 1) + if (any ((x != floor (x) | x < 0)(:))) + error ("isprime: needs positive integers"); + endif + maxn = max (x(:)); + ## generate prime table of suitable length. + maxp = min (maxn, max (sqrt (maxn), 1e7)); # FIXME: threshold not optimized. + pr = primes (maxp); + ## quick search for table matches. + t = lookup (pr, x, "b"); + ## take the rest. + m = x(x > maxp); + if (! isempty (m)) + ## there are still possible primes. filter them out by division. + if (maxn <= intmax ("uint32")) + m = uint32 (m); + elseif (maxn <= intmax ("uint64")) + m = uint64 (m); + else + warning ("isprime: too large integers being tested"); + endif + pr = cast (pr(pr <= sqrt (maxn)), class (m)); + for p = pr + m = m(rem (m, p) != 0); + if (length (m) < length (pr) / 10) + break; + endif + endfor + pr = pr(pr > p); + mm = arrayfun (@(x) all (rem (x, pr)), m); + m = m(mm); + if (! isempty (m)) + m = cast (sort (m), class (x)); + t |= lookup (m, x, "b"); + endif + endif + + else + print_usage (); + endif + +endfunction + + +%!assert (isprime (4), logical (0)); +%!assert (isprime (3), logical (1)); +%!assert (isprime (magic (3)), logical ([0, 0, 0; 1, 1, 1; 0, 0, 1])); +%!error isprime () +%!error isprime (1, 2) diff --git a/octave_packages/m/specfun/lcm.m b/octave_packages/m/specfun/lcm.m new file mode 100644 index 0000000..c331d66 --- /dev/null +++ b/octave_packages/m/specfun/lcm.m @@ -0,0 +1,61 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} lcm (@var{x}, @var{y}) +## @deftypefnx {Mapping Function} {} lcm (@var{x}, @var{y}, @dots{}) +## Compute the least common multiple of @var{x} and @var{y}, +## or of the list of all arguments. All elements must be the same size or +## scalar. +## @seealso{factor, gcd} +## @end deftypefn + +## Author: KH +## Created: 16 September 1994 +## Adapted-By: jwe + +function l = lcm (varargin) + + if (nargin > 1) + if (common_size (varargin{:}) != 0) + error ("lcm: all args must be of the same size or scalar"); + elseif (! all (cellfun ("isnumeric", varargin))) + error ("lcm: all arguments must be numeric"); + endif + + l = varargin{1}; + for i = 2:nargin + x = varargin{i}; + msk = l == 0 & x == 0; + l .*= x ./ gcd (l, x); + l(msk) = 0; + endfor + else + print_usage (); + endif + +endfunction + +%!assert(lcm (3, 5, 7, 15) == 105); + +%!error lcm (); + +%!test +%! s.a = 1; +%! fail("lcm (s)"); + diff --git a/octave_packages/m/specfun/legendre.m b/octave_packages/m/specfun/legendre.m new file mode 100644 index 0000000..7e35f10 --- /dev/null +++ b/octave_packages/m/specfun/legendre.m @@ -0,0 +1,315 @@ +## Copyright (C) 2000-2012 Kai Habel +## Copyright (C) 2008 Marco Caliari +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{l} =} legendre (@var{n}, @var{x}) +## @deftypefnx {Function File} {@var{l} =} legendre (@var{n}, @var{x}, @var{normalization}) +## Compute the Legendre function of degree @var{n} and order +## @var{m} = 0 @dots{} N@. The optional argument, @var{normalization}, +## may be one of @code{"unnorm"}, @code{"sch"}, or @code{"norm"}. +## The default is @code{"unnorm"}. The value of @var{n} must be a +## non-negative scalar integer. +## +## If the optional argument @var{normalization} is missing or is +## @code{"unnorm"}, compute the Legendre function of degree @var{n} and +## order @var{m} and return all values for @var{m} = 0 @dots{} @var{n}. +## The return value has one dimension more than @var{x}. +## +## The Legendre Function of degree @var{n} and order @var{m}: +## +## @tex +## $$ +## P^m_n(x) = (-1)^m (1-x^2)^{m/2}{d^m\over {dx^m}}P_n (x) +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## m m 2 m/2 d^m +## P(x) = (-1) * (1-x ) * ---- P(x) +## n dx^m n +## @end group +## @end example +## +## @end ifnottex +## +## @noindent +## with Legendre polynomial of degree @var{n}: +## +## @tex +## $$ +## P(x) = {1\over{2^n n!}}\biggl({d^n\over{dx^n}}(x^2 - 1)^n\biggr) +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## 1 d^n 2 n +## P(x) = ------ [----(x - 1) ] +## n 2^n n! dx^n +## @end group +## @end example +## +## @end ifnottex +## +## @noindent +## @code{legendre (3, [-1.0, -0.9, -0.8])} returns the matrix: +## +## @example +## @group +## x | -1.0 | -0.9 | -0.8 +## ------------------------------------ +## m=0 | -1.00000 | -0.47250 | -0.08000 +## m=1 | 0.00000 | -1.99420 | -1.98000 +## m=2 | 0.00000 | -2.56500 | -4.32000 +## m=3 | 0.00000 | -1.24229 | -3.24000 +## @end group +## @end example +## +## If the optional argument @code{normalization} is @code{"sch"}, +## compute the Schmidt semi-normalized associated Legendre function. +## The Schmidt semi-normalized associated Legendre function is related +## to the unnormalized Legendre functions by the following: +## +## For Legendre functions of degree n and order 0: +## +## @tex +## $$ +## SP^0_n (x) = P^0_n (x) +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## 0 0 +## SP(x) = P(x) +## n n +## @end group +## @end example +## +## @end ifnottex +## +## For Legendre functions of degree n and order m: +## +## @tex +## $$ +## SP^m_n (x) = P^m_n (x)(-1)^m\biggl({2(n-m)!\over{(n+m)!}}\biggl)^{0.5} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## m m m 2(n-m)! 0.5 +## SP(x) = P(x) * (-1) * [-------] +## n n (n+m)! +## @end group +## @end example +## +## @end ifnottex +## +## If the optional argument @var{normalization} is @code{"norm"}, +## compute the fully normalized associated Legendre function. +## The fully normalized associated Legendre function is related +## to the unnormalized Legendre functions by the following: +## +## For Legendre functions of degree @var{n} and order @var{m} +## +## @tex +## $$ +## NP^m_n (x) = P^m_n (x)(-1)^m\biggl({(n+0.5)(n-m)!\over{(n+m)!}}\biggl)^{0.5} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## m m m (n+0.5)(n-m)! 0.5 +## NP(x) = P(x) * (-1) * [-------------] +## n n (n+m)! +## @end group +## @end example +## +## @end ifnottex +## @end deftypefn + +## Author: Marco Caliari + +function retval = legendre (n, x, normalization) + + persistent warned_overflow = false; + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (!isscalar (n) || n < 0 || n != fix (n)) + error ("legendre: N must be a non-negative scalar integer"); + endif + + if (!isreal (x) || any (x(:) < -1 | x(:) > 1)) + error ("legendre: X must be real-valued vector in the range -1 <= X <= 1"); + endif + + if (nargin == 3) + normalization = lower (normalization); + else + normalization = "unnorm"; + endif + + switch (normalization) + case "norm" + scale = sqrt (n+0.5); + case "sch" + scale = sqrt (2); + case "unnorm" + scale = 1; + otherwise + error ('legendre: expecting NORMALIZATION option to be "norm", "sch", or "unnorm"'); + endswitch + + scale = scale * ones (size (x)); + + ## Based on the recurrence relation below + ## m m m + ## (n-m+1) * P (x) = (2*n+1)*x*P (x) - (n+1)*P (x) + ## n+1 n n-1 + ## http://en.wikipedia.org/wiki/Associated_Legendre_function + + overflow = false; + retval = zeros([n+1, size(x)]); + for m = 1:n + lpm1 = scale; + lpm2 = (2*m-1) .* x .* scale; + lpm3 = lpm2; + for k = m+1:n + lpm3a = (2*k-1) .* x .* lpm2; + lpm3b = (k+m-2) .* lpm1; + lpm3 = (lpm3a - lpm3b)/(k-m+1); + lpm1 = lpm2; + lpm2 = lpm3; + if (! warned_overflow) + if (any (abs (lpm3a) > realmax) + || any (abs (lpm3b) > realmax) + || any (abs (lpm3) > realmax)) + overflow = true; + endif + endif + endfor + retval(m,:) = lpm3(:); + if (strcmp (normalization, "unnorm")) + scale = -scale * (2*m-1); + else + ## normalization == "sch" or normalization == "norm" + scale = scale / sqrt ((n-m+1)*(n+m))*(2*m-1); + endif + scale = scale .* sqrt(1-x.^2); + endfor + + retval(n+1,:) = scale(:); + + if (isvector (x)) + ## vector case is special + retval = reshape (retval, n + 1, length (x)); + endif + + if (strcmp (normalization, "sch")) + retval(1,:) = retval(1,:) / sqrt (2); + endif + + if (overflow && ! warned_overflow) + warning ("legendre: overflow - results may be unstable for high orders"); + warned_overflow = true; + endif + +endfunction + + +%!test +%! result = legendre (3, [-1.0 -0.9 -0.8]); +%! expected = [ +%! -1.00000 -0.47250 -0.08000 +%! 0.00000 -1.99420 -1.98000 +%! 0.00000 -2.56500 -4.32000 +%! 0.00000 -1.24229 -3.24000 +%! ]; +%! assert (result, expected, 1e-5); + +%!test +%! result = legendre (3, [-1.0 -0.9 -0.8], "sch"); +%! expected = [ +%! -1.00000 -0.47250 -0.08000 +%! 0.00000 0.81413 0.80833 +%! -0.00000 -0.33114 -0.55771 +%! 0.00000 0.06547 0.17076 +%! ]; +%! assert (result, expected, 1e-5); + +%!test +%! result = legendre (3, [-1.0 -0.9 -0.8], "norm"); +%! expected = [ +%! -1.87083 -0.88397 -0.14967 +%! 0.00000 1.07699 1.06932 +%! -0.00000 -0.43806 -0.73778 +%! 0.00000 0.08661 0.22590 +%! ]; +%! assert (result, expected, 1e-5); + +%!test +%! result = legendre (151, 0); +%! ## Don't compare to "-Inf" since it would fail on 64 bit systems. +%! assert (result(end) < -1.7976e308 && all (isfinite (result(1:end-1)))); + +%!test +%! result = legendre (150, 0); +%! ## This agrees with Matlab's result. +%! assert (result(end), 3.7532741115719e+306, 0.0000000000001e+306); + +%!test +%! result = legendre (0, 0:0.1:1); +%! assert (result, full(ones(1,11))); + +%!test +%! result = legendre (3, [-1,0,1;1,0,-1]); +%! ## Test matrix input +%! expected(:,:,1) = [-1,1;0,0;0,0;0,0]; +%! expected(:,:,2) = [0,0;1.5,1.5;0,0;-15,-15]; +%! expected(:,:,3) = [1,-1;0,0;0,0;0,0]; +%! assert (result, expected); + +%!test +%! result = legendre (3, [-1,0,1;1,0,-1]'); +%! expected(:,:,1) = [-1,0,1;0,1.5,0;0,0,0;0,-15,0]; +%! expected(:,:,2) = [1,0,-1;0,1.5,0;0,0,0;0,-15,0]; +%! assert (result, expected); + +%% Check correct invocation +%!error legendre (); +%!error legendre (1); +%!error legendre (1,2,3,4); +%!error legendre ([1, 2], [-1, 0, 1]); +%!error legendre (-1, [-1, 0, 1]); +%!error legendre (1.1, [-1, 0, 1]); +%!error legendre (1, [-1+i, 0, 1]); +%!error legendre (1, [-2, 0, 1]); +%!error legendre (1, [-1, 0, 2]); +%!error legendre (1, [-1, 0, 1], "badnorm"); diff --git a/octave_packages/m/specfun/nchoosek.m b/octave_packages/m/specfun/nchoosek.m new file mode 100644 index 0000000..f0ee3e9 --- /dev/null +++ b/octave_packages/m/specfun/nchoosek.m @@ -0,0 +1,157 @@ +## Copyright (C) 2001-2012 Rolf Fabian and Paul Kienzle +## Copyright (C) 2008 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{c} =} nchoosek (@var{n}, @var{k}) +## @deftypefnx {Function File} {@var{c} =} nchoosek (@var{set}, @var{k}) +## +## Compute the binomial coefficient or all combinations of a set of items. +## +## If @var{n} is a scalar then calculate the binomial coefficient +## of @var{n} and @var{k} which is defined as +## @tex +## $$ +## {n \choose k} = {n (n-1) (n-2) \cdots (n-k+1) \over k!} +## = {n! \over k! (n-k)!} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## / \ +## | n | n (n-1) (n-2) @dots{} (n-k+1) n! +## | | = ------------------------- = --------- +## | k | k! k! (n-k)! +## \ / +## @end group +## @end example +## +## @end ifnottex +## @noindent +## This is the number of combinations of @var{n} items taken in groups of +## size @var{k}. +## +## If the first argument is a vector, @var{set}, then generate all +## combinations of the elements of @var{set}, taken @var{k} at a time, with +## one row per combination. The result @var{c} has @var{k} columns and +## @w{@code{nchoosek (length (@var{set}), @var{k})}} rows. +## +## For example: +## +## How many ways can three items be grouped into pairs? +## +## @example +## @group +## nchoosek (3, 2) +## @result{} 3 +## @end group +## @end example +## +## What are the possible pairs? +## +## @example +## @group +## nchoosek (1:3, 2) +## @result{} 1 2 +## 1 3 +## 2 3 +## @end group +## @end example +## +## @code{nchoosek} works only for non-negative, integer arguments. Use +## @code{bincoeff} for non-integer and negative scalar arguments, or for +## computing many binomial coefficients at once with vector inputs +## for @var{n} or @var{k}. +## +## @seealso{bincoeff, perms} +## @end deftypefn + +## Author: Rolf Fabian +## Author: Paul Kienzle +## Author: Jaroslav Hajek + +function A = nchoosek (v, k) + + if (nargin != 2 + || !isnumeric (k) || !isnumeric (v) + || !isscalar (k) || ! (isscalar (v) || isvector (v))) + print_usage (); + endif + if (k < 0 || k != fix (k) + || (isscalar (v) && (v < k || v < 0 || v != fix (v)))) + error ("nchoosek: args are non-negative integers with V not less than K"); + endif + + n = length (v); + + if (n == 1) + ## Improve precision at next step. + k = min (k, v-k); + A = round (prod ((v-k+1:v)./(1:k))); + if (A*2*k*eps >= 0.5) + warning ("nchoosek", "nchoosek: possible loss of precision"); + endif + elseif (k == 0) + A = []; + elseif (k == 1) + A = v(:); + elseif (k == n) + A = v(:).'; + elseif (k > n) + A = zeros (0, k, class (v)); + elseif (k == 2) + ## Can do it without transpose. + x = repelems (v(1:n-1), [1:n-1; n-1:-1:1]).'; + y = cat (1, cellslices (v(:), 2:n, n*ones (1, n-1)){:}); + A = [x, y]; + elseif (k < n) + v = v(:).'; + A = v(k:n); + l = 1:n-k+1; + for j = 2:k + c = columns (A); + cA = cellslices (A, l, c*ones (1, n-k+1), 2); + l = c-l+1; + b = repelems (v(k-j+1:n-j+1), [1:n-k+1; l]); + A = [b; cA{:}]; + l = cumsum (l); + l = [1, 1 + l(1:n-k)]; + endfor + clear cA b; + A = A.'; + endif +endfunction + + +%!assert (nchoosek (80,10), bincoeff (80,10)) +%!assert (nchoosek(1:5,3), [1:3;1,2,4;1,2,5;1,3,4;1,3,5;1,4,5;2:4;2,3,5;2,4,5;3:5]) + +%% Test input validation +%!warning nchoosek (100,45); +%!error nchoosek ("100", 45) +%!error nchoosek (100, "45") +%!error nchoosek (100, ones (2,2)) +%!error nchoosek (repmat (100, [2 2]), 45) +%!error nchoosek (100, -45) +%!error nchoosek (100, 45.5) +%!error nchoosek (100, 145) +%!error nchoosek (-100, 45) +%!error nchoosek (100.5, 45) + diff --git a/octave_packages/m/specfun/nthroot.m b/octave_packages/m/specfun/nthroot.m new file mode 100644 index 0000000..c4eb489 --- /dev/null +++ b/octave_packages/m/specfun/nthroot.m @@ -0,0 +1,98 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## Copyright (C) 2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} nthroot (@var{x}, @var{n}) +## +## Compute the n-th root of @var{x}, returning real results for real +## components of @var{x}. For example: +## +## @example +## @group +## nthroot (-1, 3) +## @result{} -1 +## (-1) ^ (1 / 3) +## @result{} 0.50000 - 0.86603i +## @end group +## @end example +## +## @var{x} must have all real entries. @var{n} must be a scalar. +## If @var{n} is an even integer and @var{X} has negative entries, an +## error is produced. +## @seealso{realsqrt, sqrt, cbrt} +## @end deftypefn + +function y = nthroot (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (any (iscomplex (x(:)))) + error ("nthroot: X must not contain complex values"); + endif + + if (! isscalar (n) || n == 0) + error ("nthroot: N must be a nonzero scalar"); + endif + + if (n == 3) + y = cbrt (x); + elseif (n == -3) + y = 1 ./ cbrt (x); + elseif (n < 0) + y = 1 ./ nthroot (x, -n); + else + ## Compute using power. + if (n == fix (n) && mod (n, 2) == 1) + y = abs (x) .^ (1/n) .* sign (x); + elseif (any (x(:) < 0)) + error ("nthroot: if X contains negative values, N must be an odd integer"); + else + y = x .^ (1/n); + endif + + if (finite (n) && n > 0 && n == fix (n)) + ## Correction. + y = ((n-1)*y + x ./ (y.^(n-1))) / n; + y = merge (finite (y), y, x); + endif + + endif + +endfunction + +%!assert (nthroot(-32,5), -2); +%!assert (nthroot(81,4), 3); +%!assert (nthroot(Inf,4), Inf); +%!assert (nthroot(-Inf,7), -Inf); +%!assert (nthroot(-Inf,-7), 0); + +%% Test input validation +%!error (nthroot ()) +%!error (nthroot (1)) +%!error (nthroot (1,2,3)) +%!error (nthroot (1+j,2)) +%!error (nthroot (1,[1 2])) +%!error (nthroot (1,0)) +%!error (nthroot (-1,2)) + diff --git a/octave_packages/m/specfun/perms.m b/octave_packages/m/specfun/perms.m new file mode 100644 index 0000000..44f4707 --- /dev/null +++ b/octave_packages/m/specfun/perms.m @@ -0,0 +1,73 @@ +## Copyright (C) 2001-2012 Paul Kienzle +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} perms (@var{v}) +## +## Generate all permutations of @var{v}, one row per permutation. The +## result has size @code{factorial (@var{n}) * @var{n}}, where @var{n} +## is the length of @var{v}. +## +## As an example, @code{perms([1, 2, 3])} returns the matrix +## +## @example +## @group +## 1 2 3 +## 2 1 3 +## 1 3 2 +## 2 3 1 +## 3 1 2 +## 3 2 1 +## @end group +## @end example +## @end deftypefn + +function A = perms (v) + if (nargin != 1) + print_usage (); + endif + v = v(:); + n = length (v); + + if (n == 0) + A = []; + else + A = v(1); + for j = 2:n + B = A; + A = zeros (prod (2:j), n, class (v)); + k = size (B, 1); + idx = 1:k; + for i = j:-1:1 + A(idx,1:i-1) = B(:,1:i-1); + A(idx,i) = v(j); + A(idx,i+1:j) = B(:,i:j-1); + idx += k; + endfor + endfor + endif +endfunction + +%!error perms (); +%!error perms (1, 2); + +%!assert (perms ([1,2,3]), [1,2,3;2,1,3;1,3,2;2,3,1;3,1,2;3,2,1]); +%!assert (perms (1:3), perms ([1,2,3])); + +%!assert (perms (int8([1,2,3])), int8([1,2,3;2,1,3;1,3,2;2,3,1;3,1,2;3,2,1])); diff --git a/octave_packages/m/specfun/pow2.m b/octave_packages/m/specfun/pow2.m new file mode 100644 index 0000000..e5756af --- /dev/null +++ b/octave_packages/m/specfun/pow2.m @@ -0,0 +1,69 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Mapping Function} {} pow2 (@var{x}) +## @deftypefnx {Mapping Function} {} pow2 (@var{f}, @var{e}) +## With one argument, computes +## @tex +## $2^x$ +## @end tex +## @ifnottex +## 2 .^ x +## @end ifnottex +## for each element of @var{x}. +## +## With two arguments, returns +## @tex +## $f \cdot 2^e$. +## @end tex +## @ifnottex +## f .* (2 .^ e). +## @end ifnottex +## @seealso{log2, nextpow2} +## @end deftypefn + +## Author: AW +## Created: 17 October 1994 +## Adapted-By: jwe + +function y = pow2 (f, e) + + if (nargin == 1) + y = 2 .^ f; + elseif (nargin == 2) + y = f .* (2 .^ e); + else + print_usage (); + endif + +endfunction + +%!test +%! x = [3, 0, -3]; +%! v = [8, 1, .125]; +%! assert(all (abs (pow2 (x) - v) < sqrt (eps))); + +%!test +%! x = [3, 0, -3, 4, 0, -4, 5, 0, -5]; +%! y = [-2, -2, -2, 1, 1, 1, 3, 3, 3]; +%! z = x .* (2 .^ y); +%! assert(all (abs (pow2 (x,y) - z) < sqrt (eps))); + +%!error pow2(); + diff --git a/octave_packages/m/specfun/primes.m b/octave_packages/m/specfun/primes.m new file mode 100644 index 0000000..a2e99db --- /dev/null +++ b/octave_packages/m/specfun/primes.m @@ -0,0 +1,102 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} primes (@var{n}) +## +## Return all primes up to @var{n}. +## +## The algorithm used is the Sieve of Eratosthenes. +## +## Note that if you need a specific number of primes you can use the +## fact that the distance from one prime to the next is, on average, +## proportional to the logarithm of the prime. Integrating, one finds +## that there are about @math{k} primes less than +## @tex +## $k \log (5 k)$. +## @end tex +## @ifnottex +## k*log(5*k). +## @end ifnottex +## @seealso{list_primes, isprime} +## @end deftypefn + +## Author: Paul Kienzle +## Author: Francesco Potortì +## Author: Dirk Laurie + +function x = primes (n) + + if (nargin != 1) + print_usage (); + endif + + if (! isscalar (n)) + error ("primes: N must be a scalar"); + endif + + if (n > 100000) + ## Optimization: 1/6 less memory, and much faster (asymptotically) + ## 100000 happens to be the cross-over point for Paul's machine; + ## below this the more direct code below is faster. At the limit + ## of memory in Paul's machine, this saves .7 seconds out of 7 for + ## n = 3e6. Hardly worthwhile, but Dirk reports better numbers. + lenm = floor ((n+1)/6); # length of the 6n-1 sieve + lenp = floor ((n-1)/6); # length of the 6n+1 sieve + sievem = true (1, lenm); # assume every number of form 6n-1 is prime + sievep = true (1, lenp); # assume every number of form 6n+1 is prime + + for i = 1:(sqrt(n)+1)/6 # check up to sqrt(n) + if (sievem(i)) # if i is prime, eliminate multiples of i + sievem(7*i-1:6*i-1:lenm) = false; + sievep(5*i-1:6*i-1:lenp) = false; + endif # if i is prime, eliminate multiples of i + if (sievep(i)) + sievep(7*i+1:6*i+1:lenp) = false; + sievem(5*i+1:6*i+1:lenm) = false; + endif + endfor + x = sort([2, 3, 6*find(sievem)-1, 6*find(sievep)+1]); + elseif (n > 352) # nothing magical about 352; must be >2 + len = floor ((n-1)/2); # length of the sieve + sieve = true (1, len); # assume every odd number is prime + for i = 1:(sqrt(n)-1)/2 # check up to sqrt(n) + if (sieve(i)) # if i is prime, eliminate multiples of i + sieve(3*i+1:2*i+1:len) = false; # do it + endif + endfor + x = [2, 1+2*find(sieve)]; # primes remaining after sieve + else + a = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, ... + 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, ... + 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, ... + 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, ... + 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, ... + 293, 307, 311, 313, 317, 331, 337, 347, 349]; + x = a(a <= n); + endif + +endfunction + +%!error primes (); +%!error primes (1, 2); + +%!assert (size (primes (350)), [1, 70]); +%!assert (size (primes (350)), [1, 70]); + +%!assert (primes (357)(end), 353); diff --git a/octave_packages/m/specfun/reallog.m b/octave_packages/m/specfun/reallog.m new file mode 100644 index 0000000..7e36ac3 --- /dev/null +++ b/octave_packages/m/specfun/reallog.m @@ -0,0 +1,40 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} reallog (@var{x}) +## Return the real-valued natural logarithm of each element of @var{x}. Report +## an error if any element results in a complex return value. +## @seealso{log, realpow, realsqrt} +## @end deftypefn + +function y = reallog (x) + if (nargin != 1) + print_usage (); + elseif (iscomplex (x) || any (x(:) < 0)) + error ("reallog: produced complex result"); + else + y = log (x); + endif +endfunction + +%!assert (log(1:5),reallog(1:5)) +%!test +%! x = rand (10,10); +%! assert (log(x),reallog(x)) +%!error (reallog(-1)) diff --git a/octave_packages/m/specfun/realpow.m b/octave_packages/m/specfun/realpow.m new file mode 100644 index 0000000..7c32a95 --- /dev/null +++ b/octave_packages/m/specfun/realpow.m @@ -0,0 +1,45 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} realpow (@var{x}, @var{y}) +## Compute the real-valued, element-by-element power operator. This is +## equivalent to @w{@code{@var{x} .^ @var{y}}}, except that @code{realpow} +## reports an error if any return value is complex. +## @seealso{reallog, realsqrt} +## @end deftypefn + +function z = realpow (x, y) + if (nargin != 2) + print_usage (); + else + z = x .^ y; + if (iscomplex (z)) + error ("realpow: produced complex result"); + endif + endif +endfunction + +%!assert (power (1:10, 0.5:0.5:5), realpow (1:10, 0.5:0.5:5)) +%!assert ([1:10] .^ [0.5:0.5:5], realpow (1:10, 0.5:0.5:5)) +%!test +%! x = rand (10,10); +%! y = randn (10,10); +%! assert (x.^y,realpow(x,y)) +%!assert (realpow(1i,2),-1) +%!error (realpow(-1, 1/2)) diff --git a/octave_packages/m/specfun/realsqrt.m b/octave_packages/m/specfun/realsqrt.m new file mode 100644 index 0000000..2fa197b --- /dev/null +++ b/octave_packages/m/specfun/realsqrt.m @@ -0,0 +1,40 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} realsqrt (@var{x}) +## Return the real-valued square root of each element of @var{x}. Report an +## error if any element results in a complex return value. +## @seealso{sqrt, realpow, reallog} +## @end deftypefn + +function y = realsqrt (x) + if (nargin != 1) + print_usage (); + elseif (iscomplex (x) || any (x(:) < 0)) + error ("realsqrt: produced complex result"); + else + y = sqrt (x); + endif +endfunction + +%!assert (sqrt(1:5),realsqrt(1:5)) +%!test +%! x = rand (10,10); +%! assert (sqrt(x),realsqrt(x)) +%!error (realsqrt(-1)) diff --git a/octave_packages/m/special-matrix/hadamard.m b/octave_packages/m/special-matrix/hadamard.m new file mode 100644 index 0000000..f7426c7 --- /dev/null +++ b/octave_packages/m/special-matrix/hadamard.m @@ -0,0 +1,175 @@ +## Copyright (C) 1993-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} hadamard (@var{n}) +## Construct a Hadamard matrix (@nospell{Hn}) of size @var{n}-by-@var{n}. The +## size @var{n} must be of the form @math{2^k * p} in which +## p is one of 1, 12, 20 or 28. The returned matrix is normalized, +## meaning @w{@code{Hn(:,1) == 1}} and @w{@code{Hn(1,:) == 1}}. +## +## Some of the properties of Hadamard matrices are: +## +## @itemize @bullet +## @item +## @code{kron (Hm, Hn)} is a Hadamard matrix of size @var{m}-by-@var{n}. +## +## @item +## @code{Hn * Hn' = @var{n} * eye (@var{n})}. +## +## @item +## The rows of @nospell{Hn} are orthogonal. +## +## @item +## @code{det (@var{A}) <= abs (det (Hn))} for all @var{A} with +## @w{@code{abs (@var{A}(i, j)) <= 1}}. +## +## @item +## Multiplying any row or column by -1 and the matrix will remain a Hadamard +## matrix. +## @end itemize +## @seealso{compan, hankel, toeplitz} +## @end deftypefn + + +## Reference [1] contains a list of Hadamard matrices up to n=256. +## See code for h28 in hadamard.m for an example of how to extend +## this function for additional p. +## +## References: +## [1] A Library of Hadamard Matrices, N. J. A. Sloane +## http://www.research.att.com/~njas/hadamard/ + +function h = hadamard (n) + + if (nargin != 1) + print_usage (); + endif + + ## Find k if n = 2^k*p. + k = 0; + while (n > 1 && fix (n/2) == n/2) + k++; + n /= 2; + endwhile + + ## Find base hadamard. + ## Except for n=2^k, need a multiple of 4. + if (n != 1) + k -= 2; + endif + + ## Trigger error if not a multiple of 4. + if (k < 0) + n =- 1; + endif + + switch (n) + case 1 + h = 1; + case 3 + h = h12 (); + case 5 + h = h20 (); + case 7 + h = h28 (); + otherwise + error ("hadamard: N must be 2^k*p, for p = 1, 12, 20 or 28"); + endswitch + + ## Build H(2^k*n) from kron(H(2^k),H(n)). + h2 = [1,1;1,-1]; + while (true) + if (fix (k/2) != k/2) + h = kron (h2, h); + endif + k = fix (k/2); + if (k == 0) + break; + endif + h2 = kron (h2, h2); + endwhile + +endfunction + +function h = h12 () + tu = [-1,+1,-1,+1,+1,+1,-1,-1,-1,+1,-1]; + tl = [-1,-1,+1,-1,-1,-1,+1,+1,+1,-1,+1]; + ## Note: assert (tu(2:end), tl(end:-1:2)). + h = ones (12); + h(2:end,2:end) = toeplitz (tu, tl); +endfunction + +function h = h20 () + tu = [+1,-1,-1,+1,+1,+1,+1,-1,+1,-1,+1,-1,-1,-1,-1,+1,+1,-1,-1]; + tl = [+1,-1,-1,+1,+1,-1,-1,-1,-1,+1,-1,+1,-1,+1,+1,+1,+1,-1,-1]; + ## Note: assert (tu(2:end), tl(end:-1:2)). + h = ones (20); + h(2:end,2:end) = fliplr (toeplitz (tu, tl)); +endfunction + +function h = h28 () + ## Williamson matrix construction from + ## http://www.research.att.com/~njas/hadamard/had.28.will.txt + ## Normalized so that each row and column starts with +1 + h = [1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 + 1 1 -1 -1 -1 -1 -1 -1 -1 1 -1 -1 -1 1 1 1 1 1 -1 1 1 1 1 -1 1 -1 1 -1 + 1 -1 1 -1 -1 -1 -1 1 -1 1 1 -1 -1 1 -1 -1 -1 -1 1 1 -1 1 -1 1 1 1 1 1 + 1 -1 -1 1 -1 -1 -1 1 1 1 1 1 -1 1 1 1 1 1 -1 -1 -1 -1 -1 -1 -1 1 -1 1 + 1 -1 -1 -1 1 -1 -1 1 1 -1 1 1 1 1 1 -1 -1 -1 1 1 1 -1 1 -1 1 -1 -1 -1 + 1 -1 -1 -1 -1 1 -1 1 1 -1 -1 1 1 -1 -1 -1 1 1 -1 -1 -1 1 1 1 1 1 1 -1 + 1 -1 -1 -1 -1 -1 1 -1 1 -1 -1 -1 1 -1 1 1 1 -1 1 1 1 1 -1 1 -1 1 -1 1 + 1 -1 1 1 1 1 -1 -1 1 -1 -1 -1 -1 1 1 1 -1 -1 -1 -1 1 -1 -1 1 1 1 1 -1 + 1 -1 -1 1 1 1 1 1 -1 -1 -1 -1 -1 1 -1 -1 -1 1 -1 1 1 1 1 -1 -1 1 -1 1 + 1 1 1 1 -1 -1 -1 -1 -1 -1 1 1 1 -1 1 -1 -1 -1 -1 -1 1 1 1 -1 -1 1 1 1 + 1 -1 1 1 1 -1 -1 -1 -1 1 -1 1 1 -1 -1 -1 1 1 -1 1 1 -1 -1 1 1 -1 -1 1 + 1 -1 -1 1 1 1 -1 -1 -1 1 1 -1 1 -1 -1 1 1 -1 1 1 -1 -1 1 -1 -1 1 1 -1 + 1 -1 -1 -1 1 1 1 -1 -1 1 1 1 -1 -1 1 1 -1 -1 -1 -1 -1 1 1 1 1 -1 -1 1 + 1 1 1 1 1 -1 -1 1 1 -1 -1 -1 -1 -1 -1 1 1 -1 1 -1 -1 1 1 -1 1 -1 -1 1 + 1 1 -1 1 1 -1 1 -1 1 -1 1 1 -1 1 -1 -1 1 -1 -1 1 -1 1 -1 1 -1 -1 1 -1 + 1 1 -1 1 -1 -1 1 -1 1 1 1 -1 -1 -1 -1 -1 -1 1 1 -1 1 -1 1 1 1 1 -1 -1 + 1 1 -1 1 -1 1 1 1 1 1 -1 -1 1 -1 1 -1 -1 -1 -1 1 -1 -1 -1 -1 1 -1 1 1 + 1 1 -1 1 -1 1 -1 1 -1 1 -1 1 1 1 -1 1 -1 -1 1 -1 1 1 -1 1 -1 -1 -1 -1 + 1 -1 1 -1 1 -1 1 1 1 1 1 -1 1 -1 -1 1 -1 1 -1 -1 1 1 -1 -1 -1 -1 1 -1 + 1 1 1 -1 1 -1 1 1 -1 1 -1 -1 1 1 1 -1 1 -1 -1 -1 -1 -1 1 1 -1 1 -1 -1 + 1 1 -1 -1 1 -1 1 -1 -1 -1 -1 1 1 1 -1 1 -1 1 1 -1 -1 -1 -1 -1 1 1 1 1 + 1 1 1 -1 -1 1 1 1 -1 -1 1 1 -1 -1 -1 1 1 -1 -1 1 1 -1 -1 -1 1 1 -1 -1 + 1 1 -1 -1 1 1 -1 1 -1 -1 1 -1 -1 -1 1 -1 1 1 1 -1 1 -1 -1 1 -1 -1 1 1 + 1 -1 1 -1 -1 1 1 -1 1 1 -1 1 -1 1 -1 -1 1 -1 1 -1 1 -1 1 -1 -1 -1 1 1 + 1 1 1 -1 1 1 -1 -1 1 1 -1 1 -1 -1 1 -1 -1 1 1 1 -1 1 -1 -1 -1 1 -1 -1 + 1 -1 1 1 -1 1 1 -1 -1 -1 1 -1 1 1 1 -1 1 1 1 -1 -1 1 -1 -1 1 -1 -1 -1 + 1 1 1 -1 -1 1 -1 -1 1 -1 1 -1 1 1 -1 1 -1 1 -1 1 -1 -1 1 1 -1 -1 -1 1 + 1 -1 1 1 -1 -1 1 1 -1 -1 -1 1 -1 -1 1 1 -1 1 1 1 -1 -1 1 1 -1 -1 1 -1]; +endfunction + + +%!assert (hadamard (1), 1) +%!assert (hadamard (2), [1,1;1,-1]) +%!test +%! for n = [1,2,4,8,12,24,48,20,28,2^9] +%! h = hadamard(n); +%! assert (norm (h*h' - n*eye (n)), 0); +%! endfor + +%!error hadamard () +%!error hadamard (1,2) +%!error hadamard (5) + diff --git a/octave_packages/m/special-matrix/hankel.m b/octave_packages/m/special-matrix/hankel.m new file mode 100644 index 0000000..473d27c --- /dev/null +++ b/octave_packages/m/special-matrix/hankel.m @@ -0,0 +1,98 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hankel (@var{c}) +## @deftypefnx {Function File} {} hankel (@var{c}, @var{r}) +## Return the Hankel matrix constructed from the first column @var{c}, and +## (optionally) the last row @var{r}. If the last element of @var{c} is +## not the same as the first element of @var{r}, the last element of +## @var{c} is used. If the second argument is omitted, it is assumed to +## be a vector of zeros with the same size as @var{c}. +## +## A Hankel matrix formed from an m-vector @var{c}, and an n-vector +## @var{r}, has the elements +## @tex +## $$ +## H(i, j) = \cases{c_{i+j-1},&$i+j-1\le m$;\cr r_{i+j-m},&otherwise.\cr} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## H(i,j) = c(i+j-1), i+j-1 <= m; +## H(i,j) = r(i+j-m), otherwise +## @end group +## @end example +## +## @end ifnottex +## @seealso{hadamard, toeplitz} +## @end deftypefn + +## Author: jwe + +function retval = hankel (c, r) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1) + + if (! isvector (c)) + error ("hankel: C must be a vector"); + endif + + nr = length (c); + nc = nr; + data = [c(:) ; zeros(nr, 1)]; + + else + + if (! (isvector (c) && isvector (r))) + error ("hankel: C and R must be vectors"); + elseif (r(1) != c(end)) + warning ("hankel: column wins anti-diagonal conflict"); + endif + + nr = length (c); + nc = length (r); + data = [c(:) ; r(2:end)(:)]; + + endif + + slices = cellslices (data, 1:nc, nr:1:nc+nr-1); + retval = horzcat (slices{:}); + +endfunction + + +%!assert (hankel (1), [1]) +%!assert (hankel ([1, 2]), [1, 2; 2, 0]) +%!assert (hankel ([1, 2], [2; -1; -3]), [1, 2, -1; 2, -1, -3]) +%!assert (hankel (1:3), [1,2,3;2,3,0;3,0,0]) +%!assert (hankel (1:3,3:6), [1,2,3,4;2,3,4,5;3,4,5,6]) +%!assert (hankel (1:3,3:4), [1,2;2,3;3,4]) +%!assert (hankel (1:3,4:6), [1,2,3;2,3,5;3,5,6]) + +%!error hankel (); +%!error hankel (1, 2, 3); +%!error hankel ([1, 2; 3, 4]) +%!error hankel (1:4, [1, 2; 3, 4]) + diff --git a/octave_packages/m/special-matrix/hilb.m b/octave_packages/m/special-matrix/hilb.m new file mode 100644 index 0000000..d34ba7d --- /dev/null +++ b/octave_packages/m/special-matrix/hilb.m @@ -0,0 +1,79 @@ +## Copyright (C) 1993-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hilb (@var{n}) +## Return the Hilbert matrix of order @var{n}. The @math{i,j} element +## of a Hilbert matrix is defined as +## @tex +## $$ +## H(i, j) = {1 \over (i + j - 1)} +## $$ +## @end tex +## @ifnottex +## +## @example +## H(i, j) = 1 / (i + j - 1) +## @end example +## +## @end ifnottex +## +## Hilbert matrices are close to being singular which make them difficult to +## invert with numerical routines. +## Comparing the condition number of a random matrix 5x5 matrix with that of +## a Hilbert matrix of order 5 reveals just how difficult the problem is. +## +## @example +## @group +## cond (rand (5)) +## @result{} 14.392 +## cond (hilb (5)) +## @result{} 4.7661e+05 +## @end group +## @end example +## +## @seealso{invhilb} +## @end deftypefn + +## Author: jwe + +function retval = hilb (n) + + if (nargin != 1) + print_usage (); + elseif (! isscalar (n)) + error ("hilb: N must be a scalar integer"); + endif + + retval = zeros (n); + tmp = 1:n; + for i = 1:n + retval(i, :) = 1.0 ./ tmp; + tmp++; + endfor + +endfunction + + +%!assert (hilb (2), [1, 1/2; 1/2, 1/3]) +%!assert (hilb (3), [1, 1/2, 1/3; 1/2, 1/3, 1/4; 1/3, 1/4, 1/5]) + +%!error hilb () +%!error hilb (1, 2) +%!error hilb (ones(2)) + diff --git a/octave_packages/m/special-matrix/invhilb.m b/octave_packages/m/special-matrix/invhilb.m new file mode 100644 index 0000000..464bfb8 --- /dev/null +++ b/octave_packages/m/special-matrix/invhilb.m @@ -0,0 +1,128 @@ +## Copyright (C) 1993-2012 Dirk Laurie +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} invhilb (@var{n}) +## Return the inverse of the Hilbert matrix of order @var{n}. This can be +## computed exactly using +## @tex +## $$\eqalign{ +## A_{ij} &= -1^{i+j} (i+j-1) +## \left( \matrix{n+i-1 \cr n-j } \right) +## \left( \matrix{n+j-1 \cr n-i } \right) +## \left( \matrix{i+j-2 \cr i-2 } \right)^2 \cr +## &= { p(i)p(j) \over (i+j-1) } +## }$$ +## where +## $$ +## p(k) = -1^k \left( \matrix{ k+n-1 \cr k-1 } \right) +## \left( \matrix{ n \cr k } \right) +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## +## (i+j) /n+i-1\ /n+j-1\ /i+j-2\ 2 +## A(i,j) = -1 (i+j-1)( )( ) ( ) +## \ n-j / \ n-i / \ i-2 / +## +## = p(i) p(j) / (i+j-1) +## +## @end group +## @end example +## +## @noindent +## where +## +## @example +## @group +## k /k+n-1\ /n\ +## p(k) = -1 ( ) ( ) +## \ k-1 / \k/ +## @end group +## @end example +## +## @end ifnottex +## The validity of this formula can easily be checked by expanding +## the binomial coefficients in both formulas as factorials. It can +## be derived more directly via the theory of Cauchy matrices. +## See J. W. Demmel, @cite{Applied Numerical Linear Algebra}, p. 92. +## +## Compare this with the numerical calculation of @code{inverse (hilb (n))}, +## which suffers from the ill-conditioning of the Hilbert matrix, and the +## finite precision of your computer's floating point arithmetic. +## @seealso{hilb} +## @end deftypefn + +## Author: Dirk Laurie + +function retval = invhilb (n) + + if (nargin != 1) + print_usage (); + elseif (! isscalar (n)) + error ("invhilb: N must be a scalar integer"); + endif + + ## The point about the second formula above is that when vectorized, + ## p(k) is evaluated for k=1:n which involves O(n) calls to bincoeff + ## instead of O(n^2). + ## + ## We evaluate the expression as (-1)^(i+j)*(p(i)*p(j))/(i+j-1) except + ## when p(i)*p(j) would overflow. In cases where p(i)*p(j) is an exact + ## machine number, the result is also exact. Otherwise we calculate + ## (-1)^(i+j)*p(i)*(p(j)/(i+j-1)). + ## + ## The Octave bincoeff routine uses transcendental functions (gammaln + ## and exp) rather than multiplications, for the sake of speed. + ## However, it rounds the answer to the nearest integer, which + ## justifies the claim about exactness made above. + + retval = zeros (n); + k = [1:n]; + p = k .* bincoeff (k+n-1, k-1) .* bincoeff (n, k); + p(2:2:n) = -p(2:2:n); + if (n < 203) + for l = 1:n + retval(l,:) = (p(l) * p) ./ [l:l+n-1]; + endfor + else + for l = 1:n + retval(l,:) = p(l) * (p ./ [l:l+n-1]); + endfor + endif + +endfunction + + +%!assert (invhilb (1), 1) +%!assert (invhilb (2), [4, -6; -6, 12]) +%!test +%! result4 = [16 , -120 , 240 , -140; +%! -120, 1200 , -2700, 1680; +%! 240 , -2700, 6480 , -4200; +%! -140, 1680 , -4200, 2800]; +%! assert (invhilb (4), result4); +%!assert (abs (invhilb (7) * hilb (7) - eye (7)) < sqrt (eps)) + +%!error invhilb () +%!error invhilb (1, 2) +%!error invhilb ([1, 2]) + diff --git a/octave_packages/m/special-matrix/magic.m b/octave_packages/m/special-matrix/magic.m new file mode 100644 index 0000000..7805f14 --- /dev/null +++ b/octave_packages/m/special-matrix/magic.m @@ -0,0 +1,97 @@ +## Copyright (C) 1999-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} magic (@var{n}) +## +## Create an @var{n}-by-@var{n} magic square. A magic square is an arrangement +## of the integers @code{1:n^2} such that the row sums, column sums, and +## diagonal sums are all equal to the same value. +## +## Note: @var{n} must be greater than 2 for the magic square to exist. +## @end deftypefn + +function A = magic(n) + + if (nargin != 1) + print_usage (); + endif + + if (n != fix (n) || n < 0 || n == 2) + error ("magic: N must be a positive integer not equal to 2"); + endif + + if (n == 0) + + A = []; + + elseif (mod (n, 2) == 1) + + shift = floor ((0:n*n-1)/n); + c = mod ([1:n*n] - shift + (n-3)/2, n); + r = mod ([n*n:-1:1] + 2*shift, n); + A(c*n+r+1) = 1:n*n; + A = reshape (A, n, n); + + elseif (mod (n, 4) == 0) + + A = reshape (1:n*n, n, n)'; + I = [1:4:n, 4:4:n]; + J = fliplr (I); + A(I,I) = A(J,J); + I = [2:4:n, 3:4:n]; + J = fliplr (I); + A(I,I) = A(J,J); + + elseif (mod (n, 4) == 2) + + m = n/2; + A = magic (m); + A = [A, A+2*m*m; A+3*m*m, A+m*m]; + k = (m-1)/2; + if (k > 1) + I = 1:m; + J = [2:k, n-k+2:n]; + A([I,I+m],J) = A([I+m,I],J); + endif + I = [1:k, k+2:m]; + A([I,I+m],1) = A([I+m,I],1); + I = k + 1; + A([I,I+m],I) = A([I+m,I],I); + + endif + +endfunction + + +%!test +%! for i=3:30 +%! A = magic (i); +%! assert (norm(diff([sum(diag(A)),sum(diag(flipud(A))),sum(A),sum(A')])),0); +%! endfor + +%!assert (isempty (magic (0))) +%!assert (magic(1), 1) + +%% Test input validation +%!error magic () +%!error magic (1, 2) +%!error magic (1.5) +%!error magic (-1) +%!error magic (2) + diff --git a/octave_packages/m/special-matrix/pascal.m b/octave_packages/m/special-matrix/pascal.m new file mode 100644 index 0000000..b3a77a9 --- /dev/null +++ b/octave_packages/m/special-matrix/pascal.m @@ -0,0 +1,90 @@ +## Copyright (C) 1999-2012 Peter Ekberg +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} pascal (@var{n}) +## @deftypefnx {Function File} {} pascal (@var{n}, @var{t}) +## Return the Pascal matrix of order @var{n} if @code{@var{t} = 0}. @var{t} +## defaults to 0. Return the pseudo-lower triangular Cholesky@tie{}factor of +## the Pascal matrix if @code{@var{t} = 1} (The sign of some columns may be +## negative). This matrix is its own inverse, that is @code{pascal (@var{n}, +## 1) ^ 2 == eye (@var{n})}. If @code{@var{t} = -1}, return the true +## Cholesky@tie{}factor with strictly positive values on the diagonal. If +## @code{@var{t} = 2}, return a transposed and permuted version of @code{pascal +## (@var{n}, 1)}, which is the cube root of the identity matrix. That is, +## @code{pascal (@var{n}, 2) ^ 3 == eye (@var{n})}. +## +## @seealso{chol} +## @end deftypefn + +## Author: Peter Ekberg +## (peda) + +function retval = pascal (n, t = 0) + + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (! (isscalar (n) && isscalar (t))) + error ("pascal: N and T must be scalars"); + elseif (! any (t == [-1, 0, 1, 2])) + error ("pascal: expecting T to be -1, 0, 1, or 2, found %d", t); + endif + + retval = zeros (n); + if (n > 0) + retval(:,1) = 1; + endif + + if (t == -1) + for j = 2:n + retval(j:n,j) = cumsum (retval(j-1:n-1,j-1)); + endfor + else + for j = 2:n + retval(j:n,j) = -cumsum (retval(j-1:n-1,j-1)); + endfor + endif + + if (t == 0) + retval = retval*retval'; + elseif (t == 2) + retval = rot90 (retval, 3); + if (rem (n,2) != 1) + retval *= -1; + endif + endif + +endfunction + + +%!assert (pascal (3,-1), [1,0,0;1,1,0;1,2,1]) +%!assert (pascal (3,0), [1,1,1;1,2,3;1,3,6]) +%!assert (pascal (3,0), pascal (3)) +%!assert (pascal (3,1), [1,0,0;1,-1,0;1,-2,1]) +%!assert (pascal (3,2), [1,1,1;-2,-1,0;1,0,0]) +%!assert (pascal (0,2), []) + +%% Test input validation +%!error pascal () +%!error pascal (1,2,3) +%!error pascal ([1 2]) +%!error pascal (1, [1 2]) +%!error pascal (3,-2) +%!error pascal (3,4) + diff --git a/octave_packages/m/special-matrix/rosser.m b/octave_packages/m/special-matrix/rosser.m new file mode 100644 index 0000000..0c5a688 --- /dev/null +++ b/octave_packages/m/special-matrix/rosser.m @@ -0,0 +1,48 @@ +## Copyright (C) 1999-2012 Peter Ekberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rosser () +## Return the Rosser matrix. This is a difficult test case used to evaluate +## eigenvalue algorithms. +## +## @seealso{wilkinson, eig} +## @end deftypefn + +## Author: Peter Ekberg +## (peda) + +function retval = rosser () + + if (nargin != 0) + print_usage (); + endif + + retval = [611, 196, -192, 407, -8, -52, -49, 29; + 196, 899, 113, -192, -71, -43, -8, -44; + -192, 113, 899, 196, 61, 49, 8, 52; + 407, -192, 196, 611, 8, 44, 59, -23; + -8, -71, 61, 8, 411, -599, 208, 208; + -52, -43, 49, 44, -599, 411, 208, 208; + -49, -8, 8, 59, 208, 208, 99, -911; + 29, -44, 52, -23, 208, 208, -911, 99]; + +endfunction + +%!assert (size(rosser()), [8,8]) +%!error (rosser(1)) diff --git a/octave_packages/m/special-matrix/toeplitz.m b/octave_packages/m/special-matrix/toeplitz.m new file mode 100644 index 0000000..f056a50 --- /dev/null +++ b/octave_packages/m/special-matrix/toeplitz.m @@ -0,0 +1,134 @@ +## Copyright (C) 1993-2012 John W. Eaton +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} toeplitz (@var{c}) +## @deftypefnx {Function File} {} toeplitz (@var{c}, @var{r}) +## Return the Toeplitz matrix constructed from the first column @var{c}, +## and (optionally) the first row @var{r}. If the first element of @var{r} +## is not the same as the first element of @var{c}, the first element of +## @var{c} is used. If the second argument is omitted, the first row is +## taken to be the same as the first column. +## +## A square Toeplitz matrix has the form: +## @tex +## $$ +## \left[\matrix{c_0 & r_1 & r_2 & \cdots & r_n\cr +## c_1 & c_0 & r_1 & \cdots & r_{n-1}\cr +## c_2 & c_1 & c_0 & \cdots & r_{n-2}\cr +## \vdots & \vdots & \vdots & \ddots & \vdots\cr +## c_n & c_{n-1} & c_{n-2} & \ldots & c_0}\right] +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## c(0) r(1) r(2) @dots{} r(n) +## c(1) c(0) r(1) @dots{} r(n-1) +## c(2) c(1) c(0) @dots{} r(n-2) +## . . . . . +## . . . . . +## . . . . . +## c(n) c(n-1) c(n-2) @dots{} c(0) +## @end group +## @end example +## +## @end ifnottex +## @seealso{hankel} +## @end deftypefn + +## Author: jwe && jh + +function retval = toeplitz (c, r) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1) + if (! isvector (c)) + error ("toeplitz: C must be a vector"); + endif + + r = c; + nr = length (c); + nc = nr; + else + if (! (isvector (c) && isvector (r))) + error ("toeplitz: C and R must be vectors"); + elseif (r(1) != c(1)) + warning ("toeplitz: column wins anti-diagonal conflict"); + endif + + nr = length (c); + nc = length (r); + endif + + if (nr == 0 || nc == 0) + ## Empty matrix. + retval = zeros (nr, nc, class (c)); + return; + endif + + ## If we have a single complex argument, we want to return a + ## Hermitian-symmetric matrix (actually, this will really only be + ## Hermitian-symmetric if the first element of the vector is real). + if (nargin == 1 && iscomplex (c)) + c = conj (c); + c(1) = conj (c(1)); + endif + + if (issparse (c) && issparse (r)) + c = c(:).'; ## enforce row vector + r = r(:).'; ## enforce row vector + cidx = find (c); + ridx = find (r); + + ## Ignore the first element in r. + ridx = ridx(ridx > 1); + + ## Form matrix. + retval = spdiags(repmat (c(cidx),nr,1),1-cidx,nr,nc) + ... + spdiags(repmat (r(ridx),nr,1),ridx-1,nr,nc); + else + ## Concatenate data into a single column vector. + data = [r(end:-1:2)(:); c(:)]; + + ## Get slices. + slices = cellslices (data, nc:-1:1, nc+nr-1:-1:nr); + + ## Form matrix. + retval = horzcat (slices{:}); + endif + +endfunction + + +%!assert (toeplitz (1), [1]) +%!assert (toeplitz ([1, 2, 3], [1; -3; -5]), [1, -3, -5; 2, 1, -3; 3, 2, 1]) +%!assert (toeplitz ([1, 2, 3], [1; -3i; -5i]), [1, -3i, -5i; 2, 1, -3i; 3, 2, 1]) + +%% Test input validation +%!error toeplitz () +%!error toeplitz (1, 2, 3) +%!error toeplitz ([1, 2; 3, 4]) +%!error toeplitz ([1, 2; 3, 4], 1) +%!error toeplitz (1, [1, 2; 3, 4]) + diff --git a/octave_packages/m/special-matrix/vander.m b/octave_packages/m/special-matrix/vander.m new file mode 100644 index 0000000..5433f63 --- /dev/null +++ b/octave_packages/m/special-matrix/vander.m @@ -0,0 +1,95 @@ +## Copyright (C) 1993-2012 John W. Eaton +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} vander (@var{c}) +## @deftypefnx {Function File} {} vander (@var{c}, @var{n}) +## Return the Vandermonde matrix whose next to last column is @var{c}. +## If @var{n} is specified, it determines the number of columns; +## otherwise, @var{n} is taken to be equal to the length of @var{c}. +## +## A Vandermonde matrix has the form: +## @tex +## $$ +## \left[\matrix{c_1^{n-1} & \cdots & c_1^2 & c_1 & 1 \cr +## c_2^{n-1} & \cdots & c_2^2 & c_2 & 1 \cr +## \vdots & \ddots & \vdots & \vdots & \vdots \cr +## c_n^{n-1} & \cdots & c_n^2 & c_n & 1 }\right] +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## c(1)^(n-1) @dots{} c(1)^2 c(1) 1 +## c(2)^(n-1) @dots{} c(2)^2 c(2) 1 +## . . . . . +## . . . . . +## . . . . . +## c(n)^(n-1) @dots{} c(n)^2 c(n) 1 +## @end group +## @end example +## +## @end ifnottex +## @seealso{polyfit} +## @end deftypefn + +## Author: jwe + +function retval = vander (c, n) + + if (nargin == 1) + n = length (c); + elseif (nargin != 2) + print_usage (); + endif + + if (! isvector (c)) + error ("vander: polynomial C must be a vector"); + endif + + ## avoiding many ^s appears to be faster for n >= 100. + retval = zeros (length (c), n, class (c)); + d = 1; + c = c(:); + for i = n:-1:1 + retval(:,i) = d; + d .*= c; + endfor + +endfunction + + +%!test +%! c = [0,1,2,3]; +%! expect = [0,0,0,1; 1,1,1,1; 8,4,2,1; 27,9,3,1]; +%! assert(vander (c), expect); + +%!assert (vander (1), 1) +%!assert (vander ([1, 2, 3]), vander ([1; 2; 3])) +%!assert (vander ([1, 2, 3]), [1, 1, 1; 4, 2, 1; 9, 3, 1]) +%!assert (vander ([1, 2, 3]*i), [-1, i, 1; -4, 2i, 1; -9, 3i, 1]) + +%!assert(vander (2, 3), [4, 2, 1]) +%!assert(vander ([2, 3], 3), [4, 2, 1; 9, 3, 1]) + +%!error vander (); +%!error vander (1, 2, 3); +%!error vander ([1, 2; 3, 4]); + diff --git a/octave_packages/m/special-matrix/wilkinson.m b/octave_packages/m/special-matrix/wilkinson.m new file mode 100644 index 0000000..9b28bd1 --- /dev/null +++ b/octave_packages/m/special-matrix/wilkinson.m @@ -0,0 +1,61 @@ +## Copyright (C) 1999-2012 Peter Ekberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} wilkinson (@var{n}) +## Return the Wilkinson matrix of order @var{n}. Wilkinson matrices are +## symmetric and tridiagonal with pairs of nearly, but not exactly, equal +## eigenvalues. They are useful in testing the behavior and performance +## of eigenvalue solvers. +## +## @seealso{rosser, eig} +## @end deftypefn + +## Author: Peter Ekberg +## (peda) + +function retval = wilkinson (n) + + if (nargin != 1) + print_usage (); + endif + + if (! (isscalar (n) && n >= 0 && (n == fix (n)))) + error ("wilkinson: N must be a non-negative integer"); + endif + + side = ones (n-1, 1); + center = abs (-(n-1)/2:(n-1)/2); + retval = diag (side, -1) + diag (center) + diag (side, 1); + +endfunction + + +%!assert (wilkinson (0), []) +%!assert (wilkinson (1), 0) +%!assert (wilkinson (2), [0.5,1;1,0.5]) +%!assert (wilkinson (3), [1,1,0;1,0,1;0,1,1]) +%!assert (wilkinson (4), [1.5,1,0,0;1,0.5,1,0;0,1,0.5,1;0,0,1,1.5]) + +%% Test input validation +%!error wilkinson () +%!error wilkinson (1,2) +%!error wilkinson (ones (2)) +%!error wilkinson (-1) +%!error wilkinson (1.5) + diff --git a/octave_packages/m/startup/__finish__.m b/octave_packages/m/startup/__finish__.m new file mode 100644 index 0000000..738975f --- /dev/null +++ b/octave_packages/m/startup/__finish__.m @@ -0,0 +1,40 @@ +## Copyright (C) 2008-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} __finish__ () +## Undocumented internal function. +## @end deftypefn + +## Check for the existence of the function/script, @file{finish}, in the +## path or current working directory and execute it. This function is +## intended to be excecuted upon a clean exit form Octave. This is +## accomplished in the system script @file{startup/octaverc} by use of +## the built-in function @code{onexit}. + +function __finish__ () + + if (exist ("finish", "file")) + ## No arg list here since finish might be a script. + finish; + endif + +endfunction + +## No test needed for internal helper function. +%!assert (1) diff --git a/octave_packages/m/startup/inputrc b/octave_packages/m/startup/inputrc new file mode 100644 index 0000000..2adb532 --- /dev/null +++ b/octave_packages/m/startup/inputrc @@ -0,0 +1,21 @@ +## This file configures the behavior of line-input editing for all +## Octave users when Octave is configured to use GNU Readline library +## for input-line editing. + +## history-search-backward: +## +## Search backward through the history for the string of characters +## between the start of the current line and the point. This is a +## non-incremental search. Bound to "\e[A", the ANSI escape +## sequence for the UP arrow. + +"\e[A": history-search-backward + +## history-search-forward: +## +## Search forward through the history for the string of characters +## between the start of the current line and the point. This is a +## non-incremental search. Bound to "\e[B", the ANSI escape +## sequence for the DOWN arrow. + +"\e[B": history-search-forward diff --git a/octave_packages/m/statistics/base/center.m b/octave_packages/m/statistics/base/center.m new file mode 100644 index 0000000..41f9346 --- /dev/null +++ b/octave_packages/m/statistics/base/center.m @@ -0,0 +1,83 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} center (@var{x}) +## @deftypefnx {Function File} {} center (@var{x}, @var{dim}) +## If @var{x} is a vector, subtract its mean. +## If @var{x} is a matrix, do the above for each column. +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{zscore} +## @end deftypefn + +## Author: KH +## Description: Center by subtracting means + +function retval = center (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("center: X must be a numeric vector or matrix"); + endif + + if (isinteger (x)) + x = double (x); + endif + + nd = ndims (x); + sz = size (x); + if (nargin != 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("center: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + + if (n == 0) + retval = x; + else + retval = bsxfun (@minus, x, mean (x, dim)); + endif + +endfunction + +%!assert(center ([1,2,3]), [-1,0,1]) +%!assert(center (single([1,2,3])), single([-1,0,1])) +%!assert(center (int8 ([1,2,3])), [-1,0,1]) +%!assert(center (logical ([1, 0, 0, 1])), [0.5, -0.5, -0.5, 0.5]) +%!assert(center (ones (3,2,0,2)), zeros (3,2,0,2)) +%!assert(center (ones (3,2,0,2, 'single')), zeros (3,2,0,2, 'single')) +%!assert(center (magic (3)), [3,-4,1;-2,0,2;-1,4,-3]) +%!assert(center ([1 2 3; 6 5 4], 2), [-1 0 1; 1 0 -1]) + +%% Test input validation +%!error center () +%!error center (1, 2, 3) +%!error center (1, ones(2,2)) +%!error center (1, 1.5) +%!error center (1, 0) +%!error center (1, 3) diff --git a/octave_packages/m/statistics/base/cloglog.m b/octave_packages/m/statistics/base/cloglog.m new file mode 100644 index 0000000..0204735 --- /dev/null +++ b/octave_packages/m/statistics/base/cloglog.m @@ -0,0 +1,55 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cloglog (@var{x}) +## Return the complementary log-log function of @var{x}, defined as +## @tex +## $$ +## {\rm cloglog}(x) = - \log (- \log (x)) +## $$ +## @end tex +## @ifnottex +## +## @example +## cloglog (x) = - log (- log (@var{x})) +## @end example +## +## @end ifnottex +## @end deftypefn + +## Author: KH +## Description: Complementary log-log function + +function y = cloglog (x) + + if (nargin != 1) + print_usage (); + endif + + y = - log (- log (x)); + +endfunction + +%!assert(cloglog(0), -Inf) +%!assert(cloglog(1), Inf) +%!assert(cloglog(1/e), 0) + +%% Test input validation +%!error cloglog () +%!error cloglog (1, 2) diff --git a/octave_packages/m/statistics/base/corr.m b/octave_packages/m/statistics/base/corr.m new file mode 100644 index 0000000..b4f13e7 --- /dev/null +++ b/octave_packages/m/statistics/base/corr.m @@ -0,0 +1,112 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} corr (@var{x}) +## @deftypefnx {Function File} {} corr (@var{x}, @var{y}) +## Compute matrix of correlation coefficients. +## +## If each row of @var{x} and @var{y} is an observation and each column is +## a variable, then the @w{(@var{i}, @var{j})-th} entry of +## @code{corr (@var{x}, @var{y})} is the correlation between the +## @var{i}-th variable in @var{x} and the @var{j}-th variable in @var{y}. +## @tex +## $$ +## {\rm corr}(x,y) = {{\rm cov}(x,y) \over {\rm std}(x) {\rm std}(y)} +## $$ +## @end tex +## @ifnottex +## +## @example +## corr (x,y) = cov (x,y) / (std (x) * std (y)) +## @end example +## +## @end ifnottex +## If called with one argument, compute @code{corr (@var{x}, @var{x})}, +## the correlation between the columns of @var{x}. +## @seealso{cov} +## @end deftypefn + +## Author: Kurt Hornik +## Created: March 1993 +## Adapted-By: jwe + +function retval = corr (x, y = []) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + ## Input validation is done by cov.m. Don't repeat tests here + + ## Special case, scalar is always 100% correlated with itself + if (isscalar (x)) + if (isa (x, 'single')) + retval = single (1); + else + retval = 1; + endif + return; + endif + + ## No check for division by zero error, which happens only when + ## there is a constant vector and should be rare. + if (nargin == 2) + c = cov (x, y); + s = std (x)' * std (y); + retval = c ./ s; + else + c = cov (x); + s = sqrt (diag (c)); + retval = c ./ (s * s'); + endif + +endfunction + + +%!test +%! x = rand (10); +%! cc1 = corr (x); +%! cc2 = corr (x, x); +%! assert (size (cc1) == [10, 10] && size (cc2) == [10, 10]); +%! assert (cc1, cc2, sqrt (eps)); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (corr (x,y), -1, 5*eps) +%! assert (corr (x,flipud (y)), 1, 5*eps) +%! assert (corr ([x, y]), [1 -1; -1 1], 5*eps) + +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (corr (x,y), single (-1), 5*eps) +%! assert (corr (x,flipud (y)), single (1), 5*eps) +%! assert (corr ([x, y]), single ([1 -1; -1 1]), 5*eps) + +%!assert (corr (5), 1); +%!assert (corr (single(5)), single(1)); + +%% Test input validation +%!error corr (); +%!error corr (1, 2, 3); +%!error corr ([1; 2], ["A", "B"]); +%!error corr (ones (2,2,2)); +%!error corr (ones (2,2), ones (2,2,2)); + diff --git a/octave_packages/m/statistics/base/cov.m b/octave_packages/m/statistics/base/cov.m new file mode 100644 index 0000000..db9e1b4 --- /dev/null +++ b/octave_packages/m/statistics/base/cov.m @@ -0,0 +1,165 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cov (@var{x}) +## @deftypefnx {Function File} {} cov (@var{x}, @var{opt}) +## @deftypefnx {Function File} {} cov (@var{x}, @var{y}) +## @deftypefnx {Function File} {} cov (@var{x}, @var{y}, @var{opt}) +## Compute the covariance matrix. +## +## If each row of @var{x} and @var{y} is an observation, and each column is +## a variable, then the @w{(@var{i}, @var{j})-th} entry of +## @code{cov (@var{x}, @var{y})} is the covariance between the @var{i}-th +## variable in @var{x} and the @var{j}-th variable in @var{y}. +## @tex +## $$ +## \sigma_{ij} = {1 \over N-1} \sum_{i=1}^N (x_i - \bar{x})(y_i - \bar{y}) +## $$ +## where $\bar{x}$ and $\bar{y}$ are the mean values of $x$ and $y$. +## @end tex +## @ifnottex +## +## @example +## cov (x) = 1/N-1 * SUM_i (x(i) - mean(x)) * (y(i) - mean(y)) +## @end example +## +## @end ifnottex +## +## If called with one argument, compute @code{cov (@var{x}, @var{x})}, the +## covariance between the columns of @var{x}. +## +## The argument @var{opt} determines the type of normalization to use. +## Valid values are +## +## @table @asis +## @item 0: +## normalize with @math{N-1}, provides the best unbiased estimator of the +## covariance [default] +## +## @item 1: +## normalize with @math{N}, this provides the second moment around the mean +## @end table +## @seealso{corr} +## @end deftypefn + +## Author: KH +## Description: Compute covariances + +function c = cov (x, y = [], opt = 0) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) + error ("cov: X and Y must be numeric matrices or vectors"); + endif + + if (ndims (x) != 2 || ndims (y) != 2) + error ("cov: X and Y must be 2-D matrices or vectors"); + endif + + if (nargin == 2 && isscalar (y)) + opt = y; + endif + + if (opt != 0 && opt != 1) + error ("cov: normalization OPT must be 0 or 1"); + endif + + ## Special case, scalar has zero covariance + if (isscalar (x)) + if (isa (x, 'single')) + c = single (0); + else + c = 0; + endif + return; + endif + + if (isrow (x)) + x = x.'; + endif + n = rows (x); + + if (nargin == 1 || isscalar (y)) + x = center (x, 1); + c = conj (x' * x / (n - 1 + opt)); + else + if (isrow (y)) + y = y.'; + endif + if (rows (y) != n) + error ("cov: X and Y must have the same number of observations"); + endif + x = center (x, 1); + y = center (y, 1); + c = conj (x' * y / (n - 1 + opt)); + endif + +endfunction + + +%!test +%! x = rand (10); +%! cx1 = cov (x); +%! cx2 = cov (x, x); +%! assert(size (cx1) == [10, 10] && size (cx2) == [10, 10]); +%! assert(cx1, cx2, 1e1*eps); + +%!test +%! x = [1:3]'; +%! y = [3:-1:1]'; +%! assert (cov (x,y), -1, 5*eps) +%! assert (cov (x,flipud (y)), 1, 5*eps) +%! assert (cov ([x, y]), [1 -1; -1 1], 5*eps) + +%!test +%! x = single ([1:3]'); +%! y = single ([3:-1:1]'); +%! assert (cov (x,y), single (-1), 5*eps) +%! assert (cov (x,flipud (y)), single (1), 5*eps) +%! assert (cov ([x, y]), single ([1 -1; -1 1]), 5*eps) + +%!test +%! x = [1:5]; +%! c = cov (x); +%! assert (isscalar (c)); +%! assert (c, 2.5); + +%!assert(cov (5), 0); +%!assert(cov (single(5)), single(0)); + +%!test +%! x = [1:5]; +%! c = cov (x, 0); +%! assert(c, 2.5); +%! c = cov (x, 1); +%! assert(c, 2); + +%% Test input validation +%!error cov (); +%!error cov (1, 2, 3, 4); +%!error cov ([1; 2], ["A", "B"]); +%!error cov (ones (2,2,2)); +%!error cov (ones (2,2), ones (2,2,2)); +%!error cov (1, 3); +%!error cov (ones (2,2), ones (3,2)); + diff --git a/octave_packages/m/statistics/base/gls.m b/octave_packages/m/statistics/base/gls.m new file mode 100644 index 0000000..5bfc4e4 --- /dev/null +++ b/octave_packages/m/statistics/base/gls.m @@ -0,0 +1,145 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{beta}, @var{v}, @var{r}] =} gls (@var{y}, @var{x}, @var{o}) +## Generalized least squares estimation for the multivariate model +## @tex +## $y = x b + e$ +## with $\bar{e} = 0$ and cov(vec($e$)) = $(s^2)o$, +## @end tex +## @ifnottex +## @w{@math{y = x*b + e}} with @math{mean (e) = 0} and +## @math{cov (vec (e)) = (s^2) o}, +## @end ifnottex +## where +## @tex +## $y$ is a $t \times p$ matrix, $x$ is a $t \times k$ matrix, $b$ is a $k +## \times p$ matrix, $e$ is a $t \times p$ matrix, and $o$ is a $tp \times +## tp$ matrix. +## @end tex +## @ifnottex +## @math{y} is a @math{t} by @math{p} matrix, @math{x} is a @math{t} by +## @math{k} matrix, @math{b} is a @math{k} by @math{p} matrix, @math{e} +## is a @math{t} by @math{p} matrix, and @math{o} is a @math{t*p} by +## @math{t*p} matrix. +## @end ifnottex +## +## @noindent +## Each row of @var{y} and @var{x} is an observation and each column a +## variable. The return values @var{beta}, @var{v}, and @var{r} are +## defined as follows. +## +## @table @var +## @item beta +## The GLS estimator for @math{b}. +## +## @item v +## The GLS estimator for @math{s^2}. +## +## @item r +## The matrix of GLS residuals, @math{r = y - x*beta}. +## @end table +## @seealso{ols} +## @end deftypefn + +## Author: Teresa Twaroch +## Created: May 1993 +## Adapted-By: jwe + +function [beta, v, r] = gls (y, x, o) + + if (nargin != 3) + print_usage (); + endif + + if (! (isnumeric (x) && isnumeric (y) && isnumeric (o))) + error ("gls: X, Y, and O must be numeric matrices or vectors"); + endif + + if (ndims (x) != 2 || ndims (y) != 2 || ndims (o) != 2) + error ("gls: X, Y and O must be 2-D matrices or vectors"); + endif + + [rx, cx] = size (x); + [ry, cy] = size (y); + [ro, co] = size (o); + if (rx != ry) + error ("gls: number of rows of X and Y must be equal"); + endif + if (!issquare (o) || ro != ry*cy) + error ("gls: matrix O must be square matrix with rows = rows (Y) * cols (Y)"); + endif + + if (isinteger (x)) + x = double (x); + endif + if (isinteger (y)) + y = double (y); + endif + if (isinteger (o)) + o = double (o); + endif + + ## Start of algorithm + o = o^(-1/2); + z = kron (eye (cy), x); + z = o * z; + y1 = o * reshape (y, ry*cy, 1); + u = z' * z; + r = rank (u); + + if (r == cx*cy) + b = inv (u) * z' * y1; + else + b = pinv (z) * y1; + endif + + beta = reshape (b, cx, cy); + + if (isargout (2) || isargout (3)) + r = y - x * beta; + if (isargout (2)) + v = (reshape (r, ry*cy, 1))' * (o^2) * reshape (r, ry*cy, 1) / (rx*cy - r); + endif + endif + +endfunction + + +%!test +%! x = [1:5]'; +%! y = 3*x + 2; +%! x = [x, ones(5,1)]; +%! o = diag (ones (5,1)); +%! assert (gls (y,x,o), [3; 2], 50*eps); + +%% Test input validation +%!error gls () +%!error gls (1) +%!error gls (1, 2) +%!error gls (1, 2, 3, 4) +%!error gls ([true, true], [1, 2], ones (2)) +%!error gls ([1, 2], [true, true], ones (2)) +%!error gls ([1, 2], [1, 2], true (2)) +%!error gls (ones (2,2,2), ones (2,2), ones (4,4)) +%!error gls (ones (2,2), ones (2,2,2), ones (4,4)) +%!error gls (ones (2,2), ones (2,2), ones (4,4,4)) +%!error gls (ones(1,2), ones(2,2), ones (2,2)) +%!error gls (ones(2,2), ones(2,2), ones (2,2)) + diff --git a/octave_packages/m/statistics/base/histc.m b/octave_packages/m/statistics/base/histc.m new file mode 100644 index 0000000..c6ea353 --- /dev/null +++ b/octave_packages/m/statistics/base/histc.m @@ -0,0 +1,176 @@ +## Copyright (C) 2009-2012 Søren Hauberg +## Copyright (C) 2009 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{n} =} histc (@var{x}, @var{edges}) +## @deftypefnx {Function File} {@var{n} =} histc (@var{x}, @var{edges}, @var{dim}) +## @deftypefnx {Function File} {[@var{n}, @var{idx}] =} histc (@dots{}) +## Produce histogram counts. +## +## When @var{x} is a vector, the function counts the number of elements of +## @var{x} that fall in the histogram bins defined by @var{edges}. This must be +## a vector of monotonically increasing values that define the edges of the +## histogram bins. @code{@var{n}(k)} contains the number of elements in +## @var{x} for which @code{@var{edges}(k) <= @var{x} < @var{edges}(k+1)}. +## The final element of @var{n} contains the number of elements of @var{x} +## exactly equal to the last element of @var{edges}. +## +## When @var{x} is an @math{N}-dimensional array, the computation is +## carried out along dimension @var{dim}. If not specified @var{dim} defaults +## to the first non-singleton dimension. +## +## When a second output argument is requested an index matrix is also returned. +## The @var{idx} matrix has the same size as @var{x}. Each element of @var{idx} +## contains the index of the histogram bin in which the corresponding element +## of @var{x} was counted. +## @seealso{hist} +## @end deftypefn + +function [n, idx] = histc (x, edges, dim) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (!isreal (x)) + error ("histc: X argument must be real-valued, not complex"); + endif + + num_edges = numel (edges); + if (num_edges == 0) + error ("histc: EDGES must not be empty"); + endif + + if (!isreal (edges)) + error ("histc: EDGES must be real-valued, not complex"); + else + ## Make sure 'edges' is sorted + edges = edges(:); + if (!issorted (edges) || edges(1) > edges(end)) + warning ("histc: edge values not sorted on input"); + edges = sort (edges); + endif + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 3) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("histc: DIM must be an integer and a valid dimension"); + endif + endif + + nsz = sz; + nsz(dim) = num_edges; + + ## the splitting point is 3 bins + + if (num_edges <= 3) + + ## This is the O(M*N) algorithm. + + ## Allocate the histogram + n = zeros (nsz); + + ## Allocate 'idx' + if (nargout > 1) + idx = zeros (sz); + endif + + ## Prepare indices + idx1 = cell (1, dim-1); + for k = 1:length (idx1) + idx1{k} = 1:sz(k); + endfor + idx2 = cell (length (sz) - dim); + for k = 1:length (idx2) + idx2{k} = 1:sz(k+dim); + endfor + + ## Compute the histograms + for k = 1:num_edges-1 + b = (edges (k) <= x & x < edges (k+1)); + n(idx1{:}, k, idx2{:}) = sum (b, dim); + if (nargout > 1) + idx(b) = k; + endif + endfor + b = (x == edges (end)); + n(idx1{:}, num_edges, idx2{:}) = sum (b, dim); + if (nargout > 1) + idx(b) = num_edges; + endif + + else + + ## This is the O(M*log(N) + N) algorithm. + + ## Look-up indices. + idx = lookup (edges, x); + ## Zero invalid ones (including NaNs). x < edges(1) are already zero. + idx(! (x <= edges(end))) = 0; + + iidx = idx; + + ## In case of matrix input, we adjust the indices. + if (! isvector (x)) + nl = prod (sz(1:dim-1)); + nn = sz(dim); + nu = prod (sz(dim+1:end)); + if (nl != 1) + iidx = (iidx-1) * nl; + iidx += reshape (kron (ones (1, nn*nu), 1:nl), sz); + endif + if (nu != 1) + ne =length (edges); + iidx += reshape (kron (nl*ne*(0:nu-1), ones (1, nl*nn)), sz); + endif + endif + + ## Select valid elements. + iidx = iidx(idx != 0); + + ## Call accumarray to sum the indexed elements. + n = accumarray (iidx(:), 1, nsz); + + endif + +endfunction + + +%!test +%! x = linspace (0, 10, 1001); +%! n = histc (x, 0:10); +%! assert (n, [repmat(100, 1, 10), 1]); + +%!test +%! x = repmat (linspace (0, 10, 1001), [2, 1, 3]); +%! n = histc (x, 0:10, 2); +%! assert (n, repmat ([repmat(100, 1, 10), 1], [2, 1, 3])); + +%!error histc (); +%!error histc (1); +%!error histc (1, 2, 3, 4); +%!error histc ([1:10 1+i], 2); +%!error histc (1:10, []); +%!error histc (1, 1, 3); diff --git a/octave_packages/m/statistics/base/iqr.m b/octave_packages/m/statistics/base/iqr.m new file mode 100644 index 0000000..45fda22 --- /dev/null +++ b/octave_packages/m/statistics/base/iqr.m @@ -0,0 +1,98 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} iqr (@var{x}) +## @deftypefnx {Function File} {} iqr (@var{x}, @var{dim}) +## Return the interquartile range, i.e., the difference between the upper +## and lower quartile of the input data. If @var{x} is a matrix, do the +## above for first non-singleton dimension of @var{x}. +## +## If the optional argument @var{dim} is given, operate along this dimension. +## +## As a measure of dispersion, the interquartile range is less affected by +## outliers than either @code{range} or @code{std}. +## @seealso{range, std} +## @end deftypefn + +## Author KH +## Description: Interquartile range + +function y = iqr (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("iqr: X must be a numeric vector or matrix"); + endif + + nd = ndims (x); + sz = size (x); + nel = numel (x); + if (nargin != 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("iqr: DIM must be an integer and a valid dimension"); + endif + endif + + ## This code is a bit heavy, but is needed until empirical_inv + ## can take a matrix, rather than just a vector argument. + n = sz(dim); + sz(dim) = 1; + if (isa (x, 'single')) + y = zeros (sz, 'single'); + else + y = zeros (sz); + endif + stride = prod (sz(1:dim-1)); + for i = 1 : nel / n; + offset = i; + offset2 = 0; + while (offset > stride) + offset -= stride; + offset2++; + endwhile + offset += offset2 * stride * n; + rng = [0 : n-1] * stride + offset; + + y(i) = diff (empirical_inv ([1/4, 3/4], x(rng))); + endfor + +endfunction + + +%!assert (iqr (1:101), 50); +%!assert (iqr (single(1:101)), single(50)); + +%%!test +%%! x = [1:100]; +%%! n = iqr (x, 0:10); +%%! assert (n, [repmat(100, 1, 10), 1]); + +%!error iqr (); +%!error iqr (1, 2, 3); +%!error iqr (1); +%!error iqr (['A'; 'B']); +%!error iqr (1:10, 3); + diff --git a/octave_packages/m/statistics/base/kendall.m b/octave_packages/m/statistics/base/kendall.m new file mode 100644 index 0000000..6907fc0 --- /dev/null +++ b/octave_packages/m/statistics/base/kendall.m @@ -0,0 +1,134 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} kendall (@var{x}) +## @deftypefnx {Function File} {} kendall (@var{x}, @var{y}) +## @cindex Kendall's Tau +## Compute Kendall's @var{tau}. +## +## For two data vectors @var{x}, @var{y} of common length @var{n}, +## Kendall's @var{tau} is the correlation of the signs of all rank +## differences of @var{x} and @var{y}; i.e., if both @var{x} and +## @var{y} have distinct entries, then +## +## @tex +## $$ \tau = {1 \over n(n-1)} \sum_{i,j} {\rm sign}(q_i-q_j) {\rm sign}(r_i-r_j) $$ +## @end tex +## @ifnottex +## +## @example +## @group +## 1 +## tau = ------- SUM sign (q(i) - q(j)) * sign (r(i) - r(j)) +## n (n-1) i,j +## @end group +## @end example +## +## @end ifnottex +## @noindent +## in which the +## @tex +## $q_i$ and $r_i$ +## @end tex +## @ifnottex +## @var{q}(@var{i}) and @var{r}(@var{i}) +## @end ifnottex +## are the ranks of @var{x} and @var{y}, respectively. +## +## If @var{x} and @var{y} are drawn from independent distributions, +## Kendall's @var{tau} is asymptotically normal with mean 0 and variance +## @tex +## ${2 (2n+5) \over 9n(n-1)}$. +## @end tex +## @ifnottex +## @code{(2 * (2@var{n}+5)) / (9 * @var{n} * (@var{n}-1))}. +## @end ifnottex +## +## @code{kendall (@var{x})} is equivalent to @code{kendall (@var{x}, +## @var{x})}. +## @seealso{ranks, spearman} +## @end deftypefn + +## Author: KH +## Description: Kendall's rank correlation tau + +function tau = kendall (x, y = []) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) + error ("kendall: X and Y must be numeric matrices or vectors"); + endif + + if (ndims (x) != 2 || ndims (y) != 2) + error ("kendall: X and Y must be 2-D matrices or vectors"); + endif + + if (isrow (x)) + x = x.'; + endif + [n, c] = size (x); + + if (nargin == 2) + if (isrow (y)) + y = y.'; + endif + if (rows (y) != n) + error ("kendall: X and Y must have the same number of observations"); + else + x = [x, y]; + endif + endif + + if (isa (x, 'single') || isa (y, 'single')) + cls = 'single'; + else + cls = 'double'; + endif + r = ranks (x); + m = sign (kron (r, ones (n, 1, cls)) - kron (ones (n, 1, cls), r)); + tau = corr (m); + + if (nargin == 2) + tau = tau(1 : c, (c + 1) : columns (x)); + endif + +endfunction + + +%!test +%! x = [1:2:10]; +%! y = [100:10:149]; +%! assert (kendall (x,y), 1, 5*eps); +%! assert (kendall (x,fliplr (y)), -1, 5*eps); + +%!assert (kendall (logical(1)), 1); +%!assert (kendall (single(1)), single(1)); + +%% Test input validation +%!error kendall (); +%!error kendall (1, 2, 3); +%!error kendall (['A'; 'B']); +%!error kendall (ones(2,1), ['A'; 'B']); +%!error kendall (ones (2,2,2)); +%!error kendall (ones (2,2), ones (2,2,2)); +%!error kendall (ones (2,2), ones (3,2)); diff --git a/octave_packages/m/statistics/base/kurtosis.m b/octave_packages/m/statistics/base/kurtosis.m new file mode 100644 index 0000000..66663f5 --- /dev/null +++ b/octave_packages/m/statistics/base/kurtosis.m @@ -0,0 +1,100 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} kurtosis (@var{x}) +## @deftypefnx {Function File} {} kurtosis (@var{x}, @var{dim}) +## Compute the kurtosis of the elements of the vector @var{x}. +## @tex +## $$ +## {\rm kurtosis} (x) = {1\over N \sigma^4} \sum_{i=1}^N (x_i-\bar{x})^4 - 3 +## $$ +## where $\bar{x}$ is the mean value of $x$. +## @end tex +## @ifnottex +## +## @example +## kurtosis (x) = 1/N std(x)^(-4) sum ((x - mean(x)).^4) - 3 +## @end example +## +## @end ifnottex +## If @var{x} is a matrix, return the kurtosis over the +## first non-singleton dimension of the matrix. If the optional +## @var{dim} argument is given, operate along this dimension. +## +## Note: The definition of kurtosis above yields a kurtosis of zero for the +## stdnormal distribution and is sometimes referred to as "excess kurtosis". +## To calculate kurtosis without the normalization factor of @math{-3} use +## @code{moment (@var{x}, 4, 'c') / std (@var{x})^4}. +## @seealso{var, skewness, moment} +## @end deftypefn + +## Author: KH +## Created: 29 July 1994 +## Adapted-By: jwe + +function retval = kurtosis (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("kurtosis: X must be a numeric vector or matrix"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin != 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("kurtosis: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + sz(dim) = 1; + x = center (x, dim); # center also promotes integer to double for next line + retval = zeros (sz, class (x)); + s = std (x, [], dim); + idx = find (s > 0); + x = sum (x.^4, dim); + retval(idx) = x(idx) ./ (n * s(idx) .^ 4) - 3; + +endfunction + + +%!test +%! x = [-1; 0; 0; 0; 1]; +%! y = [x, 2*x]; +%! assert (kurtosis (y), [-1.4, -1.4], sqrt (eps)); + +%!assert (kurtosis (single(1)), single(0)); + +%% Test input validation +%!error kurtosis () +%!error kurtosis (1, 2, 3) +%!error kurtosis (['A'; 'B']) +%!error kurtosis (1, ones(2,2)) +%!error kurtosis (1, 1.5) +%!error kurtosis (1, 0) +%!error kurtosis (1, 3) + diff --git a/octave_packages/m/statistics/base/logit.m b/octave_packages/m/statistics/base/logit.m new file mode 100644 index 0000000..bb8161d --- /dev/null +++ b/octave_packages/m/statistics/base/logit.m @@ -0,0 +1,59 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} logit (@var{p}) +## For each component of @var{p}, return the logit of @var{p} defined as +## @tex +## $$ +## {\rm logit}(p) = \log\Big({p \over 1-p}\Big) +## $$ +## @end tex +## @ifnottex +## +## @example +## logit (@var{p}) = log (@var{p} / (1-@var{p})) +## @end example +## +## @end ifnottex +## @seealso{logistic_cdf} +## @end deftypefn + +## Author: KH +## Description: Logit transformation + +function y = logit (p) + + if (nargin != 1) + print_usage (); + endif + + y = logistic_inv (p); + +endfunction + + +%!test +%! p = [0.01:0.01:0.99]; +%! assert(logit (p), log (p ./ (1-p)), 25*eps) + +%!assert(logit ([-1, 0, 0.5, 1, 2]), [NaN, -Inf, 0, +Inf, NaN]) + +%% Test input validation +%!error logit () +%!error logit (1, 2) diff --git a/octave_packages/m/statistics/base/mahalanobis.m b/octave_packages/m/statistics/base/mahalanobis.m new file mode 100644 index 0000000..e0e78bd --- /dev/null +++ b/octave_packages/m/statistics/base/mahalanobis.m @@ -0,0 +1,80 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mahalanobis (@var{x}, @var{y}) +## Return the Mahalanobis' D-square distance between the multivariate +## samples @var{x} and @var{y}, which must have the same number of +## components (columns), but may have a different number of observations +## (rows). +## @end deftypefn + +## Author: Friedrich Leisch +## Created: July 1993 +## Adapted-By: jwe + +function retval = mahalanobis (x, y) + + if (nargin != 2) + print_usage (); + endif + + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) + error ("mahalanobis: X and Y must be numeric matrices or vectors"); + endif + + if (ndims (x) != 2 || ndims (y) != 2) + error ("mahalanobis: X and Y must be 2-D matrices or vectors"); + endif + + [xr, xc] = size (x); + [yr, yc] = size (y); + + if (xc != yc) + error ("mahalanobis: X and Y must have the same number of columns"); + endif + + if (isinteger (x)) + x = double (x); + endif + + xm = mean (x); + ym = mean (y); + + ## Center data by subtracting means + x = bsxfun (@minus, x, xm); + y = bsxfun (@minus, y, ym); + + w = (x' * x + y' * y) / (xr + yr - 2); + + winv = inv (w); + + retval = (xm - ym) * winv * (xm - ym)'; + +endfunction + + +%% Test input validation +%!error mahalanobis (); +%!error mahalanobis (1, 2, 3); +%!error mahalanobis ('A', 'B'); +%!error mahalanobis ([1, 2], ['A', 'B']); +%!error mahalanobis (ones (2,2,2)); +%!error mahalanobis (ones (2,2), ones (2,2,2)); +%!error mahalanobis (ones (2,2), ones (2,3)); diff --git a/octave_packages/m/statistics/base/mean.m b/octave_packages/m/statistics/base/mean.m new file mode 100644 index 0000000..d8eced0 --- /dev/null +++ b/octave_packages/m/statistics/base/mean.m @@ -0,0 +1,151 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mean (@var{x}) +## @deftypefnx {Function File} {} mean (@var{x}, @var{dim}) +## @deftypefnx {Function File} {} mean (@var{x}, @var{opt}) +## @deftypefnx {Function File} {} mean (@var{x}, @var{dim}, @var{opt}) +## Compute the mean of the elements of the vector @var{x}. +## @tex +## $$ {\rm mean}(x) = \bar{x} = {1\over N} \sum_{i=1}^N x_i $$ +## @end tex +## @ifnottex +## +## @example +## mean (x) = SUM_i x(i) / N +## @end example +## +## @end ifnottex +## If @var{x} is a matrix, compute the mean for each column and return them +## in a row vector. +## +## The optional argument @var{opt} selects the type of mean to compute. +## The following options are recognized: +## +## @table @asis +## @item "a" +## Compute the (ordinary) arithmetic mean. [default] +## +## @item "g" +## Compute the geometric mean. +## +## @item "h" +## Compute the harmonic mean. +## @end table +## +## If the optional argument @var{dim} is given, operate along this dimension. +## +## Both @var{dim} and @var{opt} are optional. If both are supplied, +## either may appear first. +## @seealso{median, mode} +## @end deftypefn + +## Author: KH +## Description: Compute arithmetic, geometric, and harmonic mean + +function y = mean (x, opt1, opt2) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("mean: X must be a numeric vector or matrix"); + endif + + need_dim = false; + + if (nargin == 1) + opt = "a"; + need_dim = true; + elseif (nargin == 2) + if (ischar (opt1)) + opt = opt1; + need_dim = true; + else + dim = opt1; + opt = "a"; + endif + elseif (nargin == 3) + if (ischar (opt1)) + opt = opt1; + dim = opt2; + elseif (ischar (opt2)) + opt = opt2; + dim = opt1; + else + error ("mean: OPT must be a string"); + endif + else + print_usage (); + endif + + nd = ndims (x); + sz = size (x); + if (need_dim) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("mean: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + + if (strcmp (opt, "a")) + y = sum (x, dim) / n; + elseif (strcmp (opt, "g")) + y = prod (x, dim) .^ (1/n); + elseif (strcmp (opt, "h")) + y = n ./ sum (1 ./ x, dim); + else + error ("mean: option `%s' not recognized", opt); + endif + +endfunction + + +%!test +%! x = -10:10; +%! y = x'; +%! z = [y, y+10]; +%! assert(mean (x) == 0); +%! assert(mean (y) == 0); +%! assert(mean (z) == [0, 10]); + +%!assert(mean (magic(3), 1), [5, 5, 5]); +%!assert(mean (magic(3), 2), [5; 5; 5]); +%!assert(mean ([2 8], 'g'), 4); +%!assert(mean ([4 4 2], 'h'), 3); +%!assert(mean (logical ([1 0 1 1])), 0.75); +%!assert(mean (single ([1 0 1 1])), single (0.75)); + +%% Test input validation +%!error mean (); +%!error mean (1, 2, 3, 4); +%!error mean ({1:5}); +%!error mean (1, 2, 3); +%!error mean (1, ones(2,2)); +%!error mean (1, 1.5); +%!error mean (1, 0); +%!error mean (1, 3); +%!error mean (1, 'b'); + diff --git a/octave_packages/m/statistics/base/meansq.m b/octave_packages/m/statistics/base/meansq.m new file mode 100644 index 0000000..0887589 --- /dev/null +++ b/octave_packages/m/statistics/base/meansq.m @@ -0,0 +1,89 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} meansq (@var{x}) +## @deftypefnx {Function File} {} meansq (@var{x}, @var{dim}) +## Compute the mean square of the elements of the vector @var{x}. +## @tex +## $$ +## {\rm meansq} (x) = {\sum_{i=1}^N {x_i}^2 \over N} +## $$ +## where $\bar{x}$ is the mean value of $x$. +## @end tex +## @ifnottex +## +## @example +## @group +## std (x) = 1/N SUM_i x(i)^2 +## @end group +## @end example +## +## @end ifnottex +## For matrix arguments, return a row vector containing the mean square +## of each column. +## +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{var, std, moment} +## @end deftypefn + +## Author: KH +## Description: Compute mean square + +function y = meansq (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("mean: X must be a numeric vector or matrix"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("mean: DIM must be an integer and a valid dimension"); + endif + endif + + y = sumsq (x, dim) / sz(dim); + +endfunction + + +%!assert(meansq (1:5), 11); +%!assert(meansq (single(1:5)), single(11)); +%!assert(meansq (magic (4)), [94.5, 92.5, 92.5, 94.5]); +%!assert(meansq (magic (4), 2), [109.5; 77.5; 77.5; 109.5]); + +%% Test input validation +%!error meansq () +%!error meansq (1, 2, 3) +%!error meansq (['A'; 'B']); +%!error meansq (1, ones(2,2)) +%!error meansq (1, 1.5) +%!error meansq (1, 0) +%!error meansq (1, 3) + diff --git a/octave_packages/m/statistics/base/median.m b/octave_packages/m/statistics/base/median.m new file mode 100644 index 0000000..ab6aa65 --- /dev/null +++ b/octave_packages/m/statistics/base/median.m @@ -0,0 +1,123 @@ +## Copyright (C) 1996-2012 John W. Eaton +## Copyright (C) 2009-2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} median (@var{x}) +## @deftypefnx {Function File} {} median (@var{x}, @var{dim}) +## Compute the median value of the elements of the vector @var{x}. +## If the elements of @var{x} are sorted, the median is defined +## as +## @tex +## $$ +## {\rm median} (x) = +## \cases{x(\lceil N/2\rceil), & $N$ odd;\cr +## (x(N/2)+x(N/2+1))/2, & $N$ even.} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## x(ceil(N/2)) N odd +## median (x) = +## (x(N/2) + x((N/2)+1))/2 N even +## @end group +## @end example +## +## @end ifnottex +## If @var{x} is a matrix, compute the median value for each +## column and return them in a row vector. If the optional @var{dim} +## argument is given, operate along this dimension. +## @seealso{mean, mode} +## @end deftypefn + +## Author: jwe + +function retval = median (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("median: X must be a numeric vector or matrix"); + endif + + if (isempty (x)) + error ("median: X cannot be an empty matrix"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("median: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + k = floor ((n+1) / 2); + if (mod (n, 2) == 1) + retval = nth_element (x, k, dim); + else + retval = mean (nth_element (x, k:k+1, dim), dim); + endif + ## Inject NaNs where needed, to be consistent with Matlab. + retval(any (isnan (x), dim)) = NaN; + +endfunction + + +%!test +%! x = [1, 2, 3, 4, 5, 6]; +%! x2 = x'; +%! y = [1, 2, 3, 4, 5, 6, 7]; +%! y2 = y'; +%! +%! assert(median (x) == median (x2) && median (x) == 3.5); +%! assert(median (y) == median (y2) && median (y) == 4); +%! assert(median ([x2, 2*x2]) == [3.5, 7]); +%! assert(median ([y2, 3*y2]) == [4, 12]); + +%% Test multidimensional arrays (bug #35679) +%!shared a, b, x, y +%! rand ("seed", 2); +%! a = rand (2,3,4,5); +%! b = rand (3,4,6,5); +%! x = sort (a, 4); +%! y = sort (b, 3); +%!assert (median (a, 4), x(:, :, :, 3)); +%!assert (median (b, 3), (y(:, :, 3, :) + y(:, :, 4, :))/2); + +%!assert(median (single([1,2,3])), single(2)); +%!assert(median ([1,2,NaN;4,5,6;NaN,8,9]), [NaN, 5, NaN]); + +%% Test input validation +%!error median (); +%!error median (1, 2, 3); +%!error median ({1:5}); +%!error median (['A'; 'B']); +%!error median (1, ones(2,2)); +%!error median (1, 1.5); +%!error median (1, 0); + diff --git a/octave_packages/m/statistics/base/mode.m b/octave_packages/m/statistics/base/mode.m new file mode 100644 index 0000000..105a3b4 --- /dev/null +++ b/octave_packages/m/statistics/base/mode.m @@ -0,0 +1,167 @@ +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} mode (@var{x}) +## @deftypefnx {Function File} {} mode (@var{x}, @var{dim}) +## @deftypefnx {Function File} {[@var{m}, @var{f}, @var{c}] =} mode (@dots{}) +## Compute the most frequently occurring value in a dataset (mode). +## @code{mode} determines the frequency of values along the first non-singleton +## dimension and returns the value with the highest frequency. If two, or +## more, values have the same frequency @code{mode} returns the smallest. +## +## If the optional argument @var{dim} is given, operate along this dimension. +## +## The return variable @var{f} is the number of occurrences of the mode in +## in the dataset. The cell array @var{c} contains all of the elements +## with the maximum frequency. +## @seealso{mean, median} +## @end deftypefn + +function [m, f, c] = mode (x, dim) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("mode: X must be a numeric vector or matrix"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("mode: DIM must be an integer and a valid dimension"); + endif + endif + + sz2 = sz; + sz2(dim) = 1; + sz3 = ones (1, nd); + sz3(dim) = sz(dim); + + if (issparse (x)) + t2 = sparse (sz(1), sz(2)); + else + t2 = zeros (sz); + endif + + if (dim != 1) + perm = [dim, 1:dim-1, dim+1:nd]; + t2 = permute (t2, perm); + endif + + xs = sort (x, dim); + t = cat (dim, true (sz2), diff (xs, 1, dim) != 0); + + if (dim != 1) + t2(permute (t != 0, perm)) = diff ([find(permute (t, perm))(:); prod(sz)+1]); + f = max (ipermute (t2, perm), [], dim); + xs = permute (xs, perm); + else + t2(t) = diff ([find(t)(:); prod(sz)+1]); + f = max (t2, [], dim); + endif + + c = cell (sz2); + if (issparse (x)) + m = sparse (sz2(1), sz2(2)); + else + m = zeros (sz2, class (x)); + endif + for i = 1 : prod (sz2) + c{i} = xs(t2(:, i) == f(i), i); + m(i) = c{i}(1); + endfor +endfunction + + +%!test +%! [m, f, c] = mode (toeplitz (1:5)); +%! assert (m, [1,2,2,2,1]); +%! assert (f, [1,2,2,2,1]); +%! assert (c, {[1;2;3;4;5],[2],[2;3],[2],[1;2;3;4;5]}); +%!test +%! [m, f, c] = mode (toeplitz (1:5), 2); +%! assert (m, [1;2;2;2;1]); +%! assert (f, [1;2;2;2;1]); +%! assert (c, {[1;2;3;4;5];[2];[2;3];[2];[1;2;3;4;5]}); +%!test +%! a = sprandn (32, 32, 0.05); +%! [m, f, c] = mode (a); +%! [m2, f2, c2] = mode (full (a)); +%! assert (m, sparse (m2)); +%! assert (f, sparse (f2)); +%! c_exp(1:length(a)) = { sparse (0) }; +%! assert (c ,c_exp); +%! assert (c2,c_exp ); + +%!assert(mode ([2,3,1,2,3,4],1),[2,3,1,2,3,4]); +%!assert(mode ([2,3,1,2,3,4],2),2); +%!assert(mode ([2,3,1,2,3,4]),2); +%!assert(mode (single([2,3,1,2,3,4])), single(2)); +%!assert(mode (int8([2,3,1,2,3,4])), int8(2)); + +%!assert(mode ([2;3;1;2;3;4],1),2); +%!assert(mode ([2;3;1;2;3;4],2),[2;3;1;2;3;4]); +%!assert(mode ([2;3;1;2;3;4]),2); + +%!shared x +%! x(:,:,1) = toeplitz (1:3); +%! x(:,:,2) = circshift (toeplitz (1:3), 1); +%! x(:,:,3) = circshift (toeplitz (1:3), 2); +%!test +%! [m, f, c] = mode (x, 1); +%! assert (reshape (m, [3, 3]), [1 1 1; 2 2 2; 1 1 1]); +%! assert (reshape (f, [3, 3]), [1 1 1; 2 2 2; 1 1 1]); +%! c = reshape (c, [3, 3]); +%! assert (c{1}, [1; 2; 3]); +%! assert (c{2}, 2); +%! assert (c{3}, [1; 2; 3]); +%!test +%! [m, f, c] = mode (x, 2); +%! assert (reshape (m, [3, 3]), [1 1 2; 2 1 1; 1 2 1]); +%! assert (reshape (f, [3, 3]), [1 1 2; 2 1 1; 1 2 1]); +%! c = reshape (c, [3, 3]); +%! assert (c{1}, [1; 2; 3]); +%! assert (c{2}, 2); +%! assert (c{3}, [1; 2; 3]); +%!test +%! [m, f, c] = mode (x, 3); +%! assert (reshape (m, [3, 3]), [1 2 1; 1 2 1; 1 2 1]); +%! assert (reshape (f, [3, 3]), [1 2 1; 1 2 1; 1 2 1]); +%! c = reshape (c, [3, 3]); +%! assert (c{1}, [1; 2; 3]); +%! assert (c{2}, [1; 2; 3]); +%! assert (c{3}, [1; 2; 3]); + +%% Test input validation +%!error mode () +%!error mode (1, 2, 3) +%!error mode ({1 2 3}) +%!error mode (['A'; 'B']) +%!error mode (1, ones(2,2)) +%!error mode (1, 1.5) +%!error mode (1, 0) +%!error mode (1, 3) + diff --git a/octave_packages/m/statistics/base/moment.m b/octave_packages/m/statistics/base/moment.m new file mode 100644 index 0000000..8d499cb --- /dev/null +++ b/octave_packages/m/statistics/base/moment.m @@ -0,0 +1,199 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} moment (@var{x}, @var{p}) +## @deftypefnx {Function File} {} moment (@var{x}, @var{p}, @var{type}) +## @deftypefnx {Function File} {} moment (@var{x}, @var{p}, @var{dim}) +## @deftypefnx {Function File} {} moment (@var{x}, @var{p}, @var{type}, @var{dim}) +## @deftypefnx {Function File} {} moment (@var{x}, @var{p}, @var{dim}, @var{type}) +## Compute the @var{p}-th moment of the vector @var{x} about zero. +## @tex +## $$ +## {\rm moment} (x) = { \sum_{i=1}^N {x_i}^p \over N } +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## moment (x) = 1/N SUM_i x(i)^p +## @end group +## @end example +## +## @end ifnottex +## +## If @var{x} is a matrix, return the row vector containing the +## @var{p}-th moment of each column. +## +## The optional string @var{type} specifies the type of moment to be computed. +## Valid options are: +## +## @table @asis +## @item "c" +## Central Moment. The moment about the mean defined as +## @tex +## $$ +## {\sum_{i=1}^N (x_i - \bar{x})^p \over N} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## 1/N SUM_i (x(i) - mean(x))^p +## @end group +## @end example +## +## @end ifnottex +## +## @item "a" +## Absolute Moment. The moment about zero ignoring sign defined as +## @tex +## $$ +## {\sum_{i=1}^N {\left| x_i \right|}^p \over N} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## 1/N SUM_i ( abs (x(i)) )^p +## @end group +## @end example +## +## @end ifnottex +## +## @item "ac" +## Absolute Central Moment. Defined as +## @tex +## $$ +## {\sum_{i=1}^N {\left| x_i - \bar{x} \right|}^p \over N} +## $$ +## @end tex +## @ifnottex +## +## @example +## @group +## 1/N SUM_i ( abs (x(i) - mean(x)) )^p +## @end group +## @end example +## +## @end ifnottex +## @end table +## +## If the optional argument @var{dim} is given, operate along this dimension. +## +## If both @var{type} and @var{dim} are given they may appear in any order. +## @seealso{var, skewness, kurtosis} +## @end deftypefn + +## Can easily be made to work for continuous distributions (using quad) +## as well, but how does the general case work? + +## Author: KH +## Description: Compute moments + +function m = moment (x, p, opt1, opt2) + + if (nargin < 2 || nargin > 4) + print_usage (); + endif + + if (!(isnumeric (x) || islogical (x)) || isempty (x)) + error ("moment: X must be a non-empty numeric matrix or vector"); + endif + + if (! (isnumeric (p) && isscalar (p))) + error ("moment: P must be a numeric scalar"); + endif + + need_dim = false; + + if (nargin == 2) + type = ""; + need_dim = true; + elseif (nargin == 3) + if (ischar (opt1)) + type = opt1; + need_dim = true; + else + dim = opt1; + type = ""; + endif + elseif (nargin == 4) + if (ischar (opt1)) + type = opt1; + dim = opt2; + elseif (ischar (opt2)) + type = opt2; + dim = opt1; + else + error ("moment: expecting TYPE to be a string"); + endif + endif + + nd = ndims (x); + sz = size (x); + if (need_dim) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) || + !(1 <= dim && dim <= nd)) + error ("moment: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + + if (any (type == "c")) + x = center (x, dim); + endif + if any (type == "a") + x = abs (x); + endif + + m = sum (x .^ p, dim) / n; + +endfunction + + +%!test +%! x = rand (10); +%! assert (moment (x,1), mean (x), 1e1*eps); +%! assert (moment (x,2), meansq (x), 1e1*eps); +%! assert (moment (x,1,2), mean (x,2), 1e1*eps); +%! assert (moment (x,1,'c'), mean (center (x)), 1e1*eps); +%! assert (moment (x,1,'a'), mean (abs (x)), 1e1*eps); + +%!assert (moment (single([1 2 3]),1), single(2)); + +%% Test input validation +%!error moment () +%!error moment (1) +%!error moment (1, 2, 3, 4, 5) +%!error moment (['A'; 'B'], 2) +%!error moment (ones(2,0,3), 2) +%!error moment (1, true) +%!error moment (1, ones(2,2)) +%!error moment (1, 2, 3, 4) +%!error moment (1, 2, ones(2,2)) +%!error moment (1, 2, 1.5) +%!error moment (1, 2, 4) + diff --git a/octave_packages/m/statistics/base/ols.m b/octave_packages/m/statistics/base/ols.m new file mode 100644 index 0000000..5349ec0 --- /dev/null +++ b/octave_packages/m/statistics/base/ols.m @@ -0,0 +1,173 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{beta}, @var{sigma}, @var{r}] =} ols (@var{y}, @var{x}) +## Ordinary least squares estimation for the multivariate model +## @tex +## $y = x b + e$ +## with +## $\bar{e} = 0$, and cov(vec($e$)) = kron ($s, I$) +## @end tex +## @ifnottex +## @w{@math{y = x*b + e}} with +## @math{mean (e) = 0} and @math{cov (vec (e)) = kron (s, I)}. +## @end ifnottex +## where +## @tex +## $y$ is a $t \times p$ matrix, $x$ is a $t \times k$ matrix, +## $b$ is a $k \times p$ matrix, and $e$ is a $t \times p$ matrix. +## @end tex +## @ifnottex +## @math{y} is a @math{t} by @math{p} matrix, @math{x} is a @math{t} by +## @math{k} matrix, @math{b} is a @math{k} by @math{p} matrix, and +## @math{e} is a @math{t} by @math{p} matrix. +## @end ifnottex +## +## Each row of @var{y} and @var{x} is an observation and each column a +## variable. +## +## The return values @var{beta}, @var{sigma}, and @var{r} are defined as +## follows. +## +## @table @var +## @item beta +## The OLS estimator for @math{b}. +## @tex +## $beta$ is calculated directly via $(x^Tx)^{-1} x^T y$ if the matrix $x^Tx$ is +## of full rank. +## @end tex +## @ifnottex +## @var{beta} is calculated directly via @code{inv (x'*x) * x' * y} if the +## matrix @code{x'*x} is of full rank. +## @end ifnottex +## Otherwise, @code{@var{beta} = pinv (@var{x}) * @var{y}} where +## @code{pinv (@var{x})} denotes the pseudoinverse of @var{x}. +## +## @item sigma +## The OLS estimator for the matrix @var{s}, +## +## @example +## @group +## @var{sigma} = (@var{y}-@var{x}*@var{beta})' +## * (@var{y}-@var{x}*@var{beta}) +## / (@var{t}-rank(@var{x})) +## @end group +## @end example +## +## @item r +## The matrix of OLS residuals, @code{@var{r} = @var{y} - @var{x}*@var{beta}}. +## @end table +## @seealso{gls, pinv} +## @end deftypefn + +## Author: Teresa Twaroch +## Created: May 1993 +## Adapted-By: jwe + +function [beta, sigma, r] = ols (y, x) + + if (nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) && isnumeric (y))) + error ("ols: X and Y must be numeric matrices or vectors"); + endif + + if (ndims (x) != 2 || ndims (y) != 2) + error ("ols: X and Y must be 2-D matrices or vectors"); + endif + + [nr, nc] = size (x); + [ry, cy] = size (y); + if (nr != ry) + error ("ols: number of rows of X and Y must be equal"); + endif + + if (isinteger (x)) + x = double (x); + endif + if (isinteger (y)) + y = double (y); + endif + + ## Start of algorithm + z = x' * x; + [u, p] = chol (z); + + if (p) + beta = pinv (x) * y; + else + beta = u \ (u' \ (x' * y)); + endif + + if (isargout (2) || isargout (3)) + r = y - x * beta; + endif + if (isargout (2)) + + ## z is of full rank, avoid the SVD in rnk + if (p == 0) + rnk = columns (z); + else + rnk = rank (z); + endif + + sigma = r' * r / (nr - rnk); + endif + +endfunction + + +%!test +%! x = [1:5]'; +%! y = 3*x + 2; +%! x = [x, ones(5,1)]; +%! assert (ols(y,x), [3; 2], 50*eps) + +%!test +%! x = [1, 2; 3, 4]; +%! y = [1; 2]; +%! [b, s, r] = ols (x, y); +%! assert (b, [1.4, 2], 2*eps); +%! assert (s, [0.2, 0; 0, 0], 2*eps); +%! assert (r, [-0.4, 0; 0.2, 0], 2*eps); + +%!test +%! x = [1, 2; 3, 4]; +%! y = [1; 2]; +%! [b, s] = ols (x, y); +%! assert (b, [1.4, 2], 2*eps); +%! assert (s, [0.2, 0; 0, 0], 2*eps); + +%!test +%! x = [1, 2; 3, 4]; +%! y = [1; 2]; +%! b = ols (x, y); +%! assert (b, [1.4, 2], 2*eps); + +%% Test input validation +%!error ols (); +%!error ols (1); +%!error ols (1, 2, 3); +%!error ols ([true, true], [1, 2]); +%!error ols ([1, 2], [true, true]); +%!error ols (ones (2,2,2), ones (2,2)); +%!error ols (ones (2,2), ones (2,2,2)); +%!error ols (ones(1,2), ones(2,2)); diff --git a/octave_packages/m/statistics/base/ppplot.m b/octave_packages/m/statistics/base/ppplot.m new file mode 100644 index 0000000..7f8788e --- /dev/null +++ b/octave_packages/m/statistics/base/ppplot.m @@ -0,0 +1,84 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{p}, @var{y}] =} ppplot (@var{x}, @var{dist}, @var{params}) +## Perform a PP-plot (probability plot). +## +## If F is the CDF of the distribution @var{dist} with parameters +## @var{params} and @var{x} a sample vector of length @var{n}, the +## PP-plot graphs ordinate @var{y}(@var{i}) = F (@var{i}-th largest +## element of @var{x}) versus abscissa @var{p}(@var{i}) = (@var{i} - +## 0.5)/@var{n}. If the sample comes from F, the pairs will +## approximately follow a straight line. +## +## The default for @var{dist} is the standard normal distribution. The +## optional argument @var{params} contains a list of parameters of +## @var{dist}. For example, for a probability plot of the uniform +## distribution on [2,4] and @var{x}, use +## +## @example +## ppplot (x, "uniform", 2, 4) +## @end example +## +## @noindent +## @var{dist} can be any string for which a function @var{dist_cdf} +## that calculates the CDF of distribution @var{dist} exists. +## +## If no output arguments are given, the data are plotted directly. +## @end deftypefn + +## Author: KH +## Description: Perform a PP-plot (probability plot) + +function [p, y] = ppplot (x, dist, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (! isvector (x)) + error ("ppplot: X must be a vector"); + endif + + s = sort (x); + n = length (x); + p = ((1 : n)' - 0.5) / n; + if (nargin == 1) + F = @stdnormal_cdf; + else + F = str2func (sprintf ("%scdf", dist)); + endif; + if (nargin <= 2) + y = feval (F, s); + else + y = feval (F, s, varargin{:}); + endif + + if (nargout == 0) + plot (p, y); + axis ([0, 1, 0, 1]); + endif + +endfunction + + +%% Test input validation +%!error ppplot (); +%!error ppplot (ones(2,2)); + diff --git a/octave_packages/m/statistics/base/prctile.m b/octave_packages/m/statistics/base/prctile.m new file mode 100644 index 0000000..2e77ad1 --- /dev/null +++ b/octave_packages/m/statistics/base/prctile.m @@ -0,0 +1,175 @@ +## Copyright (C) 2008-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} prctile (@var{x}) +## @deftypefnx {Function File} {@var{q} =} prctile (@var{x}, @var{p}) +## @deftypefnx {Function File} {@var{q} =} prctile (@var{x}, @var{p}, @var{dim}) +## For a sample @var{x}, compute the quantiles, @var{q}, corresponding +## to the cumulative probability values, @var{p}, in percent. All non-numeric +## values (NaNs) of @var{x} are ignored. +## +## If @var{x} is a matrix, compute the percentiles for each column and +## return them in a matrix, such that the i-th row of @var{y} contains the +## @var{p}(i)th percentiles of each column of @var{x}. +## +## If @var{p} is unspecified, return the quantiles for @code{[0 25 50 75 100]}. +## The optional argument @var{dim} determines the dimension along which +## the percentiles are calculated. If @var{dim} is omitted, and @var{x} is +## a vector or matrix, it defaults to 1 (column-wise quantiles). When +## @var{x} is an N-D array, @var{dim} defaults to the first non-singleton +## dimension. +## @seealso{quantile} +## @end deftypefn + +## Author: Ben Abbott +## Description: Matlab style prctile function. + +function q = prctile (x, p = [], dim) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("prctile: X must be a numeric vector or matrix"); + endif + + if (isempty (p)) + p = [0, 25, 50, 75, 100]; + endif + + if (! (isnumeric (p) && isvector (p))) + error ("prctile: P must be a numeric vector"); + endif + + nd = ndims (x); + if (nargin == 2) + if (nd == 2) + ## If a matrix or vector, always use 1st dimension. + dim = 1; + else + ## If an N-d array, find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + endif + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("prctile: DIM must be an integer and a valid dimension"); + endif + endif + + ## Convert from percent to decimal. + p /= 100; + + q = quantile (x, p, dim); + +endfunction + + +%!test +%! pct = 50; +%! q = prctile (1:4, pct, 1); +%! qa = [1, 2, 3, 4]; +%! assert (q, qa); +%! q = prctile (1:4, pct, 2); +%! qa = 2.5000; +%! assert (q, qa); + +%!test +%! pct = 50; +%! x = [0.1126, 0.1148, 0.0521, 0.2364, 0.1393 +%! 0.1718, 0.7273, 0.2041, 0.4531, 0.1585 +%! 0.2795, 0.7978, 0.3296, 0.5567, 0.7307 +%! 0.4288, 0.8753, 0.6477, 0.6287, 0.8165 +%! 0.9331, 0.9312, 0.9635, 0.7796, 0.8461]; +%! tol = 0.0001; +%! q = prctile (x, pct, 1); +%! qa = [0.2795, 0.7978, 0.3296, 0.5567, 0.7307]; +%! assert (q, qa, tol); +%! q = prctile (x, pct, 2); +%! qa = [0.1148; 0.2041; 0.5567; 0.6477; 0.9312]; +%! assert (q, qa, tol); + +%!test +%! pct = 50; +%! tol = 0.0001; +%! x = [0.1126, 0.1148, 0.0521, 0.2364, 0.1393 +%! 0.1718, 0.7273, 0.2041, 0.4531, 0.1585 +%! 0.2795, 0.7978, 0.3296, 0.5567, 0.7307 +%! 0.4288, 0.8753, 0.6477, 0.6287, 0.8165 +%! 0.9331, 0.9312, 0.9635, 0.7796, 0.8461]; +%! x(5,5) = Inf; +%! q = prctile (x, pct, 1); +%! qa = [0.2795, 0.7978, 0.3296, 0.5567, 0.7307]; +%! assert (q, qa, tol); +%! x(5,5) = -Inf; +%! q = prctile (x, pct, 1); +%! qa = [0.2795, 0.7978, 0.3296, 0.5567, 0.1585]; +%! assert (q, qa, tol); +%! x(1,1) = Inf; +%! q = prctile (x, pct, 1); +%! qa = [0.4288, 0.7978, 0.3296, 0.5567, 0.1585]; +%! assert (q, qa, tol); + +%!test +%! pct = 50; +%! tol = 0.0001; +%! x = [0.1126, 0.1148, 0.0521, 0.2364, 0.1393 +%! 0.1718, 0.7273, 0.2041, 0.4531, 0.1585 +%! 0.2795, 0.7978, 0.3296, 0.5567, 0.7307 +%! 0.4288, 0.8753, 0.6477, 0.6287, 0.8165 +%! 0.9331, 0.9312, 0.9635, 0.7796, 0.8461]; +%! x(3,3) = Inf; +%! q = prctile (x, pct, 1); +%! qa = [0.2795, 0.7978, 0.6477, 0.5567, 0.7307]; +%! assert (q, qa, tol); +%! q = prctile (x, pct, 2); +%! qa = [0.1148; 0.2041; 0.7307; 0.6477; 0.9312]; +%! assert (q, qa, tol); + +%!test +%! pct = 50; +%! tol = 0.0001; +%! x = [0.1126, 0.1148, 0.0521, 0.2364, 0.1393 +%! 0.1718, 0.7273, 0.2041, 0.4531, 0.1585 +%! 0.2795, 0.7978, 0.3296, 0.5567, 0.7307 +%! 0.4288, 0.8753, 0.6477, 0.6287, 0.8165 +%! 0.9331, 0.9312, 0.9635, 0.7796, 0.8461]; +%! x(5,5) = NaN; +%! q = prctile (x, pct, 2); +%! qa = [0.1148; 0.2041; 0.5567; 0.6477; 0.9322]; +%! assert (q, qa, tol); +%! x(1,1) = NaN; +%! q = prctile (x, pct, 2); +%! qa = [0.1270; 0.2041; 0.5567; 0.6477; 0.9322]; +%! assert (q, qa, tol); +%! x(3,3) = NaN; +%! q = prctile (x, pct, 2); +%! qa = [0.1270; 0.2041; 0.6437; 0.6477; 0.9322]; +%! assert (q, qa, tol); + +%% Test input validation +%!error prctile () +%!error prctile (1, 2, 3, 4) +%!error prctile (['A'; 'B'], 10) +%!error prctile (1:10, [true, false]) +%!error prctile (1:10, ones (2,2)) +%!error prctile (1, 1, 1.5) +%!error prctile (1, 1, 0) +%!error prctile (1, 1, 3) diff --git a/octave_packages/m/statistics/base/probit.m b/octave_packages/m/statistics/base/probit.m new file mode 100644 index 0000000..17f064b --- /dev/null +++ b/octave_packages/m/statistics/base/probit.m @@ -0,0 +1,44 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} probit (@var{p}) +## For each component of @var{p}, return the probit (the quantile of the +## standard normal distribution) of @var{p}. +## @end deftypefn + +## Written by KH on 1995/02/04 +## Description: Probit transformation + +function y = probit (p) + + + if (nargin != 1) + print_usage (); + endif + + y = stdnormal_inv (p); + +endfunction + +%!assert(probit([-1, 0, 0.5, 1, 2]), [NaN, -Inf, 0, Inf, NaN]); + +%% Test input validation +%!error probit () +%!error probit (1, 2) + diff --git a/octave_packages/m/statistics/base/qqplot.m b/octave_packages/m/statistics/base/qqplot.m new file mode 100644 index 0000000..80e752f --- /dev/null +++ b/octave_packages/m/statistics/base/qqplot.m @@ -0,0 +1,99 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{q}, @var{s}] =} qqplot (@var{x}) +## @deftypefnx {Function File} {[@var{q}, @var{s}] =} qqplot (@var{x}, @var{dist}) +## @deftypefnx {Function File} {[@var{q}, @var{s}] =} qqplot (@var{x}, @var{dist}, @var{params}) +## @deftypefnx {Function File} {} qqplot (@dots{}) +## Perform a QQ-plot (quantile plot). +## +## If F is the CDF of the distribution @var{dist} with parameters +## @var{params} and G its inverse, and @var{x} a sample vector of length +## @var{n}, the QQ-plot graphs ordinate @var{s}(@var{i}) = @var{i}-th +## largest element of x versus abscissa @var{q}(@var{i}f) = G((@var{i} - +## 0.5)/@var{n}). +## +## If the sample comes from F, except for a transformation of location +## and scale, the pairs will approximately follow a straight line. +## +## The default for @var{dist} is the standard normal distribution. The +## optional argument @var{params} contains a list of parameters of +## @var{dist}. For example, for a quantile plot of the uniform +## distribution on [2,4] and @var{x}, use +## +## @example +## qqplot (x, "unif", 2, 4) +## @end example +## +## @noindent +## @var{dist} can be any string for which a function @var{distinv} or +## @var{dist_inv} exists that calculates the inverse CDF of distribution +## @var{dist}. +## +## If no output arguments are given, the data are plotted directly. +## @end deftypefn + +## Author: KH +## Description: Perform a QQ-plot (quantile plot) + +function [q, s] = qqplot (x, dist, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (!(isnumeric (x) && isvector(x))) + error ("qqplot: X must be a numeric vector"); + endif + + if (nargin == 1) + f = @stdnormal_inv; + else + if ( exist (invname = sprintf ("%sinv", dist)) + || exist (invname = sprintf ("%s_inv", dist))) + f = str2func (invname); + else + error ("qqplot: no inverse CDF found for distribution DIST"); + endif + endif; + + s = sort (x); + n = length (x); + t = ((1 : n)' - .5) / n; + if (nargin <= 2) + q = feval (f, t); + q_label = func2str (f); + else + q = feval (f, t, varargin{:}); + if (nargin > 3) + tmp = sprintf (", %g", varargin{2:end}); + else + tmp = ""; + endif + q_label = sprintf ("%s with parameter(s) %g%s", + func2str (f), varargin{1}, tmp); + endif + + if (nargout == 0) + plot (q, s); + xlabel (q_label); + ylabel ("sample points"); + endif + +endfunction diff --git a/octave_packages/m/statistics/base/quantile.m b/octave_packages/m/statistics/base/quantile.m new file mode 100644 index 0000000..bb6353e --- /dev/null +++ b/octave_packages/m/statistics/base/quantile.m @@ -0,0 +1,415 @@ +## Copyright (C) 2008-2012 Ben Abbott and Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{q} =} quantile (@var{x}, @var{p}) +## @deftypefnx {Function File} {@var{q} =} quantile (@var{x}, @var{p}, @var{dim}) +## @deftypefnx {Function File} {@var{q} =} quantile (@var{x}, @var{p}, @var{dim}, @var{method}) +## For a sample, @var{x}, calculate the quantiles, @var{q}, corresponding to +## the cumulative probability values in @var{p}. All non-numeric values (NaNs) +## of @var{x} are ignored. +## +## If @var{x} is a matrix, compute the quantiles for each column and +## return them in a matrix, such that the i-th row of @var{q} contains +## the @var{p}(i)th quantiles of each column of @var{x}. +## +## The optional argument @var{dim} determines the dimension along which +## the quantiles are calculated. If @var{dim} is omitted, and @var{x} is +## a vector or matrix, it defaults to 1 (column-wise quantiles). If +## @var{x} is an N-D array, @var{dim} defaults to the first non-singleton +## dimension. +## +## The methods available to calculate sample quantiles are the nine methods +## used by R (http://www.r-project.org/). The default value is METHOD = 5. +## +## Discontinuous sample quantile methods 1, 2, and 3 +## +## @enumerate 1 +## @item Method 1: Inverse of empirical distribution function. +## +## @item Method 2: Similar to method 1 but with averaging at discontinuities. +## +## @item Method 3: SAS definition: nearest even order statistic. +## @end enumerate +## +## Continuous sample quantile methods 4 through 9, where p(k) is the linear +## interpolation function respecting each methods' representative cdf. +## +## @enumerate 4 +## @item Method 4: p(k) = k / n. That is, linear interpolation of the +## empirical cdf. +## +## @item Method 5: p(k) = (k - 0.5) / n. That is a piecewise linear function +## where the knots are the values midway through the steps of the empirical +## cdf. +## +## @item Method 6: p(k) = k / (n + 1). +## +## @item Method 7: p(k) = (k - 1) / (n - 1). +## +## @item Method 8: p(k) = (k - 1/3) / (n + 1/3). The resulting quantile +## estimates are approximately median-unbiased regardless of the distribution +## of @var{x}. +## +## @item Method 9: p(k) = (k - 3/8) / (n + 1/4). The resulting quantile +## estimates are approximately unbiased for the expected order statistics if +## @var{x} is normally distributed. +## @end enumerate +## +## Hyndman and Fan (1996) recommend method 8. Maxima, S, and R +## (versions prior to 2.0.0) use 7 as their default. Minitab and SPSS +## use method 6. @sc{matlab} uses method 5. +## +## References: +## +## @itemize @bullet +## @item Becker, R. A., Chambers, J. M. and Wilks, A. R. (1988) The New +## S Language. Wadsworth & Brooks/Cole. +## +## @item Hyndman, R. J. and Fan, Y. (1996) Sample quantiles in +## statistical packages, American Statistician, 50, 361--365. +## +## @item R: A Language and Environment for Statistical Computing; +## @url{http://cran.r-project.org/doc/manuals/fullrefman.pdf}. +## @end itemize +## +## Examples: +## @c Set example in small font to prevent overfull line +## +## @smallexample +## @group +## x = randi (1000, [10, 1]); # Create empirical data in range 1-1000 +## q = quantile (x, [0, 1]); # Return minimum, maximum of distribution +## q = quantile (x, [0.25 0.5 0.75]); # Return quartiles of distribution +## @end group +## @end smallexample +## @seealso{prctile} +## @end deftypefn + +## Author: Ben Abbott +## Description: Matlab style quantile function of a discrete/continuous distribution + +function q = quantile (x, p = [], dim = 1, method = 5) + + if (nargin < 1 || nargin > 4) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("quantile: X must be a numeric vector or matrix"); + endif + + if (isempty (p)) + p = [0.00 0.25, 0.50, 0.75, 1.00]; + endif + + if (! (isnumeric (p) && isvector (p))) + error ("quantile: P must be a numeric vector"); + endif + + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= ndims (x))) + error ("quantile: DIM must be an integer and a valid dimension"); + endif + + ## Set the permutation vector. + perm = 1:ndims(x); + perm(1) = dim; + perm(dim) = 1; + + ## Permute dim to the 1st index. + x = permute (x, perm); + + ## Save the size of the permuted x N-d array. + sx = size (x); + + ## Reshape to a 2-d array. + x = reshape (x, [sx(1), prod(sx(2:end))]); + + ## Calculate the quantiles. + q = __quantile__ (x, p, method); + + ## Return the shape to the original N-d array. + q = reshape (q, [numel(p), sx(2:end)]); + + ## Permute the 1st index back to dim. + q = ipermute (q, perm); + +endfunction + + +%!test +%! p = 0.5; +%! x = sort (rand (11)); +%! q = quantile (x, p); +%! assert (q, x(6,:)) +%! x = x.'; +%! q = quantile (x, p, 2); +%! assert (q, x(:,6)); + +%!test +%! p = [0.00, 0.25, 0.50, 0.75, 1.00]; +%! x = [1; 2; 3; 4]; +%! a = [1.0000 1.0000 2.0000 3.0000 4.0000 +%! 1.0000 1.5000 2.5000 3.5000 4.0000 +%! 1.0000 1.0000 2.0000 3.0000 4.0000 +%! 1.0000 1.0000 2.0000 3.0000 4.0000 +%! 1.0000 1.5000 2.5000 3.5000 4.0000 +%! 1.0000 1.2500 2.5000 3.7500 4.0000 +%! 1.0000 1.7500 2.5000 3.2500 4.0000 +%! 1.0000 1.4167 2.5000 3.5833 4.0000 +%! 1.0000 1.4375 2.5000 3.5625 4.0000]; +%! for m = (1:9) +%! q = quantile (x, p, 1, m).'; +%! assert (q, a(m,:), 0.0001) +%! endfor + +%!test +%! p = [0.00, 0.25, 0.50, 0.75, 1.00]; +%! x = [1; 2; 3; 4; 5]; +%! a = [1.0000 2.0000 3.0000 4.0000 5.0000 +%! 1.0000 2.0000 3.0000 4.0000 5.0000 +%! 1.0000 1.0000 2.0000 4.0000 5.0000 +%! 1.0000 1.2500 2.5000 3.7500 5.0000 +%! 1.0000 1.7500 3.0000 4.2500 5.0000 +%! 1.0000 1.5000 3.0000 4.5000 5.0000 +%! 1.0000 2.0000 3.0000 4.0000 5.0000 +%! 1.0000 1.6667 3.0000 4.3333 5.0000 +%! 1.0000 1.6875 3.0000 4.3125 5.0000]; +%! for m = (1:9) +%! q = quantile (x, p, 1, m).'; +%! assert (q, a(m,:), 0.0001) +%! endfor + +%!test +%! p = [0.00, 0.25, 0.50, 0.75, 1.00]; +%! x = [1; 2; 5; 9]; +%! a = [1.0000 1.0000 2.0000 5.0000 9.0000 +%! 1.0000 1.5000 3.5000 7.0000 9.0000 +%! 1.0000 1.0000 2.0000 5.0000 9.0000 +%! 1.0000 1.0000 2.0000 5.0000 9.0000 +%! 1.0000 1.5000 3.5000 7.0000 9.0000 +%! 1.0000 1.2500 3.5000 8.0000 9.0000 +%! 1.0000 1.7500 3.5000 6.0000 9.0000 +%! 1.0000 1.4167 3.5000 7.3333 9.0000 +%! 1.0000 1.4375 3.5000 7.2500 9.0000]; +%! for m = (1:9) +%! q = quantile (x, p, 1, m).'; +%! assert (q, a(m,:), 0.0001) +%! endfor + +%!test +%! p = [0.00, 0.25, 0.50, 0.75, 1.00]; +%! x = [1; 2; 5; 9; 11]; +%! a = [1.0000 2.0000 5.0000 9.0000 11.0000 +%! 1.0000 2.0000 5.0000 9.0000 11.0000 +%! 1.0000 1.0000 2.0000 9.0000 11.0000 +%! 1.0000 1.2500 3.5000 8.0000 11.0000 +%! 1.0000 1.7500 5.0000 9.5000 11.0000 +%! 1.0000 1.5000 5.0000 10.0000 11.0000 +%! 1.0000 2.0000 5.0000 9.0000 11.0000 +%! 1.0000 1.6667 5.0000 9.6667 11.0000 +%! 1.0000 1.6875 5.0000 9.6250 11.0000]; +%! for m = (1:9) +%! q = quantile (x, p, 1, m).'; +%! assert (q, a(m,:), 0.0001) +%! endfor + +%!test +%! p = [0.00, 0.25, 0.50, 0.75, 1.00]; +%! x = [16; 11; 15; 12; 15; 8; 11; 12; 6; 10]; +%! a = [6.0000 10.0000 11.0000 15.0000 16.0000 +%! 6.0000 10.0000 11.5000 15.0000 16.0000 +%! 6.0000 8.0000 11.0000 15.0000 16.0000 +%! 6.0000 9.0000 11.0000 13.5000 16.0000 +%! 6.0000 10.0000 11.5000 15.0000 16.0000 +%! 6.0000 9.5000 11.5000 15.0000 16.0000 +%! 6.0000 10.2500 11.5000 14.2500 16.0000 +%! 6.0000 9.8333 11.5000 15.0000 16.0000 +%! 6.0000 9.8750 11.5000 15.0000 16.0000]; +%! for m = (1:9) +%! q = quantile (x, p, 1, m).'; +%! assert (q, a(m,:), 0.0001) +%! endfor + +%!test +%! p = [0.00, 0.25, 0.50, 0.75, 1.00]; +%! x = [-0.58851; 0.40048; 0.49527; -2.551500; -0.52057; ... +%! -0.17841; 0.057322; -0.62523; 0.042906; 0.12337]; +%! a = [-2.551474 -0.588505 -0.178409 0.123366 0.495271 +%! -2.551474 -0.588505 -0.067751 0.123366 0.495271 +%! -2.551474 -0.625231 -0.178409 0.123366 0.495271 +%! -2.551474 -0.606868 -0.178409 0.090344 0.495271 +%! -2.551474 -0.588505 -0.067751 0.123366 0.495271 +%! -2.551474 -0.597687 -0.067751 0.192645 0.495271 +%! -2.551474 -0.571522 -0.067751 0.106855 0.495271 +%! -2.551474 -0.591566 -0.067751 0.146459 0.495271 +%! -2.551474 -0.590801 -0.067751 0.140686 0.495271]; +%! for m = (1:9) +%! q = quantile (x, p, 1, m).'; +%! assert (q, a(m,:), 0.0001) +%! endfor + +%!test +%! p = 0.5; +%! x = [0.112600, 0.114800, 0.052100, 0.236400, 0.139300 +%! 0.171800, 0.727300, 0.204100, 0.453100, 0.158500 +%! 0.279500, 0.797800, 0.329600, 0.556700, 0.730700 +%! 0.428800, 0.875300, 0.647700, 0.628700, 0.816500 +%! 0.933100, 0.931200, 0.963500, 0.779600, 0.846100]; +%! tol = 0.00001; +%! x(5,5) = NaN; +%! assert (quantile(x, p, 1), [0.27950, 0.79780, 0.32960, 0.55670, 0.44460], tol); +%! x(1,1) = NaN; +%! assert (quantile(x, p, 1), [0.35415, 0.79780, 0.32960, 0.55670, 0.44460], tol); +%! x(3,3) = NaN; +%! assert (quantile(x, p, 1), [0.35415, 0.79780, 0.42590, 0.55670, 0.44460], tol); + +%!test +%! sx = [2, 3, 4]; +%! x = rand (sx); +%! dim = 2; +%! p = 0.5; +%! yobs = quantile (x, p, dim); +%! yexp = median (x, dim); +%! assert (yobs, yexp); + +%% Test input validation +%!error quantile () +%!error quantile (1, 2, 3, 4, 5) +%!error quantile (['A'; 'B'], 10) +%!error quantile (1:10, [true, false]) +%!error quantile (1:10, ones (2,2)) +%!error quantile (1, 1, 1.5) +%!error quantile (1, 1, 0) +%!error quantile (1, 1, 3) +%!error quantile ((1:5)', 0.5, 1, 0) +%!error quantile ((1:5)', 0.5, 1, 10) + +## For the cumulative probability values in @var{p}, compute the +## quantiles, @var{q} (the inverse of the cdf), for the sample, @var{x}. +## +## The optional input, @var{method}, refers to nine methods available in R +## (http://www.r-project.org/). The default is @var{method} = 7. For more +## detail, see `help quantile'. +## @seealso{prctile, quantile, statistics} + +## Author: Ben Abbott +## Vectorized version: Jaroslav Hajek +## Description: Quantile function of empirical samples + +function inv = __quantile__ (x, p, method = 5) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (isinteger (x) || islogical (x)) + x = double (x); + endif + + ## set shape of quantiles to column vector. + p = p(:); + + ## Save length and set shape of samples. + ## FIXME: does sort guarantee that NaN's come at the end? + x = sort (x); + m = sum (! isnan (x)); + [xr, xc] = size (x); + + ## Initialize output values. + inv = Inf (class (x)) * (-(p < 0) + (p > 1)); + inv = repmat (inv, 1, xc); + + ## Do the work. + if (any (k = find ((p >= 0) & (p <= 1)))) + n = length (k); + p = p(k); + ## Special case of 1 row. + if (xr == 1) + inv(k,:) = repmat (x, n, 1); + return; + endif + + ## The column-distribution indices. + pcd = kron (ones (n, 1), xr*(0:xc-1)); + mm = kron (ones (n, 1), m); + switch (method) + case {1, 2, 3} + switch (method) + case 1 + p = max (ceil (kron (p, m)), 1); + inv(k,:) = x(p + pcd); + + case 2 + p = kron (p, m); + p_lr = max (ceil (p), 1); + p_rl = min (floor (p + 1), mm); + inv(k,:) = (x(p_lr + pcd) + x(p_rl + pcd))/2; + + case 3 + ## Used by SAS, method PCTLDEF=2. + ## http://support.sas.com/onlinedoc/913/getDoc/en/statug.hlp/stdize_sect14.htm + t = max (kron (p, m), 1); + t = roundb (t); + inv(k,:) = x(t + pcd); + endswitch + + otherwise + switch (method) + case 4 + p = kron (p, m); + + case 5 + ## Used by Matlab. + p = kron (p, m) + 0.5; + + case 6 + ## Used by Minitab and SPSS. + p = kron (p, m+1); + + case 7 + ## Used by S and R. + p = kron (p, m-1) + 1; + + case 8 + ## Median unbiased. + p = kron (p, m+1/3) + 1/3; + + case 9 + ## Approximately unbiased respecting order statistics. + p = kron (p, m+0.25) + 0.375; + + otherwise + error ("quantile: Unknown METHOD, '%d'", method); + endswitch + + ## Duplicate single values. + imm1 = (mm == 1); + x(2,imm1) = x(1,imm1); + + ## Interval indices. + pi = max (min (floor (p), mm-1), 1); + pr = max (min (p - pi, 1), 0); + pi += pcd; + inv(k,:) = (1-pr) .* x(pi) + pr .* x(pi+1); + endswitch + endif + +endfunction + diff --git a/octave_packages/m/statistics/base/range.m b/octave_packages/m/statistics/base/range.m new file mode 100644 index 0000000..2d926ef --- /dev/null +++ b/octave_packages/m/statistics/base/range.m @@ -0,0 +1,61 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} range (@var{x}) +## @deftypefnx {Function File} {} range (@var{x}, @var{dim}) +## Return the range, i.e., the difference between the maximum and the minimum +## of the input data. If @var{x} is a vector, the range is calculated over +## the elements of @var{x}. If @var{x} is a matrix, the range is calculated +## over each column of @var{x}. +## +## If the optional argument @var{dim} is given, operate along this dimension. +## +## The range is a quickly computed measure of the dispersion of a data set, but +## is less accurate than @code{iqr} if there are outlying data points. +## @seealso{iqr, std} +## @end deftypefn + +## Author: KH +## Description: Compute range + +function y = range (x, dim) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1) + y = max (x) - min (x); + else + y = max (x, [], dim) - min (x, [], dim); + endif + +endfunction + + +%!assert(range (1:10), 9); +%!assert(range (single(1:10)), single(9)); +%!assert(range (magic (3)), [5, 8, 5]); +%!assert(range (magic (3), 2), [7; 4; 7]); +%!assert(range (2), 0); + +%% Test input validation +%!error range () +%!error range (1, 2, 3) diff --git a/octave_packages/m/statistics/base/ranks.m b/octave_packages/m/statistics/base/ranks.m new file mode 100644 index 0000000..fb87ec4 --- /dev/null +++ b/octave_packages/m/statistics/base/ranks.m @@ -0,0 +1,104 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ranks (@var{x}, @var{dim}) +## Return the ranks of @var{x} along the first non-singleton dimension +## adjusted for ties. If the optional argument @var{dim} is +## given, operate along this dimension. +## @seealso{spearman, kendall} +## @end deftypefn + +## Author: KH +## Description: Compute ranks + +## This code was rather ugly, since it didn't use sort due to the +## fact of how to deal with ties. Now it does use sort and its +## even uglier!!! At least it handles NDArrays.. + +function y = ranks (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("ranks: X must be a numeric vector or matrix"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin != 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("ranks: DIM must be an integer and a valid dimension"); + endif + endif + + if (sz(dim) == 1) + y = ones(sz); + else + ## The algorithm works only on dim = 1, so permute if necesary. + if (dim != 1) + perm = [1 : nd]; + perm(1) = dim; + perm(dim) = 1; + x = permute (x, perm); + endif + sz = size (x); + infvec = -Inf ([1, sz(2 : end)]); + [xs, xi] = sort (x); + eq_el = find (diff ([xs; infvec]) == 0); + if (isempty (eq_el)) + [eq_el, y] = sort (xi); + else + runs = setdiff (eq_el, eq_el+1); + len = diff (find (diff ([Inf; eq_el; -Inf]) != 1)) + 1; + [eq_el, y] = sort (xi); + for i = 1 : length(runs) + y (xi (runs (i) + [0:(len(i)-1)]) + floor (runs (i) ./ sz(1)) + * sz(1)) = eq_el(runs(i)) + (len(i) - 1) / 2; + endfor + endif + if (dim != 1) + y = permute (y, perm); + endif + endif + +endfunction + + +%!assert(ranks (1:2:10), 1:5); +%!assert(ranks (10:-2:1), 5:-1:1); +%!assert(ranks ([2, 1, 2, 4]), [2.5, 1, 2.5, 4]); +%!assert(ranks (ones(1, 5)), 3*ones(1, 5)); +%!assert(ranks (1e6*ones(1, 5)), 3*ones(1, 5)); +%!assert(ranks (rand (1, 5), 1), ones(1, 5)); + +%% Test input validation +%!error ranks () +%!error ranks (1, 2, 3) +%!error ranks ({1, 2}) +%!error ranks (['A'; 'B']) +%!error ranks (1, 1.5) +%!error ranks (1, 0) +%!error ranks (1, 3) + diff --git a/octave_packages/m/statistics/base/run_count.m b/octave_packages/m/statistics/base/run_count.m new file mode 100644 index 0000000..4e2d7ae --- /dev/null +++ b/octave_packages/m/statistics/base/run_count.m @@ -0,0 +1,113 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} run_count (@var{x}, @var{n}) +## @deftypefnx {Function File} {} run_count (@var{x}, @var{n}, @var{dim}) +## Count the upward runs along the first non-singleton dimension of +## @var{x} of length 1, 2, @dots{}, @var{n}-1 and greater than or equal +## to @var{n}. +## +## If the optional argument @var{dim} is given then operate +## along this dimension. +## @end deftypefn + +## Author: FL +## Description: Count upward runs + +function retval = run_count (x, n, dim) + + if (nargin != 2 && nargin != 3) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("run_count: X must be a numeric vector or matrix"); + endif + + if (!(isscalar (n) && n == fix (n) && n > 0)) + error ("run_count: N must be a positive integer"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin != 3) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("run_count: DIM must be an integer and a valid dimension"); + endif + endif + + ## Algorithm works on rows. Permute array if necessary, ipermute back at end + if (dim != 1) + perm = [1 : nd]; + perm(1) = dim; + perm(dim) = 1; + x = permute (x, perm); + endif + + sz = size (x); + idx = cell (); + for i = 1 : nd + idx{i} = 1 : sz(i); + endfor + c = sz(1); + tmp = zeros ([c + 1, sz(2 : end)]); + infvec = Inf ([1, sz(2 : end)]); + + ind = find (diff ([infvec; x; -infvec]) < 0); + tmp(ind(2:end) - 1) = diff (ind); + tmp = tmp(idx{:}); + + sz(1) = n; + retval = zeros (sz); + for k = 1 : (n-1) + idx{1} = k; + retval(idx{:}) = sum (tmp == k); + endfor + idx{1} = n; + retval(idx{:}) = sum (tmp >= n); + + if (dim != 1) + retval = ipermute (retval, perm); + endif + +endfunction + + +%!assert(run_count (magic(3), 4), [1,0,1;1,0,1;0,1,0;0,0,0]) +%!assert(run_count (magic(3), 4, 2), [1,0,1;1,0,1;0,1,0;0,0,0]') +%!assert(run_count (5:-1:1, 5), [5, 0, 0, 0, 0]) +%!assert(run_count (ones(3), 4), [0,0,0;0,0,0;1,1,1;0,0,0]) + +%% Test input validation +%!error run_count () +%!error run_count (1) +%!error run_count (1, 2, 3, 4) +%!error run_count ({1, 2}, 3) +%!error run_count (['A'; 'A'; 'B'], 3) +%!error run_count (1:5, ones(2,2)) +%!error run_count (1:5, 1.5) +%!error run_count (1:5, -2) +%!error run_count (1:5, 3, ones(2,2)) +%!error run_count (1:5, 3, 1.5) +%!error run_count (1:5, 3, 0) + diff --git a/octave_packages/m/statistics/base/runlength.m b/octave_packages/m/statistics/base/runlength.m new file mode 100644 index 0000000..b396746 --- /dev/null +++ b/octave_packages/m/statistics/base/runlength.m @@ -0,0 +1,66 @@ +## Copyright (C) 2005-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[count, value] =} runlength (@var{x}) +## Find the lengths of all sequences of common values. Return the +## vector of lengths and the value that was repeated. +## +## @example +## @group +## runlength ([2, 2, 0, 4, 4, 4, 0, 1, 1, 1, 1]) +## @result{} [2, 1, 3, 1, 4] +## @end group +## @end example +## @end deftypefn + +function [count, value] = runlength (x) + + if (nargin != 1) + print_usage (); + endif + + if (!(isnumeric (x) || islogical (x)) || !isvector (x)) + error ("runlength: X must be a numeric vector"); + endif + + if (iscolumn (x)) + x = x.'; + endif + + idx = [find(x(1:end-1) != x(2:end)), length(x)]; + count = diff ([0 idx]); + if (nargout == 2) + value = x(idx); + endif + +endfunction + + +%!assert (runlength([2 2 0 4 4 4 0 1 1 1 1]), [2 1 3 1 4]); +%!assert (runlength([2 2 0 4 4 4 0 1 1 1 1]'), [2 1 3 1 4]); +%!test +%! [c, v] = runlength ([2 2 0 4 4 4 0 1 1 1 1]); +%! assert (c, [2 1 3 1 4]); +%! assert (v, [2 0 4 0 1]); + +%% Test input validation +%!error runlength () +%!error runlength (1, 2) +%!error runlength (['A'; 'B']) +%!error runlength (ones(2,2)) diff --git a/octave_packages/m/statistics/base/skewness.m b/octave_packages/m/statistics/base/skewness.m new file mode 100644 index 0000000..d2905d2 --- /dev/null +++ b/octave_packages/m/statistics/base/skewness.m @@ -0,0 +1,100 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} skewness (@var{x}) +## @deftypefnx {Function File} {} skewness (@var{x}, @var{dim}) +## Compute the skewness of the elements of the vector @var{x}. +## @tex +## $$ +## {\rm skewness} (x) = {1\over N \sigma^3} \sum_{i=1}^N (x_i-\bar{x})^3 +## $$ +## where $\bar{x}$ is the mean value of $x$. +## @end tex +## @ifnottex +## +## @example +## skewness (x) = 1/N std(x)^(-3) sum ((x - mean(x)).^3) +## @end example +## +## @end ifnottex +## +## @noindent +## If @var{x} is a matrix, return the skewness along the +## first non-singleton dimension of the matrix. If the optional +## @var{dim} argument is given, operate along this dimension. +## @seealso{var, kurtosis, moment} +## @end deftypefn + +## Author: KH +## Created: 29 July 1994 +## Adapted-By: jwe + +function retval = skewness (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("skewness: X must be a numeric vector or matrix"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin != 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("skewness: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + sz(dim) = 1; + x = center (x, dim); # center also promotes integer to double for next line + retval = zeros (sz, class (x)); + s = std (x, [], dim); + idx = find (s > 0); + x = sum (x .^ 3, dim); + retval(idx) = x(idx) ./ (n * s(idx) .^ 3); + +endfunction + + +%!assert(skewness ([-1,0,1]), 0); +%!assert(skewness ([-2,0,1]) < 0); +%!assert(skewness ([-1,0,2]) > 0); +%!assert(skewness ([-3,0,1]) == -1*skewness([-1,0,3])); +%!test +%! x = [0; 0; 0; 1]; +%! y = [x, 2*x]; +%! assert(all (abs (skewness (y) - [0.75, 0.75]) < sqrt (eps))); + +%!assert (skewness (single(1)), single(0)); + +%% Test input validation +%!error skewness () +%!error skewness (1, 2, 3) +%!error skewness (['A'; 'B']) +%!error skewness (1, ones(2,2)) +%!error skewness (1, 1.5) +%!error skewness (1, 0) +%!error skewness (1, 3) diff --git a/octave_packages/m/statistics/base/spearman.m b/octave_packages/m/statistics/base/spearman.m new file mode 100644 index 0000000..b01285c --- /dev/null +++ b/octave_packages/m/statistics/base/spearman.m @@ -0,0 +1,94 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} spearman (@var{x}) +## @deftypefnx {Function File} {} spearman (@var{x}, @var{y}) +## @cindex Spearman's Rho +## Compute Spearman's rank correlation coefficient @var{rho}. +## +## For two data vectors @var{x} and @var{y}, Spearman's @var{rho} is the +## correlation coefficient of the ranks of @var{x} and @var{y}. +## +## If @var{x} and @var{y} are drawn from independent distributions, +## @var{rho} has zero mean and variance @code{1 / (n - 1)}, and is +## asymptotically normally distributed. +## +## @code{spearman (@var{x})} is equivalent to @code{spearman (@var{x}, +## @var{x})}. +## @seealso{ranks, kendall} +## @end deftypefn + +## Author: KH +## Description: Spearman's rank correlation rho + +function rho = spearman (x, y = []) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if ( ! (isnumeric (x) || islogical (x)) + || ! (isnumeric (y) || islogical (y))) + error ("spearman: X and Y must be numeric matrices or vectors"); + endif + + if (ndims (x) != 2 || ndims (y) != 2) + error ("spearman: X and Y must be 2-D matrices or vectors"); + endif + + if (isrow (x)) + x = x.'; + endif + + if (nargin == 1) + rho = corr (ranks (x)); + else + if (isrow (y)) + y = y.'; + endif + if (rows (x) != rows (y)) + error ("spearman: X and Y must have the same number of observations"); + endif + rho = corr (ranks (x), ranks (y)); + endif + + ## Restore class cleared by ranks + if (isa (x, 'single') || isa (y, 'single')) + rho = single (rho); + endif + +endfunction + + +%!test +%! x = 1:10; +%! y = exp (x); +%! assert (spearman (x,y), 1, 5*eps); +%! assert (spearman (x,-y), -1, 5*eps); + +%!assert(spearman ([1 2 3], [-1 1 -2]), -0.5, 5*eps) + +%% Test input validation +%!error spearman (); +%!error spearman (1, 2, 3); +%!error spearman (['A'; 'B']); +%!error spearman (ones(1,2), {1, 2}); +%!error spearman (ones (2,2,2)); +%!error spearman (ones (2,2), ones (2,2,2)); +%!error spearman (ones (2,2), ones (3,2)); diff --git a/octave_packages/m/statistics/base/statistics.m b/octave_packages/m/statistics/base/statistics.m new file mode 100644 index 0000000..637135b --- /dev/null +++ b/octave_packages/m/statistics/base/statistics.m @@ -0,0 +1,89 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} statistics (@var{x}) +## @deftypefnx {Function File} {} statistics (@var{x}, @var{dim}) +## Return a vector with the minimum, first quartile, median, third quartile, +## maximum, mean, standard deviation, skewness, and kurtosis of the elements of +## the vector @var{x}. +## +## If @var{x} is a matrix, calculate statistics over the first +## non-singleton dimension. +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{min, max, median, mean, std, skewness, kurtosis} +## @end deftypefn + +## Author: KH +## Description: Compute basic statistics + +function stats = statistics (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("statistics: X must be a numeric vector or matrix"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin != 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("statistics: DIM must be an integer and a valid dimension"); + endif + endif + + if (sz(dim) < 2) + error ("statistics: dimension of X is too small (<2)"); + endif + + emp_inv = quantile (x, [0.25; 0.5; 0.75], dim, 7); + + stats = cat (dim, min (x, [], dim), emp_inv, max (x, [], dim), mean (x, dim), + std (x, [], dim), skewness (x, dim), kurtosis (x, dim)); + +endfunction + + +%!test +%! x = rand (7,5); +%! s = statistics (x); +%! assert (min (x), s(1,:), eps); +%! assert (median (x), s(3,:), eps); +%! assert (max (x), s(5,:), eps); +%! assert (mean (x), s(6,:), eps); +%! assert (std (x), s(7,:), eps); +%! assert (skewness (x), s(8,:), eps); +%! assert (kurtosis (x), s(9,:), eps); + +%% Test input validation +%!error statistics () +%!error statistics (1, 2, 3) +%!error statistics (['A'; 'B']) +%!error statistics (1, ones(2,2)) +%!error statistics (1, 1.5) +%!error statistics (1, 0) +%!error statistics (1, 3) +%!error statistics (1) + diff --git a/octave_packages/m/statistics/base/std.m b/octave_packages/m/statistics/base/std.m new file mode 100644 index 0000000..cee3a6c --- /dev/null +++ b/octave_packages/m/statistics/base/std.m @@ -0,0 +1,127 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} std (@var{x}) +## @deftypefnx {Function File} {} std (@var{x}, @var{opt}) +## @deftypefnx {Function File} {} std (@var{x}, @var{opt}, @var{dim}) +## Compute the standard deviation of the elements of the vector @var{x}. +## @tex +## $$ +## {\rm std} (x) = \sigma = \sqrt{{\sum_{i=1}^N (x_i - \bar{x})^2 \over N - 1}} +## $$ +## where $\bar{x}$ is the mean value of $x$ and $N$ is the number of elements. +## @end tex +## @ifnottex +## +## @example +## @group +## std (x) = sqrt ( 1/(N-1) SUM_i (x(i) - mean(x))^2 ) +## @end group +## @end example +## +## @noindent +## where @math{N} is the number of elements. +## @end ifnottex +## +## If @var{x} is a matrix, compute the standard deviation for +## each column and return them in a row vector. +## +## The argument @var{opt} determines the type of normalization to use. +## Valid values are +## +## @table @asis +## @item 0: +## normalize with @math{N-1}, provides the square root of the best unbiased +## estimator of the variance [default] +## +## @item 1: +## normalize with @math{N}, this provides the square root of the second +## moment around the mean +## @end table +## +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{var, range, iqr, mean, median} +## @end deftypefn + +## Author: jwe + +function retval = std (x, opt = 0, dim) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("std: X must be a numeric vector or matrix"); + endif + + if (isempty (opt)) + opt = 0; + endif + if (opt != 0 && opt != 1) + error ("std: normalization OPT must be 0 or 1"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 3) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("std: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + if (n == 1 || isempty (x)) + if (isa (x, 'single')) + retval = zeros (sz, 'single'); + else + retval = zeros (sz); + endif + else + retval = sqrt (sumsq (center (x, dim), dim) / (n - 1 + opt)); + endif + +endfunction + + +%!test +%! x = ones (10, 2); +%! y = [1, 3]; +%! assert(std (x) == [0, 0]); +%! assert(std (y), sqrt (2), sqrt (eps)); +%! assert(std (x, 0, 2), zeros (10, 1)); + +%!assert(std (ones (3, 1, 2), 0, 2), zeros (3, 1, 2)); +%!assert(std ([1 2], 0), sqrt(2)/2, 5*eps); +%!assert(std ([1 2], 1), 0.5, 5*eps); +%!assert(std(1), 0); +%!assert(std(single(1)), single(0)); +%!assert(std([]), []); +%!assert(std(ones (1,3,0,2)), ones (1,3,0,2)); + +%% Test input validation +%!error std (); +%!error std (1, 2, 3, 4); +%!error std (['A'; 'B']) +%!error std (1, -1); + diff --git a/octave_packages/m/statistics/base/table.m b/octave_packages/m/statistics/base/table.m new file mode 100644 index 0000000..81f7d09 --- /dev/null +++ b/octave_packages/m/statistics/base/table.m @@ -0,0 +1,73 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{t}, @var{l_x}] =} table (@var{x}) +## @deftypefnx {Function File} {[@var{t}, @var{l_x}, @var{l_y}] =} table (@var{x}, @var{y}) +## Create a contingency table @var{t} from data vectors. The @var{l_x} and +## @var{l_y} vectors are the corresponding levels. +## +## Currently, only 1- and 2-dimensional tables are supported. +## @end deftypefn + +## Author: KH +## Description: Cross tabulation + +function [t, v, w] = table (x, y) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1) + if (!isnumeric (x) || !isvector (x)) + error ("table: X must be a numeric vector"); + endif + v = unique (x); + for i = 1 : length (v) + t(i) = sum (x == v(i) | isnan (v(i)) * isnan (x)); + endfor + elseif (nargin == 2) + if (! ( isvector (x) && isnumeric (x) + && isvector (y) && isnumeric (y) + && (length (x) == length (y)))) + error ("table: X and Y must be numeric vectors of the same length"); + endif + v = unique (x); + w = unique (y); + for i = 1 : length (v) + for j = 1 : length (w) + t(i,j) = sum ((x == v(i) | isnan (v(i)) * isnan (x)) & + (y == w(j) | isnan (w(j)) * isnan (y))); + endfor + endfor + endif + +endfunction + + +%% Test input validation +%!error table () +%!error table (1, 2, 3) +%!error table (ones (2)) +%!error table ([true true]) +%!error table (ones (2,1), true (2,1)) +%!error table (true (2,1), ones (2,1)) +%!error table (ones (2,2), ones (2,1)) +%!error table (ones (2,1), ones (2,2)) +%!error table (ones (2,1), ones (3,1)) diff --git a/octave_packages/m/statistics/base/var.m b/octave_packages/m/statistics/base/var.m new file mode 100644 index 0000000..e050434 --- /dev/null +++ b/octave_packages/m/statistics/base/var.m @@ -0,0 +1,118 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} var (@var{x}) +## @deftypefnx {Function File} {} var (@var{x}, @var{opt}) +## @deftypefnx {Function File} {} var (@var{x}, @var{opt}, @var{dim}) +## Compute the variance of the elements of the vector @var{x}. +## @tex +## $$ +## {\rm var} (x) = \sigma^2 = {\sum_{i=1}^N (x_i - \bar{x})^2 \over N - 1} +## $$ +## where $\bar{x}$ is the mean value of $x$. +## @end tex +## @ifnottex +## +## @example +## @group +## var (x) = 1/(N-1) SUM_i (x(i) - mean(x))^2 +## @end group +## @end example +## +## @end ifnottex +## If @var{x} is a matrix, compute the variance for each column +## and return them in a row vector. +## +## The argument @var{opt} determines the type of normalization to use. +## Valid values are +## +## @table @asis +## @item 0: +## normalize with @math{N-1}, provides the best unbiased estimator of the +## variance [default] +## +## @item 1: +## normalizes with @math{N}, this provides the second moment around the mean +## @end table +## +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{cov, std, skewness, kurtosis, moment} +## @end deftypefn + +## Author: KH +## Description: Compute variance + +function retval = var (x, opt = 0, dim) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("var: X must be a numeric vector or matrix"); + endif + + if (isempty (opt)) + opt = 0; + endif + if (opt != 0 && opt != 1) + error ("var: normalization OPT must be 0 or 1"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin < 3) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("var: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + if (n == 1) + if (isa (x, 'single')) + retval = zeros (sz, 'single'); + else + retval = zeros (sz); + endif + elseif (numel (x) > 0) + retval = sumsq (center (x, dim), dim) / (n - 1 + opt); + else + error ("var: X must not be empty"); + endif + +endfunction + + +%!assert(var (13), 0); +%!assert(var (single(13)), single(0)); +%!assert(var ([1,2,3]), 1); +%!assert(var ([1,2,3], 1), 2/3, eps); +%!assert(var ([1,2,3], [], 1), [0,0,0]); + +%% Test input validation +%!error var () +%!error var (1,2,3,4) +%!error var (['A'; 'B']) +%!error var (1, -1); +%!error var ([],1) + diff --git a/octave_packages/m/statistics/base/zscore.m b/octave_packages/m/statistics/base/zscore.m new file mode 100644 index 0000000..7afbd13 --- /dev/null +++ b/octave_packages/m/statistics/base/zscore.m @@ -0,0 +1,84 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} zscore (@var{x}) +## @deftypefnx {Function File} {} zscore (@var{x}, @var{dim}) +## If @var{x} is a vector, subtract its mean and divide by its standard +## deviation. +## +## If @var{x} is a matrix, do the above along the first non-singleton +## dimension. +## If the optional argument @var{dim} is given, operate along this dimension. +## @seealso{center} +## @end deftypefn + +## Author: KH +## Description: Subtract mean and divide by standard deviation + +function z = zscore (x, dim) + + if (nargin != 1 && nargin != 2) + print_usage (); + endif + + if (! (isnumeric (x) || islogical (x))) + error ("zscore: X must be a numeric vector or matrix"); + endif + + nd = ndims (x); + sz = size (x); + if (nargin != 2) + ## Find the first non-singleton dimension. + (dim = find (sz > 1, 1)) || (dim = 1); + else + if (!(isscalar (dim) && dim == fix (dim)) + || !(1 <= dim && dim <= nd)) + error ("zscore: DIM must be an integer and a valid dimension"); + endif + endif + + n = sz(dim); + if (n == 0) + z = x; + else + x = center (x, dim); # center also promotes integer to double for next line + z = zeros (sz, class (x)); + s = std (x, [], dim); + s(s==0) = 1; + z = bsxfun (@rdivide, x, s); + endif + +endfunction + + +%!assert(zscore ([1,2,3]), [-1,0,1]) +%!assert(zscore (single([1,2,3])), single([-1,0,1])) +%!assert(zscore (int8([1,2,3])), [-1,0,1]) +%!assert(zscore (ones (3,2,2,2)), zeros (3,2,2,2)) +%!assert(zscore ([2,0,-2;0,2,0;-2,-2,2]), [1,0,-1;0,1,0;-1,-1,1]) + +%% Test input validation +%!error zscore () +%!error zscore (1, 2, 3) +%!error zscore (['A'; 'B']) +%!error zscore (1, ones(2,2)) +%!error zscore (1, 1.5) +%!error zscore (1, 0) +%!error zscore (1, 3) + diff --git a/octave_packages/m/statistics/distributions/betacdf.m b/octave_packages/m/statistics/distributions/betacdf.m new file mode 100644 index 0000000..59c41ae --- /dev/null +++ b/octave_packages/m/statistics/distributions/betacdf.m @@ -0,0 +1,93 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} betacdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the Beta distribution with parameters @var{a} and +## @var{b}. +## @end deftypefn + +## Author: KH +## Description: CDF of the Beta distribution + +function cdf = betacdf (x, a, b) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("betacdf: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betacdf: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(a > 0) | !(b > 0); + cdf(k) = NaN; + + k = (x >= 1) & (a > 0) & (b > 0); + cdf(k) = 1; + + k = (x > 0) & (x < 1) & (a > 0) & (b > 0); + if (isscalar (a) && isscalar (b)) + cdf(k) = betainc (x(k), a, b); + else + cdf(k) = betainc (x(k), a(k), b(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 0 0.75 1 1]; +%!assert(betacdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(betacdf (x, 1, 2*ones(1,5)), y); +%!assert(betacdf (x, ones(1,5), 2), y); +%!assert(betacdf (x, [0 1 NaN 1 1], 2), [NaN 0 NaN 1 1]); +%!assert(betacdf (x, 1, 2*[0 1 NaN 1 1]), [NaN 0 NaN 1 1]); +%!assert(betacdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(betacdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(betacdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(betacdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(betacdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error betacdf () +%!error betacdf (1) +%!error betacdf (1,2) +%!error betacdf (1,2,3,4) +%!error betacdf (ones(3),ones(2),ones(2)) +%!error betacdf (ones(2),ones(3),ones(2)) +%!error betacdf (ones(2),ones(2),ones(3)) + diff --git a/octave_packages/m/statistics/distributions/betainv.m b/octave_packages/m/statistics/distributions/betainv.m new file mode 100644 index 0000000..d0e442b --- /dev/null +++ b/octave_packages/m/statistics/distributions/betainv.m @@ -0,0 +1,136 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} betainv (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the Beta distribution with parameters @var{a} +## and @var{b}. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the Beta distribution + +function inv = betainv (x, a, b) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("betainv: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betainv: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); + endif + + k = (x < 0) | (x > 1) | !(a > 0) | !(b > 0) | isnan (x); + inv(k) = NaN; + + k = (x == 1) & (a > 0) & (b > 0); + inv(k) = 1; + + k = find ((x > 0) & (x < 1) & (a > 0) & (b > 0)); + if (any (k)) + if (!isscalar (a) || !isscalar (b)) + a = a(k); + b = b(k); + y = a ./ (a + b); + else + y = a / (a + b) * ones (size (k)); + endif + x = x(k); + + if (isa (y, "single")) + myeps = eps ("single"); + else + myeps = eps; + endif + + l = find (y < myeps); + if (any (l)) + y(l) = sqrt (myeps) * ones (length (l), 1); + endif + l = find (y > 1 - myeps); + if (any (l)) + y(l) = 1 - sqrt (myeps) * ones (length (l), 1); + endif + + y_old = y; + for i = 1 : 10000 + h = (betacdf (y_old, a, b) - x) ./ betapdf (y_old, a, b); + y_new = y_old - h; + ind = find (y_new <= myeps); + if (any (ind)) + y_new (ind) = y_old (ind) / 10; + endif + ind = find (y_new >= 1 - myeps); + if (any (ind)) + y_new (ind) = 1 - (1 - y_old (ind)) / 10; + endif + h = y_old - y_new; + if (max (abs (h)) < sqrt (myeps)) + break; + endif + y_old = y_new; + endfor + + inv(k) = y_new; + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.75 1 2]; +%!assert(betainv (x, ones(1,5), 2*ones(1,5)), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, 1, 2*ones(1,5)), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, ones(1,5), 2), [NaN 0 0.5 1 NaN]); +%!assert(betainv (x, [1 0 NaN 1 1], 2), [NaN NaN NaN 1 NaN]); +%!assert(betainv (x, 1, 2*[1 0 NaN 1 1]), [NaN NaN NaN 1 NaN]); +%!assert(betainv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 0 NaN 1 NaN]); + +%% Test class of input preserved +%!assert(betainv ([x, NaN], 1, 2), [NaN 0 0.5 1 NaN NaN]); +%!assert(betainv (single([x, NaN]), 1, 2), single([NaN 0 0.5 1 NaN NaN])); +%!assert(betainv ([x, NaN], single(1), 2), single([NaN 0 0.5 1 NaN NaN])); +%!assert(betainv ([x, NaN], 1, single(2)), single([NaN 0 0.5 1 NaN NaN])); + +%% Test input validation +%!error betainv () +%!error betainv (1) +%!error betainv (1,2) +%!error betainv (1,2,3,4) +%!error betainv (ones(3),ones(2),ones(2)) +%!error betainv (ones(2),ones(3),ones(2)) +%!error betainv (ones(2),ones(2),ones(3)) +%!error betainv (i, 2, 2) +%!error betainv (2, i, 2) +%!error betainv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/betapdf.m b/octave_packages/m/statistics/distributions/betapdf.m new file mode 100644 index 0000000..17d35ca --- /dev/null +++ b/octave_packages/m/statistics/distributions/betapdf.m @@ -0,0 +1,130 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## Copyright (C) 2010 Christos Dimitrakakis +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} betapdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the probability density function (PDF) +## at @var{x} of the Beta distribution with parameters @var{a} and @var{b}. +## @end deftypefn + +## Author: KH , CD +## Description: PDF of the Beta distribution + +function pdf = betapdf (x, a, b) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("betapdf: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("betapdf: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")); + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = !(a > 0) | !(b > 0) | isnan (x); + pdf(k) = NaN; + + k = (x > 0) & (x < 1) & (a > 0) & (b > 0) & ((a != 1) | (b != 1)); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp ((a - 1) * log (x(k)) + + (b - 1) * log (1 - x(k)) + + lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp ((a(k) - 1) .* log (x(k)) + + (b(k) - 1) .* log (1 - x(k)) + + lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); + endif + + ## Most important special cases when the density is finite. + k = (x == 0) & (a == 1) & (b > 0) & (b != 1); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp (lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); + endif + + k = (x == 1) & (b == 1) & (a > 0) & (a != 1); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (lgamma (a + b) - lgamma (a) - lgamma (b)); + else + pdf(k) = exp (lgamma (a(k) + b(k)) - lgamma (a(k)) - lgamma (b(k))); + endif + + k = (x >= 0) & (x <= 1) & (a == 1) & (b == 1); + pdf(k) = 1; + + ## Other special case when the density at the boundary is infinite. + k = (x == 0) & (a < 1); + pdf(k) = Inf; + + k = (x == 1) & (b < 1); + pdf(k) = Inf; + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 2 1 0 0]; +%!assert(betapdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(betapdf (x, 1, 2*ones(1,5)), y); +%!assert(betapdf (x, ones(1,5), 2), y); +%!assert(betapdf (x, [0 NaN 1 1 1], 2), [NaN NaN y(3:5)]); +%!assert(betapdf (x, 1, 2*[0 NaN 1 1 1]), [NaN NaN y(3:5)]); +%!assert(betapdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(betapdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(betapdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(betapdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Beta (1/2,1/2) == arcsine distribution +%!test +%! x = rand (10,1); +%! y = 1./(pi * sqrt (x.*(1-x))); +%! assert(betapdf (x, 1/2, 1/2), y, 50*eps); + +%% Test large input values to betapdf +%!assert (betapdf(0.5, 1000, 1000), 35.678, 1e-3) + +%% Test input validation +%!error betapdf () +%!error betapdf (1) +%!error betapdf (1,2) +%!error betapdf (1,2,3,4) +%!error betapdf (ones(3),ones(2),ones(2)) +%!error betapdf (ones(2),ones(3),ones(2)) +%!error betapdf (ones(2),ones(2),ones(3)) +%!error betapdf (i, 2, 2) +%!error betapdf (2, i, 2) +%!error betapdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/betarnd.m b/octave_packages/m/statistics/distributions/betarnd.m new file mode 100644 index 0000000..6cf1e92 --- /dev/null +++ b/octave_packages/m/statistics/distributions/betarnd.m @@ -0,0 +1,137 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} betarnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} betarnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the Beta distribution with parameters +## @var{a} and @var{b}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the Beta distribution + +function rnd = betarnd (a, b, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("betarnd: A and B must be of common size or scalars"); + endif + endif + + if (iscomplex (a) || iscomplex (b)) + error ("betarnd: A and B must not be complex"); + endif + + if (nargin == 2) + sz = size (a); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("betarnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("betarnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (a) && !isequal (size (a), sz)) + error ("betarnd: A and B must be scalar or of size SZ"); + endif + + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((a > 0) && (a < Inf) && (b > 0) && (b < Inf)) + r = randg (a, sz); + rnd = r ./ (r + randg (b, sz)); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + r = randg (a(k)); + rnd(k) = r ./ (r + randg (b(k))); + endif + +endfunction + + +%!assert(size (betarnd (1,2)), [1, 1]); +%!assert(size (betarnd (ones(2,1), 2)), [2, 1]); +%!assert(size (betarnd (ones(2,2), 2)), [2, 2]); +%!assert(size (betarnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (betarnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (betarnd (1, 2, 3)), [3, 3]); +%!assert(size (betarnd (1, 2, [4 1])), [4, 1]); +%!assert(size (betarnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (betarnd (1, 2)), "double"); +%!assert(class (betarnd (single(1), 2)), "single"); +%!assert(class (betarnd (single([1 1]), 2)), "single"); +%!assert(class (betarnd (1, single(2))), "single"); +%!assert(class (betarnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error betarnd () +%!error betarnd (1) +%!error betarnd (ones(3),ones(2)) +%!error betarnd (ones(2),ones(3)) +%!error betarnd (i, 2) +%!error betarnd (2, i) +%!error betarnd (1,2, -1) +%!error betarnd (1,2, ones(2)) +%!error binornd (1,2, [2 -1 2]) +%!error betarnd (1,2, 1, ones(2)) +%!error betarnd (1,2, 1, -1) +%!error betarnd (ones(2,2), 2, 3) +%!error betarnd (ones(2,2), 2, [3, 2]) +%!error betarnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/binocdf.m b/octave_packages/m/statistics/distributions/binocdf.m new file mode 100644 index 0000000..cb7cf4d --- /dev/null +++ b/octave_packages/m/statistics/distributions/binocdf.m @@ -0,0 +1,98 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} binocdf (@var{x}, @var{n}, @var{p}) +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the binomial distribution with parameters @var{n} and +## @var{p}, where @var{n} is the number of trials and @var{p} is the +## probability of success. +## @end deftypefn + +## Author: KH +## Description: CDF of the binomial distribution + +function cdf = binocdf (x, n, p) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, x, n, p] = common_size (x, n, p); + if (retval > 0) + error ("binocdf: X, N, and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binocdf: X, N, and P must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(n >= 0) | (n != fix (n)) | !(p >= 0) | !(p <= 1); + cdf(k) = NaN; + + k = (x >= n) & (n >= 0) & (n == fix (n) & (p >= 0) & (p <= 1)); + cdf(k) = 1; + + k = (x >= 0) & (x < n) & (n == fix (n)) & (p >= 0) & (p <= 1); + tmp = floor (x(k)); + if (isscalar (n) && isscalar (p)) + cdf(k) = 1 - betainc (p, tmp + 1, n - tmp); + else + cdf(k) = 1 - betainc (p(k), tmp + 1, n(k) - tmp); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/4 3/4 1 1]; +%!assert(binocdf (x, 2*ones(1,5), 0.5*ones(1,5)), y); +%!assert(binocdf (x, 2, 0.5*ones(1,5)), y); +%!assert(binocdf (x, 2*ones(1,5), 0.5), y); +%!assert(binocdf (x, 2*[0 -1 NaN 1.1 1], 0.5), [0 NaN NaN NaN 1]); +%!assert(binocdf (x, 2, 0.5*[0 -1 NaN 3 1]), [0 NaN NaN NaN 1]); +%!assert(binocdf ([x(1:2) NaN x(4:5)], 2, 0.5), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(binocdf ([x, NaN], 2, 0.5), [y, NaN]); +%!assert(binocdf (single([x, NaN]), 2, 0.5), single([y, NaN])); +%!assert(binocdf ([x, NaN], single(2), 0.5), single([y, NaN])); +%!assert(binocdf ([x, NaN], 2, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error binocdf () +%!error binocdf (1) +%!error binocdf (1,2) +%!error binocdf (1,2,3,4) +%!error binocdf (ones(3),ones(2),ones(2)) +%!error binocdf (ones(2),ones(3),ones(2)) +%!error binocdf (ones(2),ones(2),ones(3)) +%!error binocdf (i, 2, 2) +%!error binocdf (2, i, 2) +%!error binocdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/binoinv.m b/octave_packages/m/statistics/distributions/binoinv.m new file mode 100644 index 0000000..453ccb8 --- /dev/null +++ b/octave_packages/m/statistics/distributions/binoinv.m @@ -0,0 +1,115 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} binoinv (@var{x}, @var{n}, @var{p}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the binomial distribution with parameters +## @var{n} and @var{p}, where @var{n} is the number of trials and +## @var{p} is the probability of success. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the binomial distribution + +function inv = binoinv (x, n, p) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, x, n, p] = common_size (x, n, p); + if (retval > 0) + error ("binoinv: X, N, and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binoinv: X, N, and P must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); + endif + + k = (!(x >= 0) | !(x <= 1) | !(n >= 0) | (n != fix (n)) | + !(p >= 0) | !(p <= 1)); + inv(k) = NaN; + + k = find ((x >= 0) & (x <= 1) & (n >= 0) & (n == fix (n) + & (p >= 0) & (p <= 1))); + if (any (k)) + if (isscalar (n) && isscalar (p)) + cdf = binopdf (0, n, p) * ones (size (k)); + while (any (inv(k) < n)) + m = find (cdf < x(k)); + if (any (m)) + inv(k(m)) = inv(k(m)) + 1; + cdf(m) = cdf(m) + binopdf (inv(k(m)), n, p); + else + break; + endif + endwhile + else + cdf = binopdf (0, n(k), p(k)); + while (any (inv(k) < n(k))) + m = find (cdf < x(k)); + if (any (m)) + inv(k(m)) = inv(k(m)) + 1; + cdf(m) = cdf(m) + binopdf (inv(k(m)), n(k(m)), p(k(m))); + else + break; + endif + endwhile + endif + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(binoinv (x, 2*ones(1,5), 0.5*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2, 0.5*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2*ones(1,5), 0.5), [NaN 0 1 2 NaN]); +%!assert(binoinv (x, 2*[0 -1 NaN 1.1 1], 0.5), [NaN NaN NaN NaN NaN]); +%!assert(binoinv (x, 2, 0.5*[0 -1 NaN 3 1]), [NaN NaN NaN NaN NaN]); +%!assert(binoinv ([x(1:2) NaN x(4:5)], 2, 0.5), [NaN 0 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(binoinv ([x, NaN], 2, 0.5), [NaN 0 1 2 NaN NaN]); +%!assert(binoinv (single([x, NaN]), 2, 0.5), single([NaN 0 1 2 NaN NaN])); +%!assert(binoinv ([x, NaN], single(2), 0.5), single([NaN 0 1 2 NaN NaN])); +%!assert(binoinv ([x, NaN], 2, single(0.5)), single([NaN 0 1 2 NaN NaN])); + +%% Test input validation +%!error binoinv () +%!error binoinv (1) +%!error binoinv (1,2) +%!error binoinv (1,2,3,4) +%!error binoinv (ones(3),ones(2),ones(2)) +%!error binoinv (ones(2),ones(3),ones(2)) +%!error binoinv (ones(2),ones(2),ones(3)) +%!error binoinv (i, 2, 2) +%!error binoinv (2, i, 2) +%!error binoinv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/binopdf.m b/octave_packages/m/statistics/distributions/binopdf.m new file mode 100644 index 0000000..66eeb3f --- /dev/null +++ b/octave_packages/m/statistics/distributions/binopdf.m @@ -0,0 +1,101 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} binopdf (@var{x}, @var{n}, @var{p}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the binomial distribution with parameters @var{n} +## and @var{p}, where @var{n} is the number of trials and @var{p} is the +## probability of success. +## @end deftypefn + +## Author: KH +## Description: PDF of the binomial distribution + +function pdf = binopdf (x, n, p) + + if (nargin != 3) + print_usage (); + endif + + if (! isscalar (n) || ! isscalar (p)) + [retval, x, n, p] = common_size (x, n, p); + if (retval > 0) + error ("binopdf: X, N, and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("binopdf: X, N, and P must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single") || isa (p, "single")); + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = (x == fix (x)) & (n == fix (n)) & (n >= 0) & (p >= 0) & (p <= 1); + + pdf(! k) = NaN; + + k &= ((x >= 0) & (x <= n)); + if (isscalar (n) && isscalar (p)) + pdf(k) = exp (gammaln (n+1) - gammaln (x(k)+1) - gammaln (n-x(k)+1) + + x(k)*log (p) + (n-x(k))*log (1-p)); + else + pdf(k) = exp (gammaln (n(k)+1) - gammaln (x(k)+1) - gammaln (n(k)-x(k)+1) + + x(k).*log (p(k)) + (n(k)-x(k)).*log (1-p(k))); + endif + +endfunction + + +%!shared x,y,tol +%! if (ismac ()) +%! tol = eps (); +%! else +%! tol = 0; +%! endif +%! x = [-1 0 1 2 3]; +%! y = [0 1/4 1/2 1/4 0]; +%!assert(binopdf (x, 2*ones(1,5), 0.5*ones(1,5)), y, tol); +%!assert(binopdf (x, 2, 0.5*ones(1,5)), y, tol); +%!assert(binopdf (x, 2*ones(1,5), 0.5), y, tol); +%!assert(binopdf (x, 2*[0 -1 NaN 1.1 1], 0.5), [0 NaN NaN NaN 0]); +%!assert(binopdf (x, 2, 0.5*[0 -1 NaN 3 1]), [0 NaN NaN NaN 0]); +%!assert(binopdf ([x, NaN], 2, 0.5), [y, NaN], tol); + +%% Test class of input preserved +%!assert(binopdf (single([x, NaN]), 2, 0.5), single([y, NaN])); +%!assert(binopdf ([x, NaN], single(2), 0.5), single([y, NaN])); +%!assert(binopdf ([x, NaN], 2, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error binopdf () +%!error binopdf (1) +%!error binopdf (1,2) +%!error binopdf (1,2,3,4) +%!error binopdf (ones(3),ones(2),ones(2)) +%!error binopdf (ones(2),ones(3),ones(2)) +%!error binopdf (ones(2),ones(2),ones(3)) +%!error binopdf (i, 2, 2) +%!error binopdf (2, i, 2) +%!error binopdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/binornd.m b/octave_packages/m/statistics/distributions/binornd.m new file mode 100644 index 0000000..c79eee8 --- /dev/null +++ b/octave_packages/m/statistics/distributions/binornd.m @@ -0,0 +1,154 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} binornd (@var{n}, @var{p}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} binornd (@var{n}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the binomial distribution with +## parameters @var{n} and @var{p}, where @var{n} is the number of trials +## and @var{p} is the probability of success. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{n} and @var{p}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the binomial distribution + +function rnd = binornd (n, p, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, n, p] = common_size (n, p); + if (retval > 0) + error ("binornd: N and P must be of common size or scalars"); + endif + endif + + if (iscomplex (n) || iscomplex (p)) + error ("binornd: N and P must not be complex"); + endif + + if (nargin == 2) + sz = size (n); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("binornd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("binornd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("binornd: N and P must be scalar or of size SZ"); + endif + + if (isa (n, "single") || isa (p, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n) && isscalar (p)) + if ((n > 0) && (n < Inf) && (n == fix (n)) && (p >= 0) && (p <= 1)) + nel = prod (sz); + tmp = rand (n, nel); + rnd = sum (tmp < p, 1); + rnd = reshape (rnd, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + elseif ((n == 0) && (p >= 0) && (p <= 1)) + rnd = zeros (sz, cls); + else + rnd = NaN (sz, cls); + endif + else + rnd = zeros (sz, cls); + + k = !(n >= 0) | !(n < Inf) | !(n == fix (n)) | !(p >= 0) | !(p <= 1); + rnd(k) = NaN; + + k = (n > 0) & (n < Inf) & (n == fix (n)) & (p >= 0) & (p <= 1); + if (any (k(:))) + N = max (n(k)); + L = sum (k(:)); + tmp = rand (N, L); + ind = repmat ((1 : N)', 1, L); + rnd(k) = sum ((tmp < repmat (p(k)(:)', N, 1)) & + (ind <= repmat (n(k)(:)', N, 1)), 1); + endif + endif + +endfunction + + +%!assert (binornd (0, 0, 1), 0) +%!assert (binornd ([0, 0], [0, 0], 1, 2), [0, 0]) + +%!assert(size (binornd (2, 1/2)), [1, 1]); +%!assert(size (binornd (2*ones(2,1), 1/2)), [2, 1]); +%!assert(size (binornd (2*ones(2,2), 1/2)), [2, 2]); +%!assert(size (binornd (2, 1/2*ones(2,1))), [2, 1]); +%!assert(size (binornd (2, 1/2*ones(2,2))), [2, 2]); +%!assert(size (binornd (2, 1/2, 3)), [3, 3]); +%!assert(size (binornd (2, 1/2, [4 1])), [4, 1]); +%!assert(size (binornd (2, 1/2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (binornd (2, 0.5)), "double"); +%!assert(class (binornd (single(2), 0.5)), "single"); +%!assert(class (binornd (single([2 2]), 0.5)), "single"); +%!assert(class (binornd (2, single(0.5))), "single"); +%!assert(class (binornd (2, single([0.5 0.5]))), "single"); + +%% Test input validation +%!error binornd () +%!error binornd (1) +%!error binornd (ones(3),ones(2)) +%!error binornd (ones(2),ones(3)) +%!error binornd (i, 2) +%!error binornd (2, i) +%!error binornd (1,2, -1) +%!error binornd (1,2, ones(2)) +%!error binornd (1,2, [2 -1 2]) +%!error binornd (1,2, 1, ones(2)) +%!error binornd (1,2, 1, -1) +%!error binornd (ones(2,2), 2, 3) +%!error binornd (ones(2,2), 2, [3, 2]) +%!error binornd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/cauchy_cdf.m b/octave_packages/m/statistics/distributions/cauchy_cdf.m new file mode 100644 index 0000000..fbb61a6 --- /dev/null +++ b/octave_packages/m/statistics/distributions/cauchy_cdf.m @@ -0,0 +1,91 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cauchy_cdf (@var{x}) +## @deftypefnx {Function File} {} cauchy_cdf (@var{x}, @var{location}, @var{scale}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the Cauchy distribution with location +## parameter @var{location} and scale parameter @var{scale}. Default +## values are @var{location} = 0, @var{scale} = 1. +## @end deftypefn + +## Author: KH +## Description: CDF of the Cauchy distribution + +function cdf = cauchy_cdf (x, location = 0, scale = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (location) || !isscalar (scale)) + [retval, x, location, scale] = common_size (x, location, scale); + if (retval > 0) + error ("cauchy_cdf: X, LOCATION, and SCALE must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_cdf: X, LOCATION, and SCALE must not be complex"); + endif + + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")); + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); + endif + + k = !isinf (location) & (scale > 0) & (scale < Inf); + if (isscalar (location) && isscalar (scale)) + cdf = 0.5 + atan ((x - location) / scale) / pi; + else + cdf(k) = 0.5 + atan ((x(k) - location(k)) ./ scale(k)) / pi; + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = 1/pi * atan ((x-1) / 2) + 1/2; +%!assert(cauchy_cdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(cauchy_cdf (x, 1, 2*ones(1,5)), y); +%!assert(cauchy_cdf (x, ones(1,5), 2), y); +%!assert(cauchy_cdf (x, [-Inf 1 NaN 1 Inf], 2), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_cdf (x, 1, 2*[0 1 NaN 1 Inf]), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_cdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(cauchy_cdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(cauchy_cdf (single([x, NaN]), 1, 2), single([y, NaN]), eps("single")); +%!assert(cauchy_cdf ([x, NaN], single(1), 2), single([y, NaN]), eps("single")); +%!assert(cauchy_cdf ([x, NaN], 1, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error cauchy_cdf () +%!error cauchy_cdf (1,2) +%!error cauchy_cdf (1,2,3,4) +%!error cauchy_cdf (ones(3),ones(2),ones(2)) +%!error cauchy_cdf (ones(2),ones(3),ones(2)) +%!error cauchy_cdf (ones(2),ones(2),ones(3)) +%!error cauchy_cdf (i, 2, 2) +%!error cauchy_cdf (2, i, 2) +%!error cauchy_cdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/cauchy_inv.m b/octave_packages/m/statistics/distributions/cauchy_inv.m new file mode 100644 index 0000000..37e3ce1 --- /dev/null +++ b/octave_packages/m/statistics/distributions/cauchy_inv.m @@ -0,0 +1,98 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cauchy_inv (@var{x}) +## @deftypefnx {Function File} {} cauchy_inv (@var{x}, @var{location}, @var{scale}) +## For each element of @var{x}, compute the quantile (the inverse of the +## CDF) at @var{x} of the Cauchy distribution with location parameter +## @var{location} and scale parameter @var{scale}. Default values are +## @var{location} = 0, @var{scale} = 1. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the Cauchy distribution + +function inv = cauchy_inv (x, location = 0, scale = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (location) || !isscalar (scale)) + [retval, x, location, scale] = common_size (x, location, scale); + if (retval > 0) + error ("cauchy_inv: X, LOCATION, and SCALE must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_inv: X, LOCATION, and SCALE must not be complex"); + endif + + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + ok = !isinf (location) & (scale > 0) & (scale < Inf); + + k = (x == 0) & ok; + inv(k) = -Inf; + + k = (x == 1) & ok; + inv(k) = Inf; + + k = (x > 0) & (x < 1) & ok; + if (isscalar (location) && isscalar (scale)) + inv(k) = location - scale * cot (pi * x(k)); + else + inv(k) = location(k) - scale(k) .* cot (pi * x(k)); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(cauchy_inv (x, ones(1,5), 2*ones(1,5)), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, 1, 2*ones(1,5)), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, ones(1,5), 2), [NaN -Inf 1 Inf NaN], eps); +%!assert(cauchy_inv (x, [1 -Inf NaN Inf 1], 2), [NaN NaN NaN NaN NaN]); +%!assert(cauchy_inv (x, 1, 2*[1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(cauchy_inv ([x(1:2) NaN x(4:5)], 1, 2), [NaN -Inf NaN Inf NaN]); + +%% Test class of input preserved +%!assert(cauchy_inv ([x, NaN], 1, 2), [NaN -Inf 1 Inf NaN NaN], eps); +%!assert(cauchy_inv (single([x, NaN]), 1, 2), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); +%!assert(cauchy_inv ([x, NaN], single(1), 2), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); +%!assert(cauchy_inv ([x, NaN], 1, single(2)), single([NaN -Inf 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error cauchy_inv () +%!error cauchy_inv (1,2) +%!error cauchy_inv (1,2,3,4) +%!error cauchy_inv (ones(3),ones(2),ones(2)) +%!error cauchy_inv (ones(2),ones(3),ones(2)) +%!error cauchy_inv (ones(2),ones(2),ones(3)) +%!error cauchy_inv (i, 2, 2) +%!error cauchy_inv (2, i, 2) +%!error cauchy_inv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/cauchy_pdf.m b/octave_packages/m/statistics/distributions/cauchy_pdf.m new file mode 100644 index 0000000..72406f8 --- /dev/null +++ b/octave_packages/m/statistics/distributions/cauchy_pdf.m @@ -0,0 +1,97 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cauchy_pdf (@var{x}) +## @deftypefnx {Function File} {} cauchy_pdf (@var{x}, @var{location}, @var{scale}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the Cauchy distribution with location parameter +## @var{location} and scale parameter @var{scale} > 0. Default values are +## @var{location} = 0, @var{scale} = 1. +## @end deftypefn + +## Author: KH +## Description: PDF of the Cauchy distribution + +function pdf = cauchy_pdf (x, location = 0, scale = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (location) || !isscalar (scale)) + [retval, x, location, scale] = common_size (x, location, scale); + if (retval > 0) + error ("cauchy_pdf: X, LOCATION, and SCALE must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (location) || iscomplex (scale)) + error ("cauchy_pdf: X, LOCATION, and SCALE must not be complex"); + endif + + if (isa (x, "single") || isa (location, "single") || isa (scale, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); + endif + + k = !isinf (location) & (scale > 0) & (scale < Inf); + if (isscalar (location) && isscalar (scale)) + pdf = ((1 ./ (1 + ((x - location) / scale) .^ 2)) + / pi / scale); + else + pdf(k) = ((1 ./ (1 + ((x(k) - location(k)) ./ scale(k)) .^ 2)) + / pi ./ scale(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = 1/pi * ( 2 ./ ((x-1).^2 + 2^2) ); +%!assert(cauchy_pdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(cauchy_pdf (x, 1, 2*ones(1,5)), y); +%!assert(cauchy_pdf (x, ones(1,5), 2), y); +%!assert(cauchy_pdf (x, [-Inf 1 NaN 1 Inf], 2), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_pdf (x, 1, 2*[0 1 NaN 1 Inf]), [NaN y(2) NaN y(4) NaN]); +%!assert(cauchy_pdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(cauchy_pdf (single([x, NaN]), 1, 2), single([y, NaN]), eps("single")); +%!assert(cauchy_pdf ([x, NaN], single(1), 2), single([y, NaN]), eps("single")); +%!assert(cauchy_pdf ([x, NaN], 1, single(2)), single([y, NaN]), eps("single")); + +%% Cauchy (0,1) == Student's T distribution with 1 DOF +%!test +%! x = rand (10, 1); +%! assert(cauchy_pdf (x, 0, 1), tpdf (x, 1), eps); + +%% Test input validation +%!error cauchy_pdf () +%!error cauchy_pdf (1,2) +%!error cauchy_pdf (1,2,3,4) +%!error cauchy_pdf (ones(3),ones(2),ones(2)) +%!error cauchy_pdf (ones(2),ones(3),ones(2)) +%!error cauchy_pdf (ones(2),ones(2),ones(3)) +%!error cauchy_pdf (i, 2, 2) +%!error cauchy_pdf (2, i, 2) +%!error cauchy_pdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/cauchy_rnd.m b/octave_packages/m/statistics/distributions/cauchy_rnd.m new file mode 100644 index 0000000..7aff7c5 --- /dev/null +++ b/octave_packages/m/statistics/distributions/cauchy_rnd.m @@ -0,0 +1,132 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cauchy_rnd (@var{location}, @var{scale}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{r}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} cauchy_rnd (@var{location}, @var{scale}, [@var{sz}]) +## Return a matrix of random samples from the Cauchy distribution with +## parameters @var{location} and @var{scale}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{location} and @var{scale}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the Cauchy distribution + +function rnd = cauchy_rnd (location, scale, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (location) || !isscalar (scale)) + [retval, location, scale] = common_size (location, scale); + if (retval > 0) + error ("cauchy_rnd: LOCATION and SCALE must be of common size or scalars"); + endif + endif + + if (iscomplex (location) || iscomplex (scale)) + error ("cauchy_rnd: LOCATION and SCALE must not be complex"); + endif + + if (nargin == 2) + sz = size (location); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("cauchy_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("cauchy_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (location) && !isequal (size (location), sz)) + error ("cauchy_rnd: LOCATION and SCALE must be scalar or of size SZ"); + endif + + if (isa (location, "single") || isa (scale, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (location) && isscalar (scale)) + if (!isinf (location) && (scale > 0) && (scale < Inf)) + rnd = location - cot (pi * rand (sz)) * scale; + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = !isinf (location) & (scale > 0) & (scale < Inf); + rnd(k) = location(k)(:) - cot (pi * rand (sum (k(:)), 1)) .* scale(k)(:); + endif + +endfunction + + +%!assert(size (cauchy_rnd (1,2)), [1, 1]); +%!assert(size (cauchy_rnd (ones(2,1), 2)), [2, 1]); +%!assert(size (cauchy_rnd (ones(2,2), 2)), [2, 2]); +%!assert(size (cauchy_rnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (cauchy_rnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (cauchy_rnd (1, 2, 3)), [3, 3]); +%!assert(size (cauchy_rnd (1, 2, [4 1])), [4, 1]); +%!assert(size (cauchy_rnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (cauchy_rnd (1, 2)), "double"); +%!assert(class (cauchy_rnd (single(1), 2)), "single"); +%!assert(class (cauchy_rnd (single([1 1]), 2)), "single"); +%!assert(class (cauchy_rnd (1, single(2))), "single"); +%!assert(class (cauchy_rnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error cauchy_rnd () +%!error cauchy_rnd (1) +%!error cauchy_rnd (ones(3),ones(2)) +%!error cauchy_rnd (ones(2),ones(3)) +%!error cauchy_rnd (i, 2) +%!error cauchy_rnd (2, i) +%!error cauchy_rnd (1,2, -1) +%!error cauchy_rnd (1,2, ones(2)) +%!error cauchy_rnd (1,2, [2 -1 2]) +%!error cauchy_rnd (1,2, 1, ones(2)) +%!error cauchy_rnd (1,2, 1, -1) +%!error cauchy_rnd (ones(2,2), 2, 3) +%!error cauchy_rnd (ones(2,2), 2, [3, 2]) +%!error cauchy_rnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/chi2cdf.m b/octave_packages/m/statistics/distributions/chi2cdf.m new file mode 100644 index 0000000..d178435 --- /dev/null +++ b/octave_packages/m/statistics/distributions/chi2cdf.m @@ -0,0 +1,73 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} chi2cdf (@var{x}, @var{n}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the chi-square distribution with @var{n} +## degrees of freedom. +## @end deftypefn + +## Author: TT +## Description: CDF of the chi-square distribution + +function cdf = chi2cdf (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("chi2cdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("chi2cdf: X and N must not be complex"); + endif + + cdf = gamcdf (x, n/2, 2); + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0, 1 - exp(-x(2:end)/2)]; +%!assert(chi2cdf (x, 2*ones(1,5)), y, eps); +%!assert(chi2cdf (x, 2), y, eps); +%!assert(chi2cdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)], eps); +%!assert(chi2cdf ([x(1:2) NaN x(4:5)], 2), [y(1:2) NaN y(4:5)], eps); + +%% Test class of input preserved +%!assert(chi2cdf ([x, NaN], 2), [y, NaN], eps); +%!assert(chi2cdf (single([x, NaN]), 2), single([y, NaN]), eps("single")); +%!assert(chi2cdf ([x, NaN], single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error chi2cdf () +%!error chi2cdf (1) +%!error chi2cdf (1,2,3) +%!error chi2cdf (ones(3),ones(2)) +%!error chi2cdf (ones(2),ones(3)) +%!error chi2cdf (i, 2) +%!error chi2cdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/chi2inv.m b/octave_packages/m/statistics/distributions/chi2inv.m new file mode 100644 index 0000000..ec4f83a --- /dev/null +++ b/octave_packages/m/statistics/distributions/chi2inv.m @@ -0,0 +1,72 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} chi2inv (@var{x}, @var{n}) +## For each element of @var{x}, compute the quantile (the inverse of the +## CDF) at @var{x} of the chi-square distribution with @var{n} degrees of +## freedom. +## @end deftypefn + +## Author: TT +## Description: Quantile function of the chi-square distribution + +function inv = chi2inv (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("chi2inv: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("chi2inv: X and N must not be complex"); + endif + + inv = gaminv (x, n/2, 2); + +endfunction + + +%!shared x +%! x = [-1 0 0.3934693402873666 1 2]; +%!assert(chi2inv (x, 2*ones(1,5)), [NaN 0 1 Inf NaN], 5*eps); +%!assert(chi2inv (x, 2), [NaN 0 1 Inf NaN], 5*eps); +%!assert(chi2inv (x, 2*[0 1 NaN 1 1]), [NaN 0 NaN Inf NaN], 5*eps); +%!assert(chi2inv ([x(1:2) NaN x(4:5)], 2), [NaN 0 NaN Inf NaN], 5*eps); + +%% Test class of input preserved +%!assert(chi2inv ([x, NaN], 2), [NaN 0 1 Inf NaN NaN], 5*eps); +%!assert(chi2inv (single([x, NaN]), 2), single([NaN 0 1 Inf NaN NaN]), 5*eps("single")); +%!assert(chi2inv ([x, NaN], single(2)), single([NaN 0 1 Inf NaN NaN]), 5*eps("single")); + +%% Test input validation +%!error chi2inv () +%!error chi2inv (1) +%!error chi2inv (1,2,3) +%!error chi2inv (ones(3),ones(2)) +%!error chi2inv (ones(2),ones(3)) +%!error chi2inv (i, 2) +%!error chi2inv (2, i) + diff --git a/octave_packages/m/statistics/distributions/chi2pdf.m b/octave_packages/m/statistics/distributions/chi2pdf.m new file mode 100644 index 0000000..18928de --- /dev/null +++ b/octave_packages/m/statistics/distributions/chi2pdf.m @@ -0,0 +1,72 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} chi2pdf (@var{x}, @var{n}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the chi-square distribution with @var{n} degrees +## of freedom. +## @end deftypefn + +## Author: TT +## Description: PDF of the chi-square distribution + +function pdf = chi2pdf (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("chi2pdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("chi2pdf: X and N must not be complex"); + endif + + pdf = gampdf (x, n/2, 2); + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1/2 * exp(-x(2:5)/2)]; +%!assert(chi2pdf (x, 2*ones(1,5)), y); +%!assert(chi2pdf (x, 2), y); +%!assert(chi2pdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(chi2pdf ([x, NaN], 2), [y, NaN]); + +%% Test class of input preserved +%!assert(chi2pdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(chi2pdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error chi2pdf () +%!error chi2pdf (1) +%!error chi2pdf (1,2,3) +%!error chi2pdf (ones(3),ones(2)) +%!error chi2pdf (ones(2),ones(3)) +%!error chi2pdf (i, 2) +%!error chi2pdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/chi2rnd.m b/octave_packages/m/statistics/distributions/chi2rnd.m new file mode 100644 index 0000000..542ea1d --- /dev/null +++ b/octave_packages/m/statistics/distributions/chi2rnd.m @@ -0,0 +1,120 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} chi2rnd (@var{n}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} chi2rnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the chi-square distribution with +## @var{n} degrees of freedom. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the chi-square distribution + +function rnd = chi2rnd (n, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + sz = size (n); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("chi2rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("chi2rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("chi2rnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("chi2rnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n)) + if ((n > 0) && (n < Inf)) + rnd = 2 * randg (n/2, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = (n > 0) | (n < Inf); + rnd(k) = 2 * randg (n(k)/2); + endif + +endfunction + + +%!assert(size (chi2rnd (2)), [1, 1]); +%!assert(size (chi2rnd (ones(2,1))), [2, 1]); +%!assert(size (chi2rnd (ones(2,2))), [2, 2]); +%!assert(size (chi2rnd (1, 3)), [3, 3]); +%!assert(size (chi2rnd (1, [4 1])), [4, 1]); +%!assert(size (chi2rnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (chi2rnd (2)), "double"); +%!assert(class (chi2rnd (single(2))), "single"); +%!assert(class (chi2rnd (single([2 2]))), "single"); + +%% Test input validation +%!error chi2rnd () +%!error chi2rnd (ones(3),ones(2)) +%!error chi2rnd (ones(2),ones(3)) +%!error chi2rnd (i) +%!error chi2rnd (1, -1) +%!error chi2rnd (1, ones(2)) +%!error chi2rnd (1, [2 -1 2]) +%!error chi2rnd (ones(2,2), 3) +%!error chi2rnd (ones(2,2), [3, 2]) +%!error chi2rnd (ones(2,2), 2, 3) + diff --git a/octave_packages/m/statistics/distributions/discrete_cdf.m b/octave_packages/m/statistics/distributions/discrete_cdf.m new file mode 100644 index 0000000..c9e98d7 --- /dev/null +++ b/octave_packages/m/statistics/distributions/discrete_cdf.m @@ -0,0 +1,81 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 2010-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} discrete_cdf (@var{x}, @var{v}, @var{p}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of a univariate discrete distribution which +## assumes the values in @var{v} with probabilities @var{p}. +## @end deftypefn + +function cdf = discrete_cdf (x, v, p) + + if (nargin != 3) + print_usage (); + endif + + if (! isvector (v)) + error ("discrete_cdf: V must be a vector"); + elseif (any (isnan (v))) + error ("discrete_cdf: V must not have any NaN elements"); + elseif (! isvector (p) || (length (p) != length (v))) + error ("discrete_cdf: P must be a vector with length (V) elements"); + elseif (! (all (p >= 0) && any (p))) + error ("discrete_cdf: P must be a nonzero, non-negative vector"); + endif + + p = p(:) / sum (p); # Reshape and normalize probability vector + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")); + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); + endif + + k = !isnan (x); + [vs, vi] = sort (v); + cdf(k) = [0 ; cumsum(p(vi))](lookup (vs, x(k)) + 1); + +endfunction + + +%!shared x,v,p,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [0 0.1 0.6 1 1]; +%!assert(discrete_cdf ([x, NaN], v, p), [y, NaN], eps); + +%% Test class of input preserved +%!assert(discrete_cdf (single([x, NaN]), v, p), single([y, NaN]), 2*eps("single")); +%!assert(discrete_cdf ([x, NaN], single(v), p), single([y, NaN]), 2*eps("single")); +%!assert(discrete_cdf ([x, NaN], v, single(p)), single([y, NaN]), 2*eps("single")); + +%% Test input validation +%!error discrete_cdf () +%!error discrete_cdf (1) +%!error discrete_cdf (1,2) +%!error discrete_cdf (1,2,3,4) +%!error discrete_cdf (1, ones(2), ones(2,1)) +%!error discrete_cdf (1, [1 ; NaN], ones(2,1)) +%!error discrete_cdf (1, ones(2,1), ones(1,1)) +%!error discrete_cdf (1, ones(2,1), [1 -1]) +%!error discrete_cdf (1, ones(2,1), [1 NaN]) +%!error discrete_cdf (1, ones(2,1), [0 0]) + diff --git a/octave_packages/m/statistics/distributions/discrete_inv.m b/octave_packages/m/statistics/distributions/discrete_inv.m new file mode 100644 index 0000000..91d6c5e --- /dev/null +++ b/octave_packages/m/statistics/distributions/discrete_inv.m @@ -0,0 +1,95 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} discrete_inv (@var{x}, @var{v}, @var{p}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the univariate distribution which assumes the +## values in @var{v} with probabilities @var{p}. +## @end deftypefn + +## Author: KH +## Description: Quantile function of a discrete distribution + +function inv = discrete_inv (x, v, p) + + if (nargin != 3) + print_usage (); + endif + + if (! isvector (v)) + error ("discrete_inv: V must be a vector"); + elseif (! isvector (p) || (length (p) != length (v))) + error ("discrete_inv: P must be a vector with length (V) elements"); + elseif (any (isnan (p))) + error ("discrete_rnd: P must not have any NaN elements"); + elseif (! (all (p >= 0) && any (p))) + error ("discrete_inv: P must be a nonzero, non-negative vector"); + endif + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")); + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + ## FIXME: This isn't elegant. But cumsum and lookup together produce + ## different results when called with a single or a double. + if (isa (p, "single")); + p = double (p); + endif + + [v, idx] = sort (v); + p = cumsum (p(idx)(:)) / sum (p); # Reshape and normalize probability vector + + k = (x == 0); + inv(k) = v(1); + + k = (x == 1); + inv(k) = v(end); + + k = (x > 0) & (x < 1); + inv(k) = v(length (p) - lookup (sort (p, "descend"), x(k)) + 1); + +endfunction + + +%!shared x,v,p,y +%! x = [-1 0 0.1 0.5 1 2]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [NaN v(1) v(1) v(end/2) v(end) NaN]; +%!assert(discrete_inv ([x, NaN], v, p), [y, NaN], eps); + +%% Test class of input preserved +%!assert(discrete_inv (single([x, NaN]), v, p), single([y, NaN]), eps("single")); +%!assert(discrete_inv ([x, NaN], single(v), p), single([y, NaN]), eps("single")); +%!assert(discrete_inv ([x, NaN], v, single(p)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error discrete_inv () +%!error discrete_inv (1) +%!error discrete_inv (1,2) +%!error discrete_inv (1,2,3,4) +%!error discrete_inv (1, ones(2), ones(2,1)) +%!error discrete_inv (1, ones(2,1), ones(1,1)) +%!error discrete_inv (1, ones(2,1), [1 NaN]) +%!error discrete_inv (1, ones(2,1), [1 -1]) +%!error discrete_inv (1, ones(2,1), [0 0]) + diff --git a/octave_packages/m/statistics/distributions/discrete_pdf.m b/octave_packages/m/statistics/distributions/discrete_pdf.m new file mode 100644 index 0000000..b796782 --- /dev/null +++ b/octave_packages/m/statistics/distributions/discrete_pdf.m @@ -0,0 +1,85 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} discrete_pdf (@var{x}, @var{v}, @var{p}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of a univariate discrete distribution which assumes +## the values in @var{v} with probabilities @var{p}. +## @end deftypefn + +## Author: KH +## Description: PDF of a discrete distribution + +function pdf = discrete_pdf (x, v, p) + + if (nargin != 3) + print_usage (); + endif + + if (! isvector (v)) + error ("discrete_pdf: V must be a vector"); + elseif (any (isnan (v))) + error ("discrete_pdf: V must not have any NaN elements"); + elseif (! isvector (p) || (length (p) != length (v))) + error ("discrete_pdf: P must be a vector with length (V) elements"); + elseif (! (all (p >= 0) && any (p))) + error ("discrete_pdf: P must be a nonzero, non-negative vector"); + endif + + ## Reshape and normalize probability vector. Values not in table get 0 prob. + p = [0 ; p(:)/sum(p)]; + + if (isa (x, "single") || isa (v, "single") || isa (p, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); + endif + + k = !isnan (x); + [vs, vi] = sort (v(:)); + pdf(k) = p([0 ; vi](lookup (vs, x(k), 'm') + 1) + 1); + +endfunction + + +%!shared x,v,p,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! p = 1/length(v) * ones(1, length(v)); +%! y = [0 0.1 0.1 0.1 0]; +%!assert(discrete_pdf ([x, NaN], v, p), [y, NaN], 5*eps); + +%% Test class of input preserved +%!assert(discrete_pdf (single([x, NaN]), v, p), single([y, NaN]), 5*eps("single")); +%!assert(discrete_pdf ([x, NaN], single(v), p), single([y, NaN]), 5*eps("single")); +%!assert(discrete_pdf ([x, NaN], v, single(p)), single([y, NaN]), 5*eps("single")); + +%% Test input validation +%!error discrete_pdf () +%!error discrete_pdf (1) +%!error discrete_pdf (1,2) +%!error discrete_pdf (1,2,3,4) +%!error discrete_pdf (1, ones(2), ones(2,1)) +%!error discrete_pdf (1, [1 ; NaN], ones(2,1)) +%!error discrete_pdf (1, ones(2,1), ones(1,1)) +%!error discrete_pdf (1, ones(2,1), [1 -1]) +%!error discrete_pdf (1, ones(2,1), [1 NaN]) +%!error discrete_pdf (1, ones(2,1), [0 0]) + diff --git a/octave_packages/m/statistics/distributions/discrete_rnd.m b/octave_packages/m/statistics/distributions/discrete_rnd.m new file mode 100644 index 0000000..e1073a5 --- /dev/null +++ b/octave_packages/m/statistics/distributions/discrete_rnd.m @@ -0,0 +1,104 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} discrete_rnd (@var{v}, @var{p}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} discrete_rnd (@var{v}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the univariate distribution which +## assumes the values in @var{v} with probabilities @var{p}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{v} and @var{p}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from a discrete distribution + +function rnd = discrete_rnd (v, p, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (! isvector (v)) + error ("discrete_rnd: V must be a vector"); + elseif (! isvector (p) || (length (p) != length (v))) + error ("discrete_rnd: P must be a vector with length (V) elements"); + elseif (any (isnan (p))) + error ("discrete_rnd: P must not have any NaN elements"); + elseif (! (all (p >= 0) && any (p))) + error ("discrete_rnd: P must be a nonzero, non-negative vector"); + endif + + if (nargin == 2) + sz = size (v); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("discrete_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("discrete_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + rnd = v(lookup (cumsum (p(1:end-1)) / sum (p), rand (sz)) + 1); + rnd = reshape (rnd, sz); + +endfunction + + +%!assert(size (discrete_rnd (1:2, 1:2, 3)), [3, 3]); +%!assert(size (discrete_rnd (1:2, 1:2, [4 1])), [4, 1]); +%!assert(size (discrete_rnd (1:2, 1:2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (discrete_rnd (1:2, 1:2)), "double"); +%!assert(class (discrete_rnd (single(1:2), 1:2)), "single"); +## FIXME: Maybe this should work, maybe it shouldn't. +#%!assert(class (discrete_rnd (1:2, single(1:2))), "single"); + +%% Test input validation +%!error discrete_rnd () +%!error discrete_rnd (1) +%!error discrete_rnd (1:2,1:2, -1) +%!error discrete_rnd (1:2,1:2, ones(2)) +%!error discrete_rnd (1:2,1:2, [2 -1 2]) +%!error discrete_rnd (1:2,1:2, 1, ones(2)) +%!error discrete_rnd (1:2,1:2, 1, -1) +%% test v,p verification +%!error discrete_rnd (1, ones(2), ones(2,1)) +%!error discrete_rnd (1, ones(2,1), ones(1,1)) +%!error discrete_rnd (1, ones(2,1), [1 -1]) +%!error discrete_rnd (1, ones(2,1), [1 NaN]) +%!error discrete_rnd (1, ones(2,1), [0 0]) + diff --git a/octave_packages/m/statistics/distributions/empirical_cdf.m b/octave_packages/m/statistics/distributions/empirical_cdf.m new file mode 100644 index 0000000..8a14e5f --- /dev/null +++ b/octave_packages/m/statistics/distributions/empirical_cdf.m @@ -0,0 +1,62 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} empirical_cdf (@var{x}, @var{data}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the empirical distribution obtained from +## the univariate sample @var{data}. +## @end deftypefn + +## Author: KH +## Description: CDF of the empirical distribution + +function cdf = empirical_cdf (x, data) + + if (nargin != 2) + print_usage (); + endif + + if (! isvector (data)) + error ("empirical_cdf: DATA must be a vector"); + endif + + cdf = discrete_cdf (x, data, ones (size (data))); + +endfunction + + +%!shared x,v,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! y = [0 0.1 0.6 1 1]; +%!assert(empirical_cdf (x, v), y, eps); +%!assert(empirical_cdf ([x(1) NaN x(3:5)], v), [0 NaN 0.6 1 1], eps); + +%% Test class of input preserved +%!assert(empirical_cdf ([x, NaN], v), [y, NaN], eps); +%!assert(empirical_cdf (single([x, NaN]), v), single([y, NaN]), eps); +%!assert(empirical_cdf ([x, NaN], single(v)), single([y, NaN]), eps); + +%% Test input validation +%!error empirical_cdf () +%!error empirical_cdf (1) +%!error empirical_cdf (1,2,3) +%!error empirical_cdf (1, ones(2)) + diff --git a/octave_packages/m/statistics/distributions/empirical_inv.m b/octave_packages/m/statistics/distributions/empirical_inv.m new file mode 100644 index 0000000..a9937fb --- /dev/null +++ b/octave_packages/m/statistics/distributions/empirical_inv.m @@ -0,0 +1,61 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} empirical_inv (@var{x}, @var{data}) +## For each element of @var{x}, compute the quantile (the inverse of the +## CDF) at @var{x} of the empirical distribution obtained from the +## univariate sample @var{data}. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the empirical distribution + +function inv = empirical_inv (x, data) + + if (nargin != 2) + print_usage (); + endif + + if (! isvector (data)) + error ("empirical_inv: DATA must be a vector"); + endif + + inv = discrete_inv (x, data, ones (size (data))); + +endfunction + + +%!shared x,v,y +%! x = [-1 0 0.1 0.5 1 2]; +%! v = 0.1:0.2:1.9; +%! y = [NaN v(1) v(1) v(end/2) v(end) NaN]; +%!assert(empirical_inv (x, v), y, eps); + +%% Test class of input preserved +%!assert(empirical_inv ([x, NaN], v), [y, NaN], eps); +%!assert(empirical_inv (single([x, NaN]), v), single([y, NaN]), eps); +%!assert(empirical_inv ([x, NaN], single(v)), single([y, NaN]), eps); + +%% Test input validation +%!error empirical_inv () +%!error empirical_inv (1) +%!error empirical_inv (1,2,3) +%!error empirical_inv (1, ones(2)) + diff --git a/octave_packages/m/statistics/distributions/empirical_pdf.m b/octave_packages/m/statistics/distributions/empirical_pdf.m new file mode 100644 index 0000000..f6e08d9 --- /dev/null +++ b/octave_packages/m/statistics/distributions/empirical_pdf.m @@ -0,0 +1,60 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} empirical_pdf (@var{x}, @var{data}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the empirical distribution obtained from the +## univariate sample @var{data}. +## @end deftypefn + +## Author: KH +## Description: PDF of the empirical distribution + +function pdf = empirical_pdf (x, data) + + if (nargin != 2) + print_usage (); + endif + + if (! isvector (data)) + error ("empirical_pdf: DATA must be a vector"); + endif + + pdf = discrete_pdf (x, data, ones (size (data))); + +endfunction + + +%!shared x,v,y +%! x = [-1 0.1 1.1 1.9 3]; +%! v = 0.1:0.2:1.9; +%! y = [0 0.1 0.1 0.1 0]; +%!assert(empirical_pdf (x, v), y); + +%% Test class of input preserved +%!assert(empirical_pdf (single(x), v), single (y)); +%!assert(empirical_pdf (x, single(v)), single (y)); + +%% Test input validation +%!error empirical_pdf () +%!error empirical_pdf (1) +%!error empirical_pdf (1,2,3) +%!error empirical_inv (1, ones(2)) + diff --git a/octave_packages/m/statistics/distributions/empirical_rnd.m b/octave_packages/m/statistics/distributions/empirical_rnd.m new file mode 100644 index 0000000..d332b7c --- /dev/null +++ b/octave_packages/m/statistics/distributions/empirical_rnd.m @@ -0,0 +1,69 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} empirical_rnd (@var{data}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{r}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} empirical_rnd (@var{data}, [@var{sz}]) +## Return a matrix of random samples from the empirical distribution obtained +## from the univariate sample @var{data}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is a random ordering +## of the sample @var{data}. +## @end deftypefn + +## Author: KH +## Description: Bootstrap samples from the empirical distribution + +function rnd = empirical_rnd (data, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (! isvector (data)) + error ("empirical_rnd: DATA must be a vector"); + endif + + rnd = discrete_rnd (data, ones (size (data)), varargin{:}); + +endfunction + + +%!assert(size (empirical_rnd (ones (3, 1))), [3, 1]); +%!assert(size (empirical_rnd (1:2, [4 1])), [4, 1]); +%!assert(size (empirical_rnd (1:2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (empirical_rnd (1:2, 1)), "double"); +%!assert(class (empirical_rnd (single(1:2), 1)), "single"); + +%% Test input validation +%!error empirical_rnd () +%!error empirical_rnd (ones(2), 1) +%% test data verification +%!error empirical_rnd (ones(2), 1, 1) + diff --git a/octave_packages/m/statistics/distributions/expcdf.m b/octave_packages/m/statistics/distributions/expcdf.m new file mode 100644 index 0000000..d837050 --- /dev/null +++ b/octave_packages/m/statistics/distributions/expcdf.m @@ -0,0 +1,91 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} expcdf (@var{x}, @var{lambda}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the exponential distribution with +## mean @var{lambda}. +## +## The arguments can be of common size or scalars. +## @end deftypefn + +## Author: KH +## Description: CDF of the exponential distribution + +function cdf = expcdf (x, lambda) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (lambda)) + [retval, x, lambda] = common_size (x, lambda); + if (retval > 0) + error ("expcdf: X and LAMBDA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (lambda)) + error ("expcdf: X and LAMBDA must not be complex"); + endif + + if (isa (x, "single") || isa (lambda, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(lambda > 0); + cdf(k) = NaN; + + k = (x == Inf) & (lambda > 0); + cdf(k) = 1; + + k = (x > 0) & (x < Inf) & (lambda > 0); + if isscalar (lambda) + cdf(k) = 1 - exp (- x(k) / lambda); + else + cdf(k) = 1 - exp (- x(k) ./ lambda(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1 - exp(-x(2:end)/2)]; +%!assert(expcdf (x, 2*ones(1,5)), y); +%!assert(expcdf (x, 2), y); +%!assert(expcdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); + +%% Test class of input preserved +%!assert(expcdf ([x, NaN], 2), [y, NaN]); +%!assert(expcdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(expcdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error expcdf () +%!error expcdf (1) +%!error expcdf (1,2,3) +%!error expcdf (ones(3),ones(2)) +%!error expcdf (ones(2),ones(3)) +%!error expcdf (i, 2) +%!error expcdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/expinv.m b/octave_packages/m/statistics/distributions/expinv.m new file mode 100644 index 0000000..1f352b6 --- /dev/null +++ b/octave_packages/m/statistics/distributions/expinv.m @@ -0,0 +1,95 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} expinv (@var{x}, @var{lambda}) +## For each element of @var{x}, compute the quantile (the inverse of the +## CDF) at @var{x} of the exponential distribution with mean @var{lambda}. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the exponential distribution + +function inv = expinv (x, lambda) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (lambda)) + [retval, x, lambda] = common_size (x, lambda); + if (retval > 0) + error ("expinv: X and LAMBDA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (lambda)) + error ("expinv: X and LAMBDA must not be complex"); + endif + + if (!isscalar (x)) + sz = size (x); + else + sz = size (lambda); + endif + + if (iscomplex (x) || iscomplex (lambda)) + error ("expinv: X and LAMBDA must not be complex"); + endif + + if (isa (x, "single") || isa (lambda, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x == 1) & (lambda > 0); + inv(k) = Inf; + + k = (x >= 0) & (x < 1) & (lambda > 0); + if isscalar (lambda) + inv(k) = - lambda * log (1 - x(k)); + else + inv(k) = - lambda(k) .* log (1 - x(k)); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.3934693402873666 1 2]; +%!assert(expinv (x, 2*ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(expinv (x, 2), [NaN 0 1 Inf NaN], eps); +%!assert(expinv (x, 2*[1 0 NaN 1 1]), [NaN NaN NaN Inf NaN], eps); +%!assert(expinv ([x(1:2) NaN x(4:5)], 2), [NaN 0 NaN Inf NaN], eps); + +%% Test class of input preserved +%!assert(expinv ([x, NaN], 2), [NaN 0 1 Inf NaN NaN], eps); +%!assert(expinv (single([x, NaN]), 2), single([NaN 0 1 Inf NaN NaN]), eps); +%!assert(expinv ([x, NaN], single(2)), single([NaN 0 1 Inf NaN NaN]), eps); + +%% Test input validation +%!error expinv () +%!error expinv (1) +%!error expinv (1,2,3) +%!error expinv (ones(3),ones(2)) +%!error expinv (ones(2),ones(3)) +%!error expinv (i, 2) +%!error expinv (2, i) + diff --git a/octave_packages/m/statistics/distributions/exppdf.m b/octave_packages/m/statistics/distributions/exppdf.m new file mode 100644 index 0000000..95e1205 --- /dev/null +++ b/octave_packages/m/statistics/distributions/exppdf.m @@ -0,0 +1,84 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} exppdf (@var{x}, @var{lambda}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the exponential distribution with mean @var{lambda}. +## @end deftypefn + +## Author: KH +## Description: PDF of the exponential distribution + +function pdf = exppdf (x, lambda) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (lambda)) + [retval, x, lambda] = common_size (x, lambda); + if (retval > 0) + error ("exppdf: X and LAMBDA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (lambda)) + error ("exppdf: X and LAMBDA must not be complex"); + endif + + if (isa (x, "single") || isa (lambda, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(lambda > 0); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (lambda > 0); + if isscalar (lambda) + pdf(k) = exp (- x(k) / lambda) / lambda; + else + pdf(k) = exp (- x(k) ./ lambda(k)) ./ lambda(k); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = gampdf (x, 1, 2); +%!assert(exppdf (x, 2*ones(1,5)), y); +%!assert(exppdf (x, 2*[1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(exppdf ([x, NaN], 2), [y, NaN]); + +%% Test class of input preserved +%!assert(exppdf (single([x, NaN]), 2), single([y, NaN])); +%!assert(exppdf ([x, NaN], single(2)), single([y, NaN])); + +%% Test input validation +%!error exppdf () +%!error exppdf (1) +%!error exppdf (1,2,3) +%!error exppdf (ones(3),ones(2)) +%!error exppdf (ones(2),ones(3)) +%!error exppdf (i, 2) +%!error exppdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/exprnd.m b/octave_packages/m/statistics/distributions/exprnd.m new file mode 100644 index 0000000..24ff1f6 --- /dev/null +++ b/octave_packages/m/statistics/distributions/exprnd.m @@ -0,0 +1,117 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} exprnd (@var{lambda}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, @var{r}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} exprnd (@var{lambda}, [@var{sz}]) +## Return a matrix of random samples from the exponential distribution with +## mean @var{lambda}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{lambda}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the exponential distribution + +function rnd = exprnd (lambda, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + sz = size (lambda); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("exprnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("exprnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (lambda) && !isequal (size (lambda), sz)) + error ("exprnd: LAMBDA must be scalar or of size SZ"); + endif + + if (iscomplex (lambda)) + error ("exprnd: LAMBDA must not be complex"); + endif + + if (isa (lambda, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (lambda)) + if ((lambda > 0) && (lambda < Inf)) + rnd = rande (sz) * lambda; + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = (lambda > 0) & (lambda < Inf); + rnd(k) = rande (sum (k(:)), 1) .* lambda(k)(:); + endif + +endfunction + + +%!assert(size (exprnd (2)), [1, 1]); +%!assert(size (exprnd (ones(2,1))), [2, 1]); +%!assert(size (exprnd (ones(2,2))), [2, 2]); +%!assert(size (exprnd (1, 3)), [3, 3]); +%!assert(size (exprnd (1, [4 1])), [4, 1]); +%!assert(size (exprnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (exprnd (1)), "double"); +%!assert(class (exprnd (single(1))), "single"); +%!assert(class (exprnd (single([1 1]))), "single"); + +%% Test input validation +%!error exprnd () +%!error exprnd (1, -1) +%!error exprnd (1, ones(2)) +%!error exprnd (i) +%!error exprnd (1, [2 -1 2]) +%!error exprnd (1, 2, -1) +%!error exprnd (1, 2, ones(2)) +%!error exprnd (ones(2,2), 3) +%!error exprnd (ones(2,2), [3, 2]) +%!error exprnd (ones(2,2), 2, 3) + diff --git a/octave_packages/m/statistics/distributions/fcdf.m b/octave_packages/m/statistics/distributions/fcdf.m new file mode 100644 index 0000000..f75ba63 --- /dev/null +++ b/octave_packages/m/statistics/distributions/fcdf.m @@ -0,0 +1,96 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fcdf (@var{x}, @var{m}, @var{n}) +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the F distribution with @var{m} and @var{n} degrees of +## freedom. +## @end deftypefn + +## Author: KH +## Description: CDF of the F distribution + +function cdf = fcdf (x, m, n) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (m) || !isscalar (n)) + [retval, x, m, n] = common_size (x, m, n); + if (retval > 0) + error ("fcdf: X, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("fcdf: X, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(m > 0) | !(m < Inf) | !(n > 0) | !(n < Inf); + cdf(k) = NaN; + + k = (x == Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + cdf(k) = 1; + + k = (x > 0) & (x < Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + cdf(k) = 1 - betainc (1 ./ (1 + m * x(k) / n), n/2, m/2); + else + cdf(k) = 1 - betainc (1 ./ (1 + m(k) .* x(k) ./ n(k)), n(k)/2, m(k)/2); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2 Inf]; +%! y = [0 0 1/3 1/2 2/3 1]; +%!assert(fcdf (x, 2*ones(1,6), 2*ones(1,6)), y, eps); +%!assert(fcdf (x, 2, 2*ones(1,6)), y, eps); +%!assert(fcdf (x, 2*ones(1,6), 2), y, eps); +%!assert(fcdf (x, [0 NaN Inf 2 2 2], 2), [NaN NaN NaN y(4:6)], eps); +%!assert(fcdf (x, 2, [0 NaN Inf 2 2 2]), [NaN NaN NaN y(4:6)], eps); +%!assert(fcdf ([x(1:2) NaN x(4:6)], 2, 2), [y(1:2) NaN y(4:6)], eps); + +%% Test class of input preserved +%!assert(fcdf ([x, NaN], 2, 2), [y, NaN], eps); +%!assert(fcdf (single([x, NaN]), 2, 2), single([y, NaN]), eps("single")); +%!assert(fcdf ([x, NaN], single(2), 2), single([y, NaN]), eps("single")); +%!assert(fcdf ([x, NaN], 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error fcdf () +%!error fcdf (1) +%!error fcdf (1,2) +%!error fcdf (1,2,3,4) +%!error fcdf (ones(3),ones(2),ones(2)) +%!error fcdf (ones(2),ones(3),ones(2)) +%!error fcdf (ones(2),ones(2),ones(3)) +%!error fcdf (i, 2, 2) +%!error fcdf (2, i, 2) +%!error fcdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/finv.m b/octave_packages/m/statistics/distributions/finv.m new file mode 100644 index 0000000..4c71dd1 --- /dev/null +++ b/octave_packages/m/statistics/distributions/finv.m @@ -0,0 +1,93 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} finv (@var{x}, @var{m}, @var{n}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the F distribution with @var{m} and @var{n} +## degrees of freedom. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the F distribution + +function inv = finv (x, m, n) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (m) || !isscalar (n)) + [retval, x, m, n] = common_size (x, m, n); + if (retval > 0) + error ("finv: X, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("finv: X, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x == 1) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + inv(k) = Inf; + + k = (x >= 0) & (x < 1) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + inv(k) = ((1 ./ betainv (1 - x(k), n/2, m/2) - 1) * n / m); + else + inv(k) = ((1 ./ betainv (1 - x(k), n(k)/2, m(k)/2) - 1) + .* n(k) ./ m(k)); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(finv (x, 2*ones(1,5), 2*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(finv (x, 2, 2*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(finv (x, 2*ones(1,5), 2), [NaN 0 1 Inf NaN]); +%!assert(finv (x, [2 -Inf NaN Inf 2], 2), [NaN NaN NaN NaN NaN]); +%!assert(finv (x, 2, [2 -Inf NaN Inf 2]), [NaN NaN NaN NaN NaN]); +%!assert(finv ([x(1:2) NaN x(4:5)], 2, 2), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(finv ([x, NaN], 2, 2), [NaN 0 1 Inf NaN NaN]); +%!assert(finv (single([x, NaN]), 2, 2), single([NaN 0 1 Inf NaN NaN])); +%!assert(finv ([x, NaN], single(2), 2), single([NaN 0 1 Inf NaN NaN])); +%!assert(finv ([x, NaN], 2, single(2)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error finv () +%!error finv (1) +%!error finv (1,2) +%!error finv (1,2,3,4) +%!error finv (ones(3),ones(2),ones(2)) +%!error finv (ones(2),ones(3),ones(2)) +%!error finv (ones(2),ones(2),ones(3)) +%!error finv (i, 2, 2) +%!error finv (2, i, 2) +%!error finv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/fpdf.m b/octave_packages/m/statistics/distributions/fpdf.m new file mode 100644 index 0000000..5b776cc --- /dev/null +++ b/octave_packages/m/statistics/distributions/fpdf.m @@ -0,0 +1,105 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} fpdf (@var{x}, @var{m}, @var{n}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the F distribution with @var{m} and @var{n} +## degrees of freedom. +## @end deftypefn + +## Author: KH +## Description: PDF of the F distribution + +function pdf = fpdf (x, m, n) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (m) || !isscalar (n)) + [retval, x, m, n] = common_size (x, m, n); + if (retval > 0) + error ("fpdf: X, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (m) || iscomplex (n)) + error ("fpdf: X, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (m, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(m > 0) | !(m < Inf) | !(n > 0) | !(n < Inf); + pdf(k) = NaN; + + k = (x > 0) & (x < Inf) & (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + if (isscalar (m) && isscalar (n)) + tmp = m / n * x(k); + pdf(k) = (exp ((m/2 - 1) * log (tmp) + - ((m + n) / 2) * log (1 + tmp)) + * (m / n) ./ beta (m/2, n/2)); + else + tmp = m(k) .* x(k) ./ n(k); + pdf(k) = (exp ((m(k)/2 - 1) .* log (tmp) + - ((m(k) + n(k)) / 2) .* log (1 + tmp)) + .* (m(k) ./ n(k)) ./ beta (m(k)/2, n(k)/2)); + endif + +endfunction + + +%% F (x, 1, m) == T distribution (sqrt (x), m) / sqrt (x) +%!test +%! x = rand (10,1); +%! x = x(x > 0.1 & x < 0.9); +%! y = tpdf (sqrt (x), 2) ./ sqrt (x); +%! assert(fpdf (x, 1, 2), y, 5*eps); + +%!shared x,y +%! x = [-1 0 0.5 1 2]; +%! y = [0 0 4/9 1/4 1/9]; +%!assert(fpdf (x, 2*ones(1,5), 2*ones(1,5)), y, eps); +%!assert(fpdf (x, 2, 2*ones(1,5)), y, eps); +%!assert(fpdf (x, 2*ones(1,5), 2), y, eps); +%!assert(fpdf (x, [0 NaN Inf 2 2], 2), [NaN NaN NaN y(4:5)], eps); +%!assert(fpdf (x, 2, [0 NaN Inf 2 2]), [NaN NaN NaN y(4:5)], eps); +%!assert(fpdf ([x, NaN], 2, 2), [y, NaN], eps); + +%% Test class of input preserved +%!assert(fpdf (single([x, NaN]), 2, 2), single([y, NaN]), eps("single")); +%!assert(fpdf ([x, NaN], single(2), 2), single([y, NaN]), eps("single")); +%!assert(fpdf ([x, NaN], 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error fpdf () +%!error fpdf (1) +%!error fpdf (1,2) +%!error fpdf (1,2,3,4) +%!error fpdf (ones(3),ones(2),ones(2)) +%!error fpdf (ones(2),ones(3),ones(2)) +%!error fpdf (ones(2),ones(2),ones(3)) +%!error fpdf (i, 2, 2) +%!error fpdf (2, i, 2) +%!error fpdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/frnd.m b/octave_packages/m/statistics/distributions/frnd.m new file mode 100644 index 0000000..54dab91 --- /dev/null +++ b/octave_packages/m/statistics/distributions/frnd.m @@ -0,0 +1,132 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} frnd (@var{m}, @var{n}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, @var{r}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} frnd (@var{m}, @var{n}, [@var{sz}]) +## Return a matrix of random samples from the F distribution with +## @var{m} and @var{n} degrees of freedom. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{m} and @var{n}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the F distribution + +function rnd = frnd (m, n, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (m) || !isscalar (n)) + [retval, m, n] = common_size (m, n); + if (retval > 0) + error ("frnd: M and N must be of common size or scalars"); + endif + endif + + if (iscomplex (m) || iscomplex (n)) + error ("frnd: M and N must not be complex"); + endif + + if (nargin == 2) + sz = size (m); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("frnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("frnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (m) && !isequal (size (m), sz)) + error ("frnd: M and N must be scalar or of size SZ"); + endif + + if (isa (m, "single") || isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (m) && isscalar (n)) + if ((m > 0) && (m < Inf) && (n > 0) && (n < Inf)) + rnd = n/m * randg (m/2, sz) ./ randg (n/2, sz); + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = (m > 0) & (m < Inf) & (n > 0) & (n < Inf); + rnd(k) = n(k) ./ m(k) .* randg (m(k)/2) ./ randg (n(k)/2); + endif + +endfunction + + +%!assert(size (frnd (1,2)), [1, 1]); +%!assert(size (frnd (ones(2,1), 2)), [2, 1]); +%!assert(size (frnd (ones(2,2), 2)), [2, 2]); +%!assert(size (frnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (frnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (frnd (1, 2, 3)), [3, 3]); +%!assert(size (frnd (1, 2, [4 1])), [4, 1]); +%!assert(size (frnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (frnd (1, 2)), "double"); +%!assert(class (frnd (single(1), 2)), "single"); +%!assert(class (frnd (single([1 1]), 2)), "single"); +%!assert(class (frnd (1, single(2))), "single"); +%!assert(class (frnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error frnd () +%!error frnd (1) +%!error frnd (ones(3),ones(2)) +%!error frnd (ones(2),ones(3)) +%!error frnd (i, 2) +%!error frnd (2, i) +%!error frnd (1,2, -1) +%!error frnd (1,2, ones(2)) +%!error frnd (1, 2, [2 -1 2]) +%!error frnd (1,2, 1, ones(2)) +%!error frnd (1,2, 1, -1) +%!error frnd (ones(2,2), 2, 3) +%!error frnd (ones(2,2), 2, [3, 2]) +%!error frnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/gamcdf.m b/octave_packages/m/statistics/distributions/gamcdf.m new file mode 100644 index 0000000..5b3cad6 --- /dev/null +++ b/octave_packages/m/statistics/distributions/gamcdf.m @@ -0,0 +1,91 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gamcdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the Gamma distribution with shape +## parameter @var{a} and scale @var{b}. +## @end deftypefn + +## Author: TT +## Description: CDF of the Gamma distribution + +function cdf = gamcdf (x, a, b) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("gamcdf: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gamcdf: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf); + cdf(k) = NaN; + + k = (x > 0) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + if (isscalar (a) && isscalar (b)) + cdf(k) = gammainc (x(k) / b, a); + else + cdf(k) = gammainc (x(k) ./ b(k), a(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2 Inf]; +%! y = [0, gammainc(x(2:end), 1)]; +%!assert(gamcdf (x, ones(1,6), ones(1,6)), y); +%!assert(gamcdf (x, 1, ones(1,6)), y); +%!assert(gamcdf (x, ones(1,6), 1), y); +%!assert(gamcdf (x, [0 -Inf NaN Inf 1 1], 1), [NaN NaN NaN NaN y(5:6)]); +%!assert(gamcdf (x, 1, [0 -Inf NaN Inf 1 1]), [NaN NaN NaN NaN y(5:6)]); +%!assert(gamcdf ([x(1:2) NaN x(4:6)], 1, 1), [y(1:2) NaN y(4:6)]); + +%% Test class of input preserved +%!assert(gamcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(gamcdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); + +%% Test input validation +%!error gamcdf () +%!error gamcdf (1) +%!error gamcdf (1,2) +%!error gamcdf (1,2,3,4) +%!error gamcdf (ones(3),ones(2),ones(2)) +%!error gamcdf (ones(2),ones(3),ones(2)) +%!error gamcdf (ones(2),ones(2),ones(3)) +%!error gamcdf (i, 2, 2) +%!error gamcdf (2, i, 2) +%!error gamcdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/gaminv.m b/octave_packages/m/statistics/distributions/gaminv.m new file mode 100644 index 0000000..cbf3b09 --- /dev/null +++ b/octave_packages/m/statistics/distributions/gaminv.m @@ -0,0 +1,129 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gaminv (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the Gamma distribution with shape parameter +## @var{a} and scale @var{b}. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the Gamma distribution + +function inv = gaminv (x, a, b) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("gaminv: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gaminv: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); + endif + + k = ((x < 0) | (x > 1) | isnan (x) + | !(a > 0) | !(a < Inf) | !(b > 0) | !(b < Inf)); + inv(k) = NaN; + + k = (x == 1) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + inv(k) = Inf; + + k = find ((x > 0) & (x < 1) & (a > 0) & (a < Inf) & (b > 0) & (b < Inf)); + if (any (k)) + if (!isscalar (a) || !isscalar (b)) + a = a(k); + b = b(k); + y = a .* b; + else + y = a * b * ones (size (k)); + endif + x = x(k); + + if (isa (x, "single")) + myeps = eps ("single"); + else + myeps = eps; + endif + + l = find (x < myeps); + if (any (l)) + y(l) = sqrt (myeps) * ones (length (l), 1); + endif + + y_old = y; + for i = 1 : 100 + h = (gamcdf (y_old, a, b) - x) ./ gampdf (y_old, a, b); + y_new = y_old - h; + ind = find (y_new <= myeps); + if (any (ind)) + y_new (ind) = y_old (ind) / 10; + h = y_old - y_new; + endif + if (max (abs (h)) < sqrt (myeps)) + break; + endif + y_old = y_new; + endfor + + inv(k) = y_new; + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.63212055882855778 1 2]; +%!assert(gaminv (x, ones(1,5), ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, 1, ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, ones(1,5), 1), [NaN 0 1 Inf NaN], eps); +%!assert(gaminv (x, [1 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(gaminv (x, 1, [1 -Inf NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(gaminv ([x(1:2) NaN x(4:5)], 1, 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(gaminv ([x, NaN], 1, 1), [NaN 0 1 Inf NaN NaN], eps); +%!assert(gaminv (single([x, NaN]), 1, 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(gaminv ([x, NaN], single(1), 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(gaminv ([x, NaN], 1, single(1)), single([NaN 0 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error gaminv () +%!error gaminv (1) +%!error gaminv (1,2) +%!error gaminv (1,2,3,4) +%!error gaminv (ones(3),ones(2),ones(2)) +%!error gaminv (ones(2),ones(3),ones(2)) +%!error gaminv (ones(2),ones(2),ones(3)) +%!error gaminv (i, 2, 2) +%!error gaminv (2, i, 2) +%!error gaminv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/gampdf.m b/octave_packages/m/statistics/distributions/gampdf.m new file mode 100644 index 0000000..a10b34c --- /dev/null +++ b/octave_packages/m/statistics/distributions/gampdf.m @@ -0,0 +1,103 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gampdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, return the probability density function +## (PDF) at @var{x} of the Gamma distribution with shape parameter +## @var{a} and scale @var{b}. +## @end deftypefn + +## Author: TT +## Description: PDF of the Gamma distribution + +function pdf = gampdf (x, a, b) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("gampdf: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("gampdf: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = !(a > 0) | !(b > 0) | isnan (x); + pdf(k) = NaN; + + k = (x >= 0) & (a > 0) & (a <= 1) & (b > 0); + if (isscalar (a) && isscalar (b)) + pdf(k) = (x(k) .^ (a - 1)) ... + .* exp (- x(k) / b) / gamma (a) / (b ^ a); + else + pdf(k) = (x(k) .^ (a(k) - 1)) ... + .* exp (- x(k) ./ b(k)) ./ gamma (a(k)) ./ (b(k) .^ a(k)); + endif + + k = (x >= 0) & (a > 1) & (b > 0); + if (isscalar (a) && isscalar (b)) + pdf(k) = exp (- a * log (b) + (a-1) * log (x(k)) + - x(k) / b - gammaln (a)); + else + pdf(k) = exp (- a(k) .* log (b(k)) + (a(k)-1) .* log (x(k)) + - x(k) ./ b(k) - gammaln (a(k))); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0 exp(-x(2:end))]; +%!assert(gampdf (x, ones(1,5), ones(1,5)), y); +%!assert(gampdf (x, 1, ones(1,5)), y); +%!assert(gampdf (x, ones(1,5), 1), y); +%!assert(gampdf (x, [0 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN y(5)]); +%!assert(gampdf (x, 1, [0 -Inf NaN Inf 1]), [NaN NaN NaN 0 y(5)]); +%!assert(gampdf ([x, NaN], 1, 1), [y, NaN]); + +%% Test class of input preserved +%!assert(gampdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(gampdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(gampdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error gampdf () +%!error gampdf (1) +%!error gampdf (1,2) +%!error gampdf (1,2,3,4) +%!error gampdf (ones(3),ones(2),ones(2)) +%!error gampdf (ones(2),ones(3),ones(2)) +%!error gampdf (ones(2),ones(2),ones(3)) +%!error gampdf (i, 2, 2) +%!error gampdf (2, i, 2) +%!error gampdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/gamrnd.m b/octave_packages/m/statistics/distributions/gamrnd.m new file mode 100644 index 0000000..9b6089d --- /dev/null +++ b/octave_packages/m/statistics/distributions/gamrnd.m @@ -0,0 +1,135 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} gamrnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} gamrnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the Gamma distribution with +## shape parameter @var{a} and scale @var{b}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the Gamma distribution + +function rnd = gamrnd (a, b, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("gamrnd: A and B must be of common size or scalars"); + endif + endif + + if (iscomplex (a) || iscomplex (b)) + error ("gamrnd: A and B must not be complex"); + endif + + if (nargin == 2) + sz = size (a); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("gamrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("gamrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (a) && !isequal (size (a), sz)) + error ("gamrnd: A and B must be scalar or of size SZ"); + endif + + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((a > 0) && (a < Inf) && (b > 0) && (b < Inf)) + rnd = b * randg (a, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = (a > 0) & (a < Inf) & (b > 0) & (b < Inf); + rnd(k) = b(k) .* randg (a(k)); + endif + +endfunction + + +%!assert(size (gamrnd (1,2)), [1, 1]); +%!assert(size (gamrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (gamrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (gamrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (gamrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (gamrnd (1, 2, 3)), [3, 3]); +%!assert(size (gamrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (gamrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (gamrnd (1, 2)), "double"); +%!assert(class (gamrnd (single(1), 2)), "single"); +%!assert(class (gamrnd (single([1 1]), 2)), "single"); +%!assert(class (gamrnd (1, single(2))), "single"); +%!assert(class (gamrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error gamrnd () +%!error gamrnd (1) +%!error gamrnd (ones(3),ones(2)) +%!error gamrnd (ones(2),ones(3)) +%!error gamrnd (i, 2) +%!error gamrnd (2, i) +%!error gamrnd (1,2, -1) +%!error gamrnd (1,2, ones(2)) +%!error gamrnd (1, 2, [2 -1 2]) +%!error gamrnd (1,2, 1, ones(2)) +%!error gamrnd (1,2, 1, -1) +%!error gamrnd (ones(2,2), 2, 3) +%!error gamrnd (ones(2,2), 2, [3, 2]) +%!error gamrnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/geocdf.m b/octave_packages/m/statistics/distributions/geocdf.m new file mode 100644 index 0000000..b9c6902 --- /dev/null +++ b/octave_packages/m/statistics/distributions/geocdf.m @@ -0,0 +1,89 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} geocdf (@var{x}, @var{p}) +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the geometric distribution with parameter @var{p}. +## @end deftypefn + +## Author: KH +## Description: CDF of the geometric distribution + +function cdf = geocdf (x, p) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (p)) + [retval, x, p] = common_size (x, p); + if (retval > 0) + error ("geocdf: X and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (p)) + error ("geocdf: X and P must not be complex"); + endif + + if (isa (x, "single") || isa (p, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(p >= 0) | !(p <= 1); + cdf(k) = NaN; + + k = (x == Inf) & (p >= 0) & (p <= 1); + cdf(k) = 1; + + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (p > 0) & (p <= 1); + if (isscalar (p)) + cdf(k) = 1 - ((1 - p) .^ (x(k) + 1)); + else + cdf(k) = 1 - ((1 - p(k)) .^ (x(k) + 1)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 Inf]; +%! y = [0 0.5 0.75 1]; +%!assert(geocdf (x, 0.5*ones(1,4)), y); +%!assert(geocdf (x, 0.5), y); +%!assert(geocdf (x, 0.5*[-1 NaN 4 1]), [NaN NaN NaN y(4)]); +%!assert(geocdf ([x(1:2) NaN x(4)], 0.5), [y(1:2) NaN y(4)]); + +%% Test class of input preserved +%!assert(geocdf ([x, NaN], 0.5), [y, NaN]); +%!assert(geocdf (single([x, NaN]), 0.5), single([y, NaN])); +%!assert(geocdf ([x, NaN], single(0.5)), single([y, NaN])); + +%% Test input validation +%!error geocdf () +%!error geocdf (1) +%!error geocdf (1,2,3) +%!error geocdf (ones(3),ones(2)) +%!error geocdf (ones(2),ones(3)) +%!error geocdf (i, 2) +%!error geocdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/geoinv.m b/octave_packages/m/statistics/distributions/geoinv.m new file mode 100644 index 0000000..9bc1b6a --- /dev/null +++ b/octave_packages/m/statistics/distributions/geoinv.m @@ -0,0 +1,85 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} geoinv (@var{x}, @var{p}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the geometric distribution with parameter @var{p}. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the geometric distribution + +function inv = geoinv (x, p) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (p)) + [retval, x, p] = common_size (x, p); + if (retval > 0) + error ("geoinv: X and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (p)) + error ("geoinv: X and P must not be complex"); + endif + + if (isa (x, "single") || isa (p, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x == 1) & (p >= 0) & (p <= 1); + inv(k) = Inf; + + k = (x >= 0) & (x < 1) & (p > 0) & (p <= 1); + if (isscalar (p)) + inv(k) = max (ceil (log (1 - x(k)) / log (1 - p)) - 1, 0); + else + inv(k) = max (ceil (log (1 - x(k)) ./ log (1 - p(k))) - 1, 0); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.75 1 2]; +%!assert(geoinv (x, 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(geoinv (x, 0.5), [NaN 0 1 Inf NaN]); +%!assert(geoinv (x, 0.5*[1 -1 NaN 4 1]), [NaN NaN NaN NaN NaN]); +%!assert(geoinv ([x(1:2) NaN x(4:5)], 0.5), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(geoinv ([x, NaN], 0.5), [NaN 0 1 Inf NaN NaN]); +%!assert(geoinv (single([x, NaN]), 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(geoinv ([x, NaN], single(0.5)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error geoinv () +%!error geoinv (1) +%!error geoinv (1,2,3) +%!error geoinv (ones(3),ones(2)) +%!error geoinv (ones(2),ones(3)) +%!error geoinv (i, 2) +%!error geoinv (2, i) + diff --git a/octave_packages/m/statistics/distributions/geopdf.m b/octave_packages/m/statistics/distributions/geopdf.m new file mode 100644 index 0000000..86cc88e --- /dev/null +++ b/octave_packages/m/statistics/distributions/geopdf.m @@ -0,0 +1,85 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} geopdf (@var{x}, @var{p}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the geometric distribution with parameter @var{p}. +## @end deftypefn + +## Author: KH +## Description: PDF of the geometric distribution + +function pdf = geopdf (x, p) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (p)) + [retval, x, p] = common_size (x, p); + if (retval > 0) + error ("geopdf: X and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (p)) + error ("geopdf: X and P must not be complex"); + endif + + if (isa (x, "single") || isa (p, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | (x == Inf) | !(p >= 0) | !(p <= 1); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (p > 0) & (p <= 1); + if (isscalar (p)) + pdf(k) = p * ((1 - p) .^ x(k)); + else + pdf(k) = p(k) .* ((1 - p(k)) .^ x(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 Inf]; +%! y = [0, 1/2, 1/4, NaN]; +%!assert(geopdf (x, 0.5*ones(1,4)), y); +%!assert(geopdf (x, 0.5), y); +%!assert(geopdf (x, 0.5*[-1 NaN 4 1]), [NaN NaN NaN y(4)]); +%!assert(geopdf ([x, NaN], 0.5), [y, NaN]); + +%% Test class of input preserved +%!assert(geopdf (single([x, NaN]), 0.5), single([y, NaN]), 5*eps("single")); +%!assert(geopdf ([x, NaN], single(0.5)), single([y, NaN]), 5*eps("single")); + +%% Test input validation +%!error geopdf () +%!error geopdf (1) +%!error geopdf (1,2,3) +%!error geopdf (ones(3),ones(2)) +%!error geopdf (ones(2),ones(3)) +%!error geopdf (i, 2) +%!error geopdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/geornd.m b/octave_packages/m/statistics/distributions/geornd.m new file mode 100644 index 0000000..d2c7f25 --- /dev/null +++ b/octave_packages/m/statistics/distributions/geornd.m @@ -0,0 +1,125 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} geornd (@var{p}) +## @deftypefnx {Function File} {} geornd (@var{p}, @var{r}) +## @deftypefnx {Function File} {} geornd (@var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} geornd (@var{p}, [@var{sz}]) +## Return a matrix of random samples from the geometric distribution with +## parameter @var{p}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{p}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the geometric distribution + +function rnd = geornd (p, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + sz = size (p); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("geornd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("geornd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (p) && !isequal (size (p), sz)) + error ("geornd: P must be scalar or of size SZ"); + endif + + if (iscomplex (p)) + error ("geornd: P must not be complex"); + endif + + if (isa (p, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (p)) + if (p > 0 && p < 1); + rnd = floor (- rande (sz) ./ log (1 - p)); + elseif (p == 0) + rnd = Inf (sz, cls); + elseif (p == 1) + rnd = zeros (sz, cls); + elseif (p < 0 || p > 1) + rnd = NaN (sz, cls); + endif + else + rnd = floor (- rande (sz) ./ log (1 - p)); + + k = !(p >= 0) | !(p <= 1); + rnd(k) = NaN; + + k = (p == 0); + rnd(k) = Inf; + endif + +endfunction + + +%!assert(size (geornd (0.5)), [1, 1]); +%!assert(size (geornd (0.5*ones(2,1))), [2, 1]); +%!assert(size (geornd (0.5*ones(2,2))), [2, 2]); +%!assert(size (geornd (0.5, 3)), [3, 3]); +%!assert(size (geornd (0.5, [4 1])), [4, 1]); +%!assert(size (geornd (0.5, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (geornd (0.5)), "double"); +%!assert(class (geornd (single(0.5))), "single"); +%!assert(class (geornd (single([0.5 0.5]))), "single"); +%!assert(class (geornd (single(0))), "single"); +%!assert(class (geornd (single(1))), "single"); + +%% Test input validation +%!error geornd () +%!error geornd (ones(3),ones(2)) +%!error geornd (ones(2),ones(3)) +%!error geornd (i) +%!error geornd (1, -1) +%!error geornd (1, ones(2)) +%!error geornd (1, [2 -1 2]) +%!error geornd (ones(2,2), 2, 3) +%!error geornd (ones(2,2), 3, 2) + diff --git a/octave_packages/m/statistics/distributions/hygecdf.m b/octave_packages/m/statistics/distributions/hygecdf.m new file mode 100644 index 0000000..e4d5186 --- /dev/null +++ b/octave_packages/m/statistics/distributions/hygecdf.m @@ -0,0 +1,109 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1997-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hygecdf (@var{x}, @var{t}, @var{m}, @var{n}) +## Compute the cumulative distribution function (CDF) at @var{x} of the +## hypergeometric distribution with parameters @var{t}, @var{m}, and +## @var{n}. This is the probability of obtaining not more than @var{x} +## marked items when randomly drawing a sample of size @var{n} without +## replacement from a population of total size @var{t} containing +## @var{m} marked items. +## +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers +## with @var{m} and @var{n} not greater than @var{t}. +## @end deftypefn + +## Author: KH +## Description: CDF of the hypergeometric distribution + +function cdf = hygecdf (x, t, m, n) + + if (nargin != 4) + print_usage (); + endif + + if (!isscalar (t) || !isscalar (m) || !isscalar (n)) + [retval, x, t, m, n] = common_size (x, t, m, n); + if (retval > 0) + error ("hygecdf: X, T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygecdf: X, T, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); + endif + + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + cdf = discrete_cdf (x, 0 : n, hygepdf (0 : n, t, m, n)); + endif + else + for i = find (ok(:)') # Must be row vector arg to for loop + v = 0 : n(i); + cdf(i) = discrete_cdf (x(i), v, hygepdf (v, t(i), m(i), n(i))); + endfor + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/6 5/6 1 1]; +%!assert(hygecdf (x, 4*ones(1,5), 2, 2), y, eps); +%!assert(hygecdf (x, 4, 2*ones(1,5), 2), y, eps); +%!assert(hygecdf (x, 4, 2, 2*ones(1,5)), y, eps); +%!assert(hygecdf (x, 4*[1 -1 NaN 1.1 1], 2, 2), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 2*[1 -1 NaN 1.1 1], 2), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygecdf (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [y(1) NaN NaN NaN y(5)], eps); +%!assert(hygecdf (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygecdf ([x(1:2) NaN x(4:5)], 4, 2, 2), [y(1:2) NaN y(4:5)], eps); + +%% Test class of input preserved +%!assert(hygecdf ([x, NaN], 4, 2, 2), [y, NaN], eps); +%!assert(hygecdf (single([x, NaN]), 4, 2, 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], single(4), 2, 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], 4, single(2), 2), single([y, NaN]), eps("single")); +%!assert(hygecdf ([x, NaN], 4, 2, single(2)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error hygecdf () +%!error hygecdf (1) +%!error hygecdf (1,2) +%!error hygecdf (1,2,3) +%!error hygecdf (1,2,3,4,5) +%!error hygecdf (ones(2), ones(3), 1, 1) +%!error hygecdf (1, ones(2), ones(3), 1) +%!error hygecdf (1, 1, ones(2), ones(3)) +%!error hygecdf (i, 2, 2, 2) +%!error hygecdf (2, i, 2, 2) +%!error hygecdf (2, 2, i, 2) +%!error hygecdf (2, 2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/hygeinv.m b/octave_packages/m/statistics/distributions/hygeinv.m new file mode 100644 index 0000000..8720531 --- /dev/null +++ b/octave_packages/m/statistics/distributions/hygeinv.m @@ -0,0 +1,114 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1997-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hygeinv (@var{x}, @var{t}, @var{m}, @var{n}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the hypergeometric distribution with parameters +## @var{t}, @var{m}, and @var{n}. This is the probability of obtaining @var{x} +## marked items when randomly drawing a sample of size @var{n} without +## replacement from a population of total size @var{t} containing @var{m} +## marked items. +## +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers +## with @var{m} and @var{n} not greater than @var{t}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the hypergeometric distribution + +function inv = hygeinv (x, t, m, n) + + if (nargin != 4) + print_usage (); + endif + + if (!isscalar (t) || !isscalar (m) || !isscalar (n)) + [retval, x, t, m, n] = common_size (x, t, m, n); + if (retval > 0) + error ("hygeinv: X, T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygeinv: X, T, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + inv = discrete_inv (x, 0 : n, hygepdf (0 : n, t, m, n)); + inv(x == 0) = 0; # Hack to return correct value for start of distribution + endif + else + for i = find (ok(:)') # Must be row vector arg to for loop + v = 0 : n(i); + if (x(i) == 0) + inv(i) = 0; # Hack to return correct value for start of distribution + else + inv(i) = discrete_inv (x(i), v, hygepdf (v, t(i), m(i), n(i))); + endif + endfor + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(hygeinv (x, 4*ones(1,5), 2*ones(1,5), 2*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4*ones(1,5), 2, 2), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4, 2*ones(1,5), 2), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4, 2, 2*ones(1,5)), [NaN 0 1 2 NaN]); +%!assert(hygeinv (x, 4*[1 -1 NaN 1.1 1], 2, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2*[1 -1 NaN 1.1 1], 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygeinv ([x(1:2) NaN x(4:5)], 4, 2, 2), [NaN 0 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(hygeinv ([x, NaN], 4, 2, 2), [NaN 0 1 2 NaN NaN]); +%!assert(hygeinv (single([x, NaN]), 4, 2, 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], single(4), 2, 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], 4, single(2), 2), single([NaN 0 1 2 NaN NaN])); +%!assert(hygeinv ([x, NaN], 4, 2, single(2)), single([NaN 0 1 2 NaN NaN])); + +%% Test input validation +%!error hygeinv () +%!error hygeinv (1) +%!error hygeinv (1,2) +%!error hygeinv (1,2,3) +%!error hygeinv (1,2,3,4,5) +%!error hygeinv (ones(2), ones(3), 1, 1) +%!error hygeinv (1, ones(2), ones(3), 1) +%!error hygeinv (1, 1, ones(2), ones(3)) +%!error hygeinv (i, 2, 2, 2) +%!error hygeinv (2, i, 2, 2) +%!error hygeinv (2, 2, i, 2) +%!error hygeinv (2, 2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/hygepdf.m b/octave_packages/m/statistics/distributions/hygepdf.m new file mode 100644 index 0000000..f53a943 --- /dev/null +++ b/octave_packages/m/statistics/distributions/hygepdf.m @@ -0,0 +1,112 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hygepdf (@var{x}, @var{t}, @var{m}, @var{n}) +## Compute the probability density function (PDF) at @var{x} of the +## hypergeometric distribution with parameters @var{t}, @var{m}, and +## @var{n}. This is the probability of obtaining @var{x} marked items +## when randomly drawing a sample of size @var{n} without replacement +## from a population of total size @var{t} containing @var{m} marked items. +## +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers +## with @var{m} and @var{n} not greater than @var{t}. +## @end deftypefn + +## Author: KH +## Description: PDF of the hypergeometric distribution + +function pdf = hygepdf (x, t, m, n) + + if (nargin != 4) + print_usage (); + endif + + if (!isscalar (t) || !isscalar (m) || !isscalar (n)) + [retval, x, t, m, n] = common_size (x, t, m, n); + if (retval > 0) + error ("hygepdf: X, T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygepdf: X, T, M, and N must not be complex"); + endif + + if (isa (x, "single") || isa (t, "single") || isa (m, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + ## everything in nel gives NaN + nel = (isnan (x) | (t < 0) | (m < 0) | (n <= 0) | (m > t) | (n > t) | + (t != fix (t)) | (m != fix (m)) | (n != fix (n))); + ## everything in zel gives 0 unless in nel + zel = ((x != fix (x)) | (x < 0) | (x > m) | (n < x) | (n-x > t-m)); + + pdf(nel) = NaN; + + k = !nel & !zel; + if (any (k(:))) + if (isscalar (t) && isscalar (m) && isscalar (n)) + pdf(k) = (bincoeff (m, x(k)) .* bincoeff (t-m, n-x(k)) + / bincoeff (t, n)); + else + pdf(k) = (bincoeff (m(k), x(k)) .* bincoeff (t(k)-m(k), n(k)-x(k)) + ./ bincoeff (t(k), n(k))); + endif + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 2 3]; +%! y = [0 1/6 4/6 1/6 0]; +%!assert(hygepdf (x, 4*ones(1,5), 2, 2), y); +%!assert(hygepdf (x, 4, 2*ones(1,5), 2), y); +%!assert(hygepdf (x, 4, 2, 2*ones(1,5)), y); +%!assert(hygepdf (x, 4*[1 -1 NaN 1.1 1], 2, 2), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 2*[1 -1 NaN 1.1 1], 2), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 5, 2), [NaN NaN NaN NaN NaN]); +%!assert(hygepdf (x, 4, 2, 2*[1 -1 NaN 1.1 1]), [0 NaN NaN NaN 0]); +%!assert(hygepdf (x, 4, 2, 5), [NaN NaN NaN NaN NaN]); +%!assert(hygepdf ([x, NaN], 4, 2, 2), [y, NaN], eps); + +%% Test class of input preserved +%!assert(hygepdf (single([x, NaN]), 4, 2, 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], single(4), 2, 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], 4, single(2), 2), single([y, NaN])); +%!assert(hygepdf ([x, NaN], 4, 2, single(2)), single([y, NaN])); + +%% Test input validation +%!error hygepdf () +%!error hygepdf (1) +%!error hygepdf (1,2) +%!error hygepdf (1,2,3) +%!error hygepdf (1,2,3,4,5) +%!error hygepdf (1, ones(3),ones(2),ones(2)) +%!error hygepdf (1, ones(2),ones(3),ones(2)) +%!error hygepdf (1, ones(2),ones(2),ones(3)) +%!error hygepdf (i, 2, 2, 2) +%!error hygepdf (2, i, 2, 2) +%!error hygepdf (2, 2, i, 2) +%!error hygepdf (2, 2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/hygernd.m b/octave_packages/m/statistics/distributions/hygernd.m new file mode 100644 index 0000000..0fc167b --- /dev/null +++ b/octave_packages/m/statistics/distributions/hygernd.m @@ -0,0 +1,148 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1997-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hygernd (@var{t}, @var{m}, @var{n}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{r}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} hygernd (@var{t}, @var{m}, @var{n}, [@var{sz}]) +## Return a matrix of random samples from the hypergeometric distribution +## with parameters @var{t}, @var{m}, and @var{n}. +## +## The parameters @var{t}, @var{m}, and @var{n} must be positive integers +## with @var{m} and @var{n} not greater than @var{t}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{t}, @var{m}, and @var{n}. +## @end deftypefn + +function rnd = hygernd (t, m, n, varargin) + + if (nargin < 3) + print_usage (); + endif + + if (! isscalar (t) || ! isscalar (m) || ! isscalar (n)) + [retval, t, m, n] = common_size (t, m, n); + if (retval > 0) + error ("hygernd: T, M, and N must be of common size or scalars"); + endif + endif + + if (iscomplex (t) || iscomplex (m) || iscomplex (n)) + error ("hygernd: T, M, and N must not be complex"); + endif + + if (nargin == 3) + sz = size (t); + elseif (nargin == 4) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("hygernd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 4) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("hygernd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (t) && !isequal (size (t), sz)) + error ("hygernd: T, M, and N must be scalar or of size SZ"); + endif + + if (isa (t, "single") || isa (m, "single") || isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + ok = ((t >= 0) & (m >= 0) & (n > 0) & (m <= t) & (n <= t) & + (t == fix (t)) & (m == fix (m)) & (n == fix (n))); + + if (isscalar (t)) + if (ok) + v = 0:n; + p = hygepdf (v, t, m, n); + rnd = v(lookup (cumsum (p(1:end-1)) / sum (p), rand (sz)) + 1); + rnd = reshape (rnd, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + rn = rand (sz); + for i = find (ok(:)') # Must be row vector arg to for loop + v = 0 : n(i); + p = hygepdf (v, t(i), m(i), n(i)); + rnd(i) = v(lookup (cumsum (p(1 : end-1)) / sum (p), rn(i)) + 1); + endfor + endif + +endfunction + + +%!assert(size (hygernd (4,2,2)), [1, 1]); +%!assert(size (hygernd (4*ones(2,1), 2,2)), [2, 1]); +%!assert(size (hygernd (4*ones(2,2), 2,2)), [2, 2]); +%!assert(size (hygernd (4, 2*ones(2,1), 2)), [2, 1]); +%!assert(size (hygernd (4, 2*ones(2,2), 2)), [2, 2]); +%!assert(size (hygernd (4, 2, 2*ones(2,1))), [2, 1]); +%!assert(size (hygernd (4, 2, 2*ones(2,2))), [2, 2]); +%!assert(size (hygernd (4, 2, 2, 3)), [3, 3]); +%!assert(size (hygernd (4, 2, 2, [4 1])), [4, 1]); +%!assert(size (hygernd (4, 2, 2, 4, 1)), [4, 1]); + +%!assert(class (hygernd (4,2,2)), "double"); +%!assert(class (hygernd (single(4),2,2)), "single"); +%!assert(class (hygernd (single([4 4]),2,2)), "single"); +%!assert(class (hygernd (4,single(2),2)), "single"); +%!assert(class (hygernd (4,single([2 2]),2)), "single"); +%!assert(class (hygernd (4,2,single(2))), "single"); +%!assert(class (hygernd (4,2,single([2 2]))), "single"); + +%% Test input validation +%!error hygernd () +%!error hygernd (1) +%!error hygernd (1,2) +%!error hygernd (ones(3),ones(2),ones(2), 2) +%!error hygernd (ones(2),ones(3),ones(2), 2) +%!error hygernd (ones(2),ones(2),ones(3), 2) +%!error hygernd (i, 2, 2) +%!error hygernd (2, i, 2) +%!error hygernd (2, 2, i) +%!error hygernd (4,2,2, -1) +%!error hygernd (4,2,2, ones(2)) +%!error hygernd (4,2,2, [2 -1 2]) +%!error hygernd (4*ones(2),2,2, 3) +%!error hygernd (4*ones(2),2,2, [3, 2]) +%!error hygernd (4*ones(2),2,2, 3, 2) + diff --git a/octave_packages/m/statistics/distributions/kolmogorov_smirnov_cdf.m b/octave_packages/m/statistics/distributions/kolmogorov_smirnov_cdf.m new file mode 100644 index 0000000..66ad10e --- /dev/null +++ b/octave_packages/m/statistics/distributions/kolmogorov_smirnov_cdf.m @@ -0,0 +1,95 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} kolmogorov_smirnov_cdf (@var{x}, @var{tol}) +## Return the cumulative distribution function (CDF) at @var{x} of the +## Kolmogorov-Smirnov distribution, +## @tex +## $$ Q(x) = \sum_{k=-\infty}^\infty (-1)^k \exp (-2 k^2 x^2) $$ +## @end tex +## @ifnottex +## +## @example +## @group +## Inf +## Q(x) = SUM (-1)^k exp (-2 k^2 x^2) +## k = -Inf +## @end group +## @end example +## +## @end ifnottex +## @noindent +## for @var{x} > 0. +## +## The optional parameter @var{tol} specifies the precision up to which +## the series should be evaluated; the default is @var{tol} = @code{eps}. +## @end deftypefn + +## Author: KH +## Description: CDF of the Kolmogorov-Smirnov distribution + +function cdf = kolmogorov_smirnov_cdf (x, tol) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin == 1) + if (isa (x, "single")) + tol = eps ("single"); + else + tol = eps; + endif + else + if (! (isscalar (tol) && (tol > 0))) + error ("kolmogorov_smirnov_cdf: TOL must be a positive scalar"); + endif + endif + + if (numel (x) == 0) + error ("kolmogorov_smirnov_cdf: X must not be empty"); + endif + + cdf = zeros (size (x)); + + ind = find (x > 0); + if (length (ind) > 0) + if (columns (ind) < rows (ind)) + y = x(ind.'); + else + y = x(ind); + endif + K = ceil (sqrt (- log (tol) / 2) / min (y)); + k = (1:K)'; + A = exp (- 2 * k.^2 * y.^2); + odd = find (rem (k, 2) == 1); + A(odd,:) = -A(odd,:); + cdf(ind) = 1 + 2 * sum (A); + endif + +endfunction + + +%% Test input validation +%!error kolmogorov_smirnov_cdf () +%!error kolmogorov_smirnov_cdf (1,2,3) +%!error kolmogorov_smirnov_cdf (1, ones(2)) +%!error kolmogorov_smirnov_cdf ([], 1) + diff --git a/octave_packages/m/statistics/distributions/laplace_cdf.m b/octave_packages/m/statistics/distributions/laplace_cdf.m new file mode 100644 index 0000000..6d6fd2a --- /dev/null +++ b/octave_packages/m/statistics/distributions/laplace_cdf.m @@ -0,0 +1,56 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} laplace_cdf (@var{x}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the Laplace distribution. +## @end deftypefn + +## Author: KH +## Description: CDF of the Laplace distribution + +function cdf = laplace_cdf (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("laplace_cdf: X must not be complex"); + endif + + cdf = (1 + sign (x) .* (1 - exp (- abs (x)))) / 2; + +endfunction + + +%!shared x,y +%! x = [-Inf -log(2) 0 log(2) Inf]; +%! y = [0, 1/4, 1/2, 3/4, 1]; +%!assert(laplace_cdf ([x, NaN]), [y, NaN]); + +%% Test class of input preserved +%!assert(laplace_cdf (single([x, NaN])), single([y, NaN])); + +%% Test input validation +%!error laplace_cdf () +%!error laplace_cdf (1,2) +%!error laplace_cdf (i) + diff --git a/octave_packages/m/statistics/distributions/laplace_inv.m b/octave_packages/m/statistics/distributions/laplace_inv.m new file mode 100644 index 0000000..f437238 --- /dev/null +++ b/octave_packages/m/statistics/distributions/laplace_inv.m @@ -0,0 +1,64 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} laplace_inv (@var{x}) +## For each element of @var{x}, compute the quantile (the inverse of the +## CDF) at @var{x} of the Laplace distribution. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the Laplace distribution + +function inv = laplace_inv (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("laplace_inv: X must not be complex"); + endif + + if (isa (x, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x >= 0) & (x <= 1); + inv(k) = ((x(k) < 1/2) .* log (2 * x(k)) + - (x(k) > 1/2) .* log (2 * (1 - x(k)))); + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(laplace_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(laplace_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(laplace_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error laplace_inv () +%!error laplace_inv (1,2) +%!error laplace_inv (i) + diff --git a/octave_packages/m/statistics/distributions/laplace_pdf.m b/octave_packages/m/statistics/distributions/laplace_pdf.m new file mode 100644 index 0000000..146aada --- /dev/null +++ b/octave_packages/m/statistics/distributions/laplace_pdf.m @@ -0,0 +1,56 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} laplace_pdf (@var{x}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the Laplace distribution. +## @end deftypefn + +## Author: KH +## Description: PDF of the Laplace distribution + +function pdf = laplace_pdf (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("laplace_pdf: X must not be complex"); + endif + + pdf = exp (- abs (x)) / 2; + +endfunction + + +%!shared x,y +%! x = [-Inf -log(2) 0 log(2) Inf]; +%! y = [0, 1/4, 1/2, 1/4, 0]; +%!assert(laplace_pdf ([x, NaN]), [y, NaN]); + +%% Test class of input preserved +%!assert(laplace_pdf (single([x, NaN])), single([y, NaN])); + +%% Test input validation +%!error laplace_pdf () +%!error laplace_pdf (1,2) +%!error laplace_pdf (i) + diff --git a/octave_packages/m/statistics/distributions/laplace_rnd.m b/octave_packages/m/statistics/distributions/laplace_rnd.m new file mode 100644 index 0000000..0dbbd79 --- /dev/null +++ b/octave_packages/m/statistics/distributions/laplace_rnd.m @@ -0,0 +1,74 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} laplace_rnd (@var{r}) +## @deftypefnx {Function File} {} laplace_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} laplace_rnd ([@var{sz}]) +## Return a matrix of random samples from the Laplace distribution. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the Laplace distribution + +function rnd = laplace_rnd (varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}(:)'; + else + error ("laplace_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("laplace_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + tmp = rand (sz); + rnd = (tmp < 1/2) .* log (2 * tmp) - (tmp > 1/2) .* log (2 * (1 - tmp)); + +endfunction + + +%!assert(size (laplace_rnd (3)), [3, 3]); +%!assert(size (laplace_rnd ([4 1])), [4, 1]); +%!assert(size (laplace_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error laplace_rnd () +%!error laplace_rnd (-1) +%!error laplace_rnd (ones(2)) +%!error laplace_rnd ([2 -1 2]) +%!error laplace_rnd (1, ones(2)) +%!error laplace_rnd (1, -1) + diff --git a/octave_packages/m/statistics/distributions/logistic_cdf.m b/octave_packages/m/statistics/distributions/logistic_cdf.m new file mode 100644 index 0000000..8db8b8c --- /dev/null +++ b/octave_packages/m/statistics/distributions/logistic_cdf.m @@ -0,0 +1,56 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} logistic_cdf (@var{x}) +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the logistic distribution. +## @end deftypefn + +## Author: KH +## Description: CDF of the logistic distribution + +function cdf = logistic_cdf (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("logistic_cdf: X must not be complex"); + endif + + cdf = 1 ./ (1 + exp (-x)); + +endfunction + + +%!shared x,y +%! x = [-Inf -log(3) 0 log(3) Inf]; +%! y = [0, 1/4, 1/2, 3/4, 1]; +%!assert(logistic_cdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(logistic_cdf (single([x, NaN])), single([y, NaN]), eps ("single")); + +%% Test input validation +%!error logistic_cdf () +%!error logistic_cdf (1,2) +%!error logistic_cdf (i) + diff --git a/octave_packages/m/statistics/distributions/logistic_inv.m b/octave_packages/m/statistics/distributions/logistic_inv.m new file mode 100644 index 0000000..8a634fa --- /dev/null +++ b/octave_packages/m/statistics/distributions/logistic_inv.m @@ -0,0 +1,69 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} logistic_inv (@var{x}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the logistic distribution. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the logistic distribution + +function inv = logistic_inv (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("logistic_inv: X must not be complex"); + endif + + if (isa (x, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x == 0); + inv(k) = -Inf; + + k = (x == 1); + inv(k) = Inf; + + k = (x > 0) & (x < 1); + inv(k) = - log (1 ./ x(k) - 1); + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(logistic_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(logistic_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(logistic_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error logistic_inv () +%!error logistic_inv (1,2) +%!error logistic_inv (i) + diff --git a/octave_packages/m/statistics/distributions/logistic_pdf.m b/octave_packages/m/statistics/distributions/logistic_pdf.m new file mode 100644 index 0000000..fd5ae6b --- /dev/null +++ b/octave_packages/m/statistics/distributions/logistic_pdf.m @@ -0,0 +1,56 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} logistic_pdf (@var{x}) +## For each element of @var{x}, compute the PDF at @var{x} of the +## logistic distribution. +## @end deftypefn + +## Author: KH +## Description: PDF of the logistic distribution + +function pdf = logistic_pdf (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("logistic_pdf: X must not be complex"); + endif + + cdf = logistic_cdf (x); + pdf = cdf .* (1 - cdf); + +endfunction + + +%!shared x,y +%! x = [-Inf -log(4) 0 log(4) Inf]; +%! y = [0, 0.16, 1/4, 0.16, 0]; +%!assert(logistic_pdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(logistic_pdf (single([x, NaN])), single([y, NaN]), eps ("single")); + +%% Test input validation +%!error logistic_pdf () +%!error logistic_pdf (1,2) +%!error logistic_pdf (i) + diff --git a/octave_packages/m/statistics/distributions/logistic_rnd.m b/octave_packages/m/statistics/distributions/logistic_rnd.m new file mode 100644 index 0000000..5809b2b --- /dev/null +++ b/octave_packages/m/statistics/distributions/logistic_rnd.m @@ -0,0 +1,73 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} logistic_rnd (@var{r}) +## @deftypefnx {Function File} {} logistic_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} logistic_rnd ([@var{sz}]) +## Return a matrix of random samples from the logistic distribution. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the logistic distribution + +function rnd = logistic_rnd (varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("logistic_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("logistic_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + rnd = - log (1 ./ rand (sz) - 1); + +endfunction + + +%!assert(size (logistic_rnd (3)), [3, 3]); +%!assert(size (logistic_rnd ([4 1])), [4, 1]); +%!assert(size (logistic_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error logistic_rnd () +%!error logistic_rnd (-1) +%!error logistic_rnd (ones(2)) +%!error logistic_rnd ([2 -1 2]) +%!error logistic_rnd (1, ones(2)) +%!error logistic_rnd (1, -1) + diff --git a/octave_packages/m/statistics/distributions/logncdf.m b/octave_packages/m/statistics/distributions/logncdf.m new file mode 100644 index 0000000..d0b8a44 --- /dev/null +++ b/octave_packages/m/statistics/distributions/logncdf.m @@ -0,0 +1,100 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} logncdf (@var{x}) +## @deftypefnx {Function File} {} logncdf (@var{x}, @var{mu}, @var{sigma}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the lognormal distribution with +## parameters @var{mu} and @var{sigma}. If a random variable follows this +## distribution, its logarithm is normally distributed with mean +## @var{mu} and standard deviation @var{sigma}. +## +## Default values are @var{mu} = 1, @var{sigma} = 1. +## @end deftypefn + +## Author: KH +## Description: CDF of the log normal distribution + +function cdf = logncdf (x, mu = 0, sigma = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); + if (retval > 0) + error ("logncdf: X, MU, and SIGMA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("logncdf: X, MU, and SIGMA must not be complex"); + endif + + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(sigma > 0) | !(sigma < Inf); + cdf(k) = NaN; + + k = (x == Inf) & (sigma > 0) & (sigma < Inf); + cdf(k) = 1; + + k = (x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + cdf(k) = stdnormal_cdf ((log (x(k)) - mu) / sigma); + else + cdf(k) = stdnormal_cdf ((log (x(k)) - mu(k)) ./ sigma(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 e Inf]; +%! y = [0, 0, 0.5, 1/2+1/2*erf(1/2), 1]; +%!assert(logncdf (x, zeros(1,5), sqrt(2)*ones(1,5)), y); +%!assert(logncdf (x, 0, sqrt(2)*ones(1,5)), y); +%!assert(logncdf (x, zeros(1,5), sqrt(2)), y); +%!assert(logncdf (x, [0 1 NaN 0 1], sqrt(2)), [0 0 NaN y(4:5)]); +%!assert(logncdf (x, 0, sqrt(2)*[0 NaN Inf 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(logncdf ([x(1:3) NaN x(5)], 0, sqrt(2)), [y(1:3) NaN y(5)]); + +%% Test class of input preserved +%!assert(logncdf ([x, NaN], 0, sqrt(2)), [y, NaN]); +%!assert(logncdf (single([x, NaN]), 0, sqrt(2)), single([y, NaN]), eps("single")); +%!assert(logncdf ([x, NaN], single(0), sqrt(2)), single([y, NaN]), eps("single")); +%!assert(logncdf ([x, NaN], 0, single(sqrt(2))), single([y, NaN]), eps("single")); + +%% Test input validation +%!error logncdf () +%!error logncdf (1,2) +%!error logncdf (1,2,3,4) +%!error logncdf (ones(3),ones(2),ones(2)) +%!error logncdf (ones(2),ones(3),ones(2)) +%!error logncdf (ones(2),ones(2),ones(3)) +%!error logncdf (i, 2, 2) +%!error logncdf (2, i, 2) +%!error logncdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/logninv.m b/octave_packages/m/statistics/distributions/logninv.m new file mode 100644 index 0000000..0332ecd --- /dev/null +++ b/octave_packages/m/statistics/distributions/logninv.m @@ -0,0 +1,99 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} logninv (@var{x}) +## @deftypefnx {Function File} {} logninv (@var{x}, @var{mu}, @var{sigma}) +## For each element of @var{x}, compute the quantile (the inverse of the +## CDF) at @var{x} of the lognormal distribution with parameters @var{mu} +## and @var{sigma}. If a random variable follows this distribution, its +## logarithm is normally distributed with mean @code{log (@var{mu})} and +## variance @var{sigma}. +## +## Default values are @var{mu} = 1, @var{sigma} = 1. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the log normal distribution + +function inv = logninv (x, mu = 0, sigma = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); + if (retval > 0) + error ("logninv: X, MU, and SIGMA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("logninv: X, MU, and SIGMA must not be complex"); + endif + + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = !(x >= 0) | !(x <= 1) | !(sigma > 0) | !(sigma < Inf); + inv(k) = NaN; + + k = (x == 1) & (sigma > 0) & (sigma < Inf); + inv(k) = Inf; + + k = (x >= 0) & (x < 1) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + inv(k) = exp (mu) .* exp (sigma .* stdnormal_inv (x(k))); + else + inv(k) = exp (mu(k)) .* exp (sigma(k) .* stdnormal_inv (x(k))); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(logninv (x, ones(1,5), ones(1,5)), [NaN 0 e Inf NaN]); +%!assert(logninv (x, 1, ones(1,5)), [NaN 0 e Inf NaN]); +%!assert(logninv (x, ones(1,5), 1), [NaN 0 e Inf NaN]); +%!assert(logninv (x, [1 1 NaN 0 1], 1), [NaN 0 NaN Inf NaN]); +%!assert(logninv (x, 1, [1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(logninv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(logninv ([x, NaN], 1, 1), [NaN 0 e Inf NaN NaN]); +%!assert(logninv (single([x, NaN]), 1, 1), single([NaN 0 e Inf NaN NaN])); +%!assert(logninv ([x, NaN], single(1), 1), single([NaN 0 e Inf NaN NaN])); +%!assert(logninv ([x, NaN], 1, single(1)), single([NaN 0 e Inf NaN NaN])); + +%% Test input validation +%!error logninv () +%!error logninv (1,2) +%!error logninv (1,2,3,4) +%!error logninv (ones(3),ones(2),ones(2)) +%!error logninv (ones(2),ones(3),ones(2)) +%!error logninv (ones(2),ones(2),ones(3)) +%!error logninv (i, 2, 2) +%!error logninv (2, i, 2) +%!error logninv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/lognpdf.m b/octave_packages/m/statistics/distributions/lognpdf.m new file mode 100644 index 0000000..6c8f55e --- /dev/null +++ b/octave_packages/m/statistics/distributions/lognpdf.m @@ -0,0 +1,96 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} lognpdf (@var{x}) +## @deftypefnx {Function File} {} lognpdf (@var{x}, @var{mu}, @var{sigma}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the lognormal distribution with parameters +## @var{mu} and @var{sigma}. If a random variable follows this distribution, +## its logarithm is normally distributed with mean @var{mu} +## and standard deviation @var{sigma}. +## +## Default values are @var{mu} = 1, @var{sigma} = 1. +## @end deftypefn + +## Author: KH +## Description: PDF of the log normal distribution + +function pdf = lognpdf (x, mu = 0, sigma = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); + if (retval > 0) + error ("lognpdf: X, MU, and SIGMA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("lognpdf: X, MU, and SIGMA must not be complex"); + endif + + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(sigma > 0) | !(sigma < Inf); + pdf(k) = NaN; + + k = (x > 0) & (x < Inf) & (sigma > 0) & (sigma < Inf); + if (isscalar (mu) && isscalar (sigma)) + pdf(k) = normpdf (log (x(k)), mu, sigma) ./ x(k); + else + pdf(k) = normpdf (log (x(k)), mu(k), sigma(k)) ./ x(k); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 e Inf]; +%! y = [0, 0, 1/(e*sqrt(2*pi)) * exp(-1/2), 0]; +%!assert(lognpdf (x, zeros(1,4), ones(1,4)), y, eps); +%!assert(lognpdf (x, 0, ones(1,4)), y, eps); +%!assert(lognpdf (x, zeros(1,4), 1), y, eps); +%!assert(lognpdf (x, [0 1 NaN 0], 1), [0 0 NaN y(4)], eps); +%!assert(lognpdf (x, 0, [0 NaN Inf 1]), [NaN NaN NaN y(4)], eps); +%!assert(lognpdf ([x, NaN], 0, 1), [y, NaN], eps); + +%% Test class of input preserved +%!assert(lognpdf (single([x, NaN]), 0, 1), single([y, NaN]), eps("single")); +%!assert(lognpdf ([x, NaN], single(0), 1), single([y, NaN]), eps("single")); +%!assert(lognpdf ([x, NaN], 0, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error lognpdf () +%!error lognpdf (1,2) +%!error lognpdf (1,2,3,4) +%!error lognpdf (ones(3),ones(2),ones(2)) +%!error lognpdf (ones(2),ones(3),ones(2)) +%!error lognpdf (ones(2),ones(2),ones(3)) +%!error lognpdf (i, 2, 2) +%!error lognpdf (2, i, 2) +%!error lognpdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/lognrnd.m b/octave_packages/m/statistics/distributions/lognrnd.m new file mode 100644 index 0000000..6b062f5 --- /dev/null +++ b/octave_packages/m/statistics/distributions/lognrnd.m @@ -0,0 +1,132 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} lognrnd (@var{mu}, @var{sigma}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{r}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} lognrnd (@var{mu}, @var{sigma}, [@var{sz}]) +## Return a matrix of random samples from the lognormal distribution with +## parameters @var{mu} and @var{sigma}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{mu} and @var{sigma}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the log normal distribution + +function rnd = lognrnd (mu, sigma, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, mu, sigma] = common_size (mu, sigma); + if (retval > 0) + error ("lognrnd: MU and SIGMA must be of common size or scalars"); + endif + endif + + if (iscomplex (mu) || iscomplex (sigma)) + error ("lognrnd: MU and SIGMA must not be complex"); + endif + + if (nargin == 2) + sz = size (mu); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("lognrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("lognrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (mu) && !isequal (size (mu), sz)) + error ("lognrnd: MU and SIGMA must be scalar or of size SZ"); + endif + + if (isa (mu, "single") || isa (sigma, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (mu) && isscalar (sigma)) + if ((sigma > 0) && (sigma < Inf)) + rnd = exp (mu + sigma * randn (sz)); + else + rnd = NaN (sz, cls); + endif + else + rnd = exp (mu + sigma .* randn (sz)); + + k = (sigma < 0) | (sigma == Inf); + rnd(k) = NaN; + endif + +endfunction + + +%!assert(size (lognrnd (1,2)), [1, 1]); +%!assert(size (lognrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (lognrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (lognrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (lognrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (lognrnd (1, 2, 3)), [3, 3]); +%!assert(size (lognrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (lognrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (lognrnd (1, 2)), "double"); +%!assert(class (lognrnd (single(1), 2)), "single"); +%!assert(class (lognrnd (single([1 1]), 2)), "single"); +%!assert(class (lognrnd (1, single(2))), "single"); +%!assert(class (lognrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error lognrnd () +%!error lognrnd (1) +%!error lognrnd (ones(3),ones(2)) +%!error lognrnd (ones(2),ones(3)) +%!error lognrnd (i, 2) +%!error lognrnd (2, i) +%!error lognrnd (1,2, -1) +%!error lognrnd (1,2, ones(2)) +%!error lognrnd (1, 2, [2 -1 2]) +%!error lognrnd (1,2, 1, ones(2)) +%!error lognrnd (1,2, 1, -1) +%!error lognrnd (ones(2,2), 2, 3) +%!error lognrnd (ones(2,2), 2, [3, 2]) +%!error lognrnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/nbincdf.m b/octave_packages/m/statistics/distributions/nbincdf.m new file mode 100644 index 0000000..d7001f6 --- /dev/null +++ b/octave_packages/m/statistics/distributions/nbincdf.m @@ -0,0 +1,105 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nbincdf (@var{x}, @var{n}, @var{p}) +## For each element of @var{x}, compute the cumulative distribution function +## (CDF) at @var{x} of the negative binomial distribution with +## parameters @var{n} and @var{p}. +## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## +## The number of failures in a Bernoulli experiment with success +## probability @var{p} before the @var{n}-th success follows this +## distribution. +## @end deftypefn + +## Author: KH +## Description: CDF of the Pascal (negative binomial) distribution + +function cdf = nbincdf (x, n, p) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, x, n, p] = common_size (x, n, p); + if (retval > 0) + error ("nbincdf: X, N, and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbincdf: X, N, and P must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = (isnan (x) | isnan (n) | (n < 1) | (n == Inf) + | (p < 0) | (p > 1) | isnan (p)); + cdf(k) = NaN; + + k = (x == Inf) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + cdf(k) = 1; + + k = ((x >= 0) & (x < Inf) & (x == fix (x)) + & (n > 0) & (n < Inf) & (p > 0) & (p <= 1)); + if (isscalar (n) && isscalar (p)) + cdf(k) = 1 - betainc (1-p, x(k)+1, n); + else + cdf(k) = 1 - betainc (1-p(k), x(k)+1, n(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0 1/2 3/4 7/8 1]; +%!assert(nbincdf (x, ones(1,5), 0.5*ones(1,5)), y); +%!assert(nbincdf (x, 1, 0.5*ones(1,5)), y); +%!assert(nbincdf (x, ones(1,5), 0.5), y); +%!assert(nbincdf ([x(1:3) 0 x(5)], [0 1 NaN 1.5 Inf], 0.5), [NaN 1/2 NaN nbinpdf(0,1.5,0.5) NaN], eps); +%!assert(nbincdf (x, 1, 0.5*[-1 NaN 4 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(nbincdf ([x(1:2) NaN x(4:5)], 1, 0.5), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(nbincdf ([x, NaN], 1, 0.5), [y, NaN]); +%!assert(nbincdf (single([x, NaN]), 1, 0.5), single([y, NaN])); +%!assert(nbincdf ([x, NaN], single(1), 0.5), single([y, NaN])); +%!assert(nbincdf ([x, NaN], 1, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error nbincdf () +%!error nbincdf (1) +%!error nbincdf (1,2) +%!error nbincdf (1,2,3,4) +%!error nbincdf (ones(3),ones(2),ones(2)) +%!error nbincdf (ones(2),ones(3),ones(2)) +%!error nbincdf (ones(2),ones(2),ones(3)) +%!error nbincdf (i, 2, 2) +%!error nbincdf (2, i, 2) +%!error nbincdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/nbininv.m b/octave_packages/m/statistics/distributions/nbininv.m new file mode 100644 index 0000000..98341d3 --- /dev/null +++ b/octave_packages/m/statistics/distributions/nbininv.m @@ -0,0 +1,128 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nbininv (@var{x}, @var{n}, @var{p}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the negative binomial distribution +## with parameters @var{n} and @var{p}. +## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## +## The number of failures in a Bernoulli experiment with success +## probability @var{p} before the @var{n}-th success follows this +## distribution. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the Pascal distribution + +function inv = nbininv (x, n, p) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, x, n, p] = common_size (x, n, p); + if (retval > 0) + error ("nbininv: X, N, and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbininv: X, N, and P must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); + endif + + k = (isnan (x) | (x < 0) | (x > 1) | isnan (n) | (n < 1) | (n == Inf) + | isnan (p) | (p < 0) | (p > 1)); + inv(k) = NaN; + + k = (x == 1) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + inv(k) = Inf; + + k = find ((x >= 0) & (x < 1) & (n > 0) & (n < Inf) + & (p > 0) & (p <= 1)); + m = zeros (size (k)); + x = x(k); + if (isscalar (n) && isscalar (p)) + s = p ^ n * ones (size (k)); + while (1) + l = find (s < x); + if (any (l)) + m(l) = m(l) + 1; + s(l) = s(l) + nbinpdf (m(l), n, p); + else + break; + endif + endwhile + else + n = n(k); + p = p(k); + s = p .^ n; + while (1) + l = find (s < x); + if (any (l)) + m(l) = m(l) + 1; + s(l) = s(l) + nbinpdf (m(l), n(l), p(l)); + else + break; + endif + endwhile + endif + inv(k) = m; + +endfunction + + +%!shared x +%! x = [-1 0 3/4 1 2]; +%!assert(nbininv (x, ones(1,5), 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, 1, 0.5*ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, ones(1,5), 0.5), [NaN 0 1 Inf NaN]); +%!assert(nbininv (x, [1 0 NaN Inf 1], 0.5), [NaN NaN NaN NaN NaN]); +%!assert(nbininv (x, [1 0 1.5 Inf 1], 0.5), [NaN NaN 2 NaN NaN]); +%!assert(nbininv (x, 1, 0.5*[1 -Inf NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(nbininv ([x(1:2) NaN x(4:5)], 1, 0.5), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(nbininv ([x, NaN], 1, 0.5), [NaN 0 1 Inf NaN NaN]); +%!assert(nbininv (single([x, NaN]), 1, 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(nbininv ([x, NaN], single(1), 0.5), single([NaN 0 1 Inf NaN NaN])); +%!assert(nbininv ([x, NaN], 1, single(0.5)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error nbininv () +%!error nbininv (1) +%!error nbininv (1,2) +%!error nbininv (1,2,3,4) +%!error nbininv (ones(3),ones(2),ones(2)) +%!error nbininv (ones(2),ones(3),ones(2)) +%!error nbininv (ones(2),ones(2),ones(3)) +%!error nbininv (i, 2, 2) +%!error nbininv (2, i, 2) +%!error nbininv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/nbinpdf.m b/octave_packages/m/statistics/distributions/nbinpdf.m new file mode 100644 index 0000000..c8af895 --- /dev/null +++ b/octave_packages/m/statistics/distributions/nbinpdf.m @@ -0,0 +1,102 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nbinpdf (@var{x}, @var{n}, @var{p}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the negative binomial distribution with +## parameters @var{n} and @var{p}. +## +## When @var{n} is integer this is the Pascal distribution. When +## @var{n} is extended to real numbers this is the Polya distribution. +## +## The number of failures in a Bernoulli experiment with success +## probability @var{p} before the @var{n}-th success follows this +## distribution. +## @end deftypefn + +## Author: KH +## Description: PDF of the Pascal (negative binomial) distribution + +function pdf = nbinpdf (x, n, p) + + if (nargin != 3) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, x, n, p] = common_size (x, n, p); + if (retval > 0) + error ("nbinpdf: X, N, and P must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n) || iscomplex (p)) + error ("nbinpdf: X, N, and P must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single") || isa (p, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); + endif + + ok = (x < Inf) & (x == fix (x)) & (n > 0) & (n < Inf) & (p >= 0) & (p <= 1); + + k = (x < 0) & ok; + pdf(k) = 0; + + k = (x >= 0) & ok; + if (isscalar (n) && isscalar (p)) + pdf(k) = bincoeff (-n, x(k)) .* (p ^ n) .* ((p - 1) .^ x(k)); + else + pdf(k) = bincoeff (-n(k), x(k)) .* (p(k) .^ n(k)) .* ((p(k) - 1) .^ x(k)); + endif + + +endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0 1/2 1/4 1/8 NaN]; +%!assert(nbinpdf (x, ones(1,5), 0.5*ones(1,5)), y); +%!assert(nbinpdf (x, 1, 0.5*ones(1,5)), y); +%!assert(nbinpdf (x, ones(1,5), 0.5), y); +%!assert(nbinpdf (x, [0 1 NaN 1.5 Inf], 0.5), [NaN 1/2 NaN 1.875*0.5^1.5/4 NaN], eps); +%!assert(nbinpdf (x, 1, 0.5*[-1 NaN 4 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(nbinpdf ([x, NaN], 1, 0.5), [y, NaN]); + +%% Test class of input preserved +%!assert(nbinpdf (single([x, NaN]), 1, 0.5), single([y, NaN])); +%!assert(nbinpdf ([x, NaN], single(1), 0.5), single([y, NaN])); +%!assert(nbinpdf ([x, NaN], 1, single(0.5)), single([y, NaN])); + +%% Test input validation +%!error nbinpdf () +%!error nbinpdf (1) +%!error nbinpdf (1,2) +%!error nbinpdf (1,2,3,4) +%!error nbinpdf (ones(3),ones(2),ones(2)) +%!error nbinpdf (ones(2),ones(3),ones(2)) +%!error nbinpdf (ones(2),ones(2),ones(3)) +%!error nbinpdf (i, 2, 2) +%!error nbinpdf (2, i, 2) +%!error nbinpdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/nbinrnd.m b/octave_packages/m/statistics/distributions/nbinrnd.m new file mode 100644 index 0000000..e50cf06 --- /dev/null +++ b/octave_packages/m/statistics/distributions/nbinrnd.m @@ -0,0 +1,140 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} nbinrnd (@var{n}, @var{p}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, @var{r}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} nbinrnd (@var{n}, @var{p}, [@var{sz}]) +## Return a matrix of random samples from the negative binomial +## distribution with parameters @var{n} and @var{p}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{n} and @var{p}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the Pascal distribution + +function rnd = nbinrnd (n, p, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (n) || !isscalar (p)) + [retval, n, p] = common_size (n, p); + if (retval > 0) + error ("nbinrnd: N and P must be of common size or scalars"); + endif + endif + + if (iscomplex (n) || iscomplex (p)) + error ("nbinrnd: N and P must not be complex"); + endif + + if (nargin == 2) + sz = size (n); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("nbinrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("nbinrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("nbinrnd: N and P must be scalar or of size SZ"); + endif + + if (isa (n, "single") || isa (p, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n) && isscalar (p)) + if ((n > 0) && (n < Inf) && (p > 0) && (p <= 1)) + rnd = randp ((1 - p) ./ p .* randg (n, sz)); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + elseif ((n > 0) && (n < Inf) && (p == 0)) + rnd = zeros (sz, cls); + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = (n > 0) & (n < Inf) & (p == 0); + rnd(k) = 0; + + k = (n > 0) & (n < Inf) & (p > 0) & (p <= 1); + rnd(k) = randp ((1 - p(k)) ./ p(k) .* randg (n(k))); + endif + +endfunction + + +%!assert(size (nbinrnd (2, 1/2)), [1, 1]); +%!assert(size (nbinrnd (2*ones(2,1), 1/2)), [2, 1]); +%!assert(size (nbinrnd (2*ones(2,2), 1/2)), [2, 2]); +%!assert(size (nbinrnd (2, 1/2*ones(2,1))), [2, 1]); +%!assert(size (nbinrnd (2, 1/2*ones(2,2))), [2, 2]); +%!assert(size (nbinrnd (2, 1/2, 3)), [3, 3]); +%!assert(size (nbinrnd (2, 1/2, [4 1])), [4, 1]); +%!assert(size (nbinrnd (2, 1/2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (nbinrnd (2, 1/2)), "double"); +%!assert(class (nbinrnd (single(2), 1/2)), "single"); +%!assert(class (nbinrnd (single([2 2]), 1/2)), "single"); +%!assert(class (nbinrnd (2, single(1/2))), "single"); +%!assert(class (nbinrnd (2, single([1/2 1/2]))), "single"); + +%% Test input validation +%!error nbinrnd () +%!error nbinrnd (1) +%!error nbinrnd (ones(3),ones(2)) +%!error nbinrnd (ones(2),ones(3)) +%!error nbinrnd (i, 2) +%!error nbinrnd (2, i) +%!error nbinrnd (1,2, -1) +%!error nbinrnd (1,2, ones(2)) +%!error nbinrnd (1, 2, [2 -1 2]) +%!error nbinrnd (1,2, 1, ones(2)) +%!error nbinrnd (1,2, 1, -1) +%!error nbinrnd (ones(2,2), 2, 3) +%!error nbinrnd (ones(2,2), 2, [3, 2]) +%!error nbinrnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/normcdf.m b/octave_packages/m/statistics/distributions/normcdf.m new file mode 100644 index 0000000..f329407 --- /dev/null +++ b/octave_packages/m/statistics/distributions/normcdf.m @@ -0,0 +1,99 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} normcdf (@var{x}) +## @deftypefnx {Function File} {} normcdf (@var{x}, @var{mu}, @var{sigma}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the normal distribution with mean +## @var{mu} and standard deviation @var{sigma}. +## +## Default values are @var{mu} = 0, @var{sigma} = 1. +## @end deftypefn + +## Author: TT +## Description: CDF of the normal distribution + +function cdf = normcdf (x, mu = 0, sigma = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); + if (retval > 0) + error ("normcdf: X, MU, and SIGMA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("normcdf: X, MU, and SIGMA must not be complex"); + endif + + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")); + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + cdf = stdnormal_cdf ((x - mu) / sigma); + else + cdf = NaN (size (x), class (cdf)); + endif + else + k = isinf (mu) | isnan (mu) | !(sigma > 0) | !(sigma < Inf); + cdf(k) = NaN; + + k = ! k; + cdf(k) = stdnormal_cdf ((x(k) - mu(k)) ./ sigma(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-Inf 1 2 Inf]; +%! y = [0, 0.5, 1/2*(1+erf(1/sqrt(2))), 1]; +%!assert(normcdf (x, ones(1,4), ones(1,4)), y); +%!assert(normcdf (x, 1, ones(1,4)), y); +%!assert(normcdf (x, ones(1,4), 1), y); +%!assert(normcdf (x, [0 -Inf NaN Inf], 1), [y(1) NaN NaN NaN]); +%!assert(normcdf (x, 1, [Inf NaN -1 0]), [NaN NaN NaN NaN]); +%!assert(normcdf ([x(1:2) NaN x(4)], 1, 1), [y(1:2) NaN y(4)]); + +%% Test class of input preserved +%!assert(normcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(normcdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); +%!assert(normcdf ([x, NaN], single(1), 1), single([y, NaN]), eps("single")); +%!assert(normcdf ([x, NaN], 1, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error normcdf () +%!error normcdf (1,2) +%!error normcdf (1,2,3,4) +%!error normcdf (ones(3),ones(2),ones(2)) +%!error normcdf (ones(2),ones(3),ones(2)) +%!error normcdf (ones(2),ones(2),ones(3)) +%!error normcdf (i, 2, 2) +%!error normcdf (2, i, 2) +%!error normcdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/norminv.m b/octave_packages/m/statistics/distributions/norminv.m new file mode 100644 index 0000000..cee4a83 --- /dev/null +++ b/octave_packages/m/statistics/distributions/norminv.m @@ -0,0 +1,93 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} norminv (@var{x}) +## @deftypefnx {Function File} {} norminv (@var{x}, @var{mu}, @var{sigma}) +## For each element of @var{x}, compute the quantile (the inverse of the +## CDF) at @var{x} of the normal distribution with mean @var{mu} and +## standard deviation @var{sigma}. +## +## Default values are @var{mu} = 0, @var{sigma} = 1. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the normal distribution + +function inv = norminv (x, mu = 0, sigma = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); + if (retval > 0) + error ("norminv: X, MU, and SIGMA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("norminv: X, MU, and SIGMA must not be complex"); + endif + + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + inv = mu + sigma * stdnormal_inv (x); + endif + else + k = !isinf (mu) & !isnan (mu) & (sigma > 0) & (sigma < Inf); + inv(k) = mu(k) + sigma(k) .* stdnormal_inv (x(k)); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(norminv (x, ones(1,5), ones(1,5)), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, 1, ones(1,5)), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, ones(1,5), 1), [NaN -Inf 1 Inf NaN]); +%!assert(norminv (x, [1 -Inf NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(norminv (x, 1, [1 0 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(norminv ([x(1:2) NaN x(4:5)], 1, 1), [NaN -Inf NaN Inf NaN]); + +%% Test class of input preserved +%!assert(norminv ([x, NaN], 1, 1), [NaN -Inf 1 Inf NaN NaN]); +%!assert(norminv (single([x, NaN]), 1, 1), single([NaN -Inf 1 Inf NaN NaN])); +%!assert(norminv ([x, NaN], single(1), 1), single([NaN -Inf 1 Inf NaN NaN])); +%!assert(norminv ([x, NaN], 1, single(1)), single([NaN -Inf 1 Inf NaN NaN])); + +%% Test input validation +%!error norminv () +%!error norminv (1,2) +%!error norminv (1,2,3,4) +%!error norminv (ones(3),ones(2),ones(2)) +%!error norminv (ones(2),ones(3),ones(2)) +%!error norminv (ones(2),ones(2),ones(3)) +%!error norminv (i, 2, 2) +%!error norminv (2, i, 2) +%!error norminv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/normpdf.m b/octave_packages/m/statistics/distributions/normpdf.m new file mode 100644 index 0000000..64a0a28 --- /dev/null +++ b/octave_packages/m/statistics/distributions/normpdf.m @@ -0,0 +1,98 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} normpdf (@var{x}) +## @deftypefnx {Function File} {} normpdf (@var{x}, @var{mu}, @var{sigma}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the normal distribution with mean @var{mu} and +## standard deviation @var{sigma}. +## +## Default values are @var{mu} = 0, @var{sigma} = 1. +## @end deftypefn + +## Author: TT +## Description: PDF of the normal distribution + +function pdf = normpdf (x, mu = 0, sigma = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, x, mu, sigma] = common_size (x, mu, sigma); + if (retval > 0) + error ("normpdf: X, MU, and SIGMA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (mu) || iscomplex (sigma)) + error ("normpdf: X, MU, and SIGMA must not be complex"); + endif + + if (isa (x, "single") || isa (mu, "single") || isa (sigma, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isinf (mu) && !isnan (mu) && (sigma > 0) && (sigma < Inf)) + pdf = stdnormal_pdf ((x - mu) / sigma) / sigma; + else + pdf = NaN (size (x), class (pdf)); + endif + else + k = isinf (mu) | !(sigma > 0) | !(sigma < Inf); + pdf(k) = NaN; + + k = !isinf (mu) & (sigma > 0) & (sigma < Inf); + pdf(k) = stdnormal_pdf ((x(k) - mu(k)) ./ sigma(k)) ./ sigma(k); + endif + +endfunction + + +%!shared x,y +%! x = [-Inf 1 2 Inf]; +%! y = 1/sqrt(2*pi)*exp (-(x-1).^2/2); +%!assert(normpdf (x, ones(1,4), ones(1,4)), y); +%!assert(normpdf (x, 1, ones(1,4)), y); +%!assert(normpdf (x, ones(1,4), 1), y); +%!assert(normpdf (x, [0 -Inf NaN Inf], 1), [y(1) NaN NaN NaN]); +%!assert(normpdf (x, 1, [Inf NaN -1 0]), [NaN NaN NaN NaN]); +%!assert(normpdf ([x, NaN], 1, 1), [y, NaN]); + +%% Test class of input preserved +%!assert(normpdf (single([x, NaN]), 1, 1), single([y, NaN]), eps("single")); +%!assert(normpdf ([x, NaN], single(1), 1), single([y, NaN]), eps("single")); +%!assert(normpdf ([x, NaN], 1, single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error normpdf () +%!error normpdf (1,2) +%!error normpdf (1,2,3,4) +%!error normpdf (ones(3),ones(2),ones(2)) +%!error normpdf (ones(2),ones(3),ones(2)) +%!error normpdf (ones(2),ones(2),ones(3)) +%!error normpdf (i, 2, 2) +%!error normpdf (2, i, 2) +%!error normpdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/normrnd.m b/octave_packages/m/statistics/distributions/normrnd.m new file mode 100644 index 0000000..abee242 --- /dev/null +++ b/octave_packages/m/statistics/distributions/normrnd.m @@ -0,0 +1,131 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} normrnd (@var{mu}, @var{sigma}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, @var{r}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} normrnd (@var{mu}, @var{sigma}, [@var{sz}]) +## Return a matrix of random samples from the normal distribution with +## parameters mean @var{mu} and standard deviation @var{sigma}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{mu} and @var{sigma}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the normal distribution + +function rnd = normrnd (mu, sigma, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (mu) || !isscalar (sigma)) + [retval, mu, sigma] = common_size (mu, sigma); + if (retval > 0) + error ("normrnd: mu and sigma must be of common size or scalars"); + endif + endif + + if (iscomplex (mu) || iscomplex (sigma)) + error ("normrnd: MU and SIGMA must not be complex"); + endif + + if (nargin == 2) + sz = size (mu); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("normrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("normrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (mu) && !isequal (size (mu), sz)) + error ("normrnd: mu and sigma must be scalar or of size SZ"); + endif + + if (isa (mu, "single") || isa (sigma, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (mu) && isscalar (sigma)) + if (!isnan (mu) && !isinf (mu) && (sigma > 0) && (sigma < Inf)) + rnd = mu + sigma * randn (sz); + else + rnd = NaN (sz, cls); + endif + else + rnd = mu + sigma .* randn (sz); + k = isnan (mu) | isinf (mu) | !(sigma > 0) | !(sigma < Inf); + rnd(k) = NaN; + endif + +endfunction + + +%!assert(size (normrnd (1,2)), [1, 1]); +%!assert(size (normrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (normrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (normrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (normrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (normrnd (1, 2, 3)), [3, 3]); +%!assert(size (normrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (normrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (normrnd (1, 2)), "double"); +%!assert(class (normrnd (single(1), 2)), "single"); +%!assert(class (normrnd (single([1 1]), 2)), "single"); +%!assert(class (normrnd (1, single(2))), "single"); +%!assert(class (normrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error normrnd () +%!error normrnd (1) +%!error normrnd (ones(3),ones(2)) +%!error normrnd (ones(2),ones(3)) +%!error normrnd (i, 2) +%!error normrnd (2, i) +%!error normrnd (1,2, -1) +%!error normrnd (1,2, ones(2)) +%!error normrnd (1, 2, [2 -1 2]) +%!error normrnd (1,2, 1, ones(2)) +%!error normrnd (1,2, 1, -1) +%!error normrnd (ones(2,2), 2, 3) +%!error normrnd (ones(2,2), 2, [3, 2]) +%!error normrnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/poisscdf.m b/octave_packages/m/statistics/distributions/poisscdf.m new file mode 100644 index 0000000..6342f21 --- /dev/null +++ b/octave_packages/m/statistics/distributions/poisscdf.m @@ -0,0 +1,90 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} poisscdf (@var{x}, @var{lambda}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the Poisson distribution with parameter +## lambda. +## @end deftypefn + +## Author: KH +## Description: CDF of the Poisson distribution + +function cdf = poisscdf (x, lambda) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (lambda)) + [retval, x, lambda] = common_size (x, lambda); + if (retval > 0) + error ("poisscdf: X and LAMBDA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (lambda)) + error ("poisscdf: X and LAMBDA must not be complex"); + endif + + if (isa (x, "single") || isa (lambda, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(lambda > 0); + cdf(k) = NaN; + + k = (x == Inf) & (lambda > 0); + cdf(k) = 1; + + k = (x >= 0) & (x < Inf) & (lambda > 0); + if (isscalar (lambda)) + cdf(k) = 1 - gammainc (lambda, floor (x(k)) + 1); + else + cdf(k) = 1 - gammainc (lambda(k), floor (x(k)) + 1); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0, gammainc(1, (x(2:4) +1), 'upper'), 1]; +%!assert(poisscdf (x, ones(1,5)), y); +%!assert(poisscdf (x, 1), y); +%!assert(poisscdf (x, [1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)]); +%!assert(poisscdf ([x(1:2) NaN Inf x(5)], 1), [y(1:2) NaN 1 y(5)]); + +%% Test class of input preserved +%!assert(poisscdf ([x, NaN], 1), [y, NaN]); +%!assert(poisscdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(poisscdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error poisscdf () +%!error poisscdf (1) +%!error poisscdf (1,2,3) +%!error poisscdf (ones(3),ones(2)) +%!error poisscdf (ones(2),ones(3)) +%!error poisscdf (i, 2) +%!error poisscdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/poissinv.m b/octave_packages/m/statistics/distributions/poissinv.m new file mode 100644 index 0000000..c450017 --- /dev/null +++ b/octave_packages/m/statistics/distributions/poissinv.m @@ -0,0 +1,103 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} poissinv (@var{x}, @var{lambda}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the Poisson distribution with parameter +## @var{lambda}. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the Poisson distribution + +function inv = poissinv (x, lambda) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (lambda)) + [retval, x, lambda] = common_size (x, lambda); + if (retval > 0) + error ("poissinv: X and LAMBDA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (lambda)) + error ("poissinv: X and LAMBDA must not be complex"); + endif + + if (isa (x, "single") || isa (lambda, "single")) + inv = zeros (size (x), "single"); + else + inv = zeros (size (x)); + endif + + k = (x < 0) | (x > 1) | isnan (x) | !(lambda > 0); + inv(k) = NaN; + + k = (x == 1) & (lambda > 0); + inv(k) = Inf; + + k = find ((x > 0) & (x < 1) & (lambda > 0)); + if (isscalar (lambda)) + cdf = exp (-lambda) * ones (size (k)); + else + cdf = exp (-lambda(k)); + endif + + while (1) + m = find (cdf < x(k)); + if (any (m)) + inv(k(m)) += 1; + if (isscalar (lambda)) + cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda); + else + cdf(m) = cdf(m) + poisspdf (inv(k(m)), lambda(k(m))); + endif + else + break; + endif + endwhile + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(poissinv (x, ones(1,5)), [NaN 0 1 Inf NaN]); +%!assert(poissinv (x, 1), [NaN 0 1 Inf NaN]); +%!assert(poissinv (x, [1 0 NaN 1 1]), [NaN NaN NaN Inf NaN]); +%!assert(poissinv ([x(1:2) NaN x(4:5)], 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(poissinv ([x, NaN], 1), [NaN 0 1 Inf NaN NaN]); +%!assert(poissinv (single([x, NaN]), 1), single([NaN 0 1 Inf NaN NaN])); +%!assert(poissinv ([x, NaN], single(1)), single([NaN 0 1 Inf NaN NaN])); + +%% Test input validation +%!error poissinv () +%!error poissinv (1) +%!error poissinv (1,2,3) +%!error poissinv (ones(3),ones(2)) +%!error poissinv (ones(2),ones(3)) +%!error poissinv (i, 2) +%!error poissinv (2, i) + diff --git a/octave_packages/m/statistics/distributions/poisspdf.m b/octave_packages/m/statistics/distributions/poisspdf.m new file mode 100644 index 0000000..d98ed0b --- /dev/null +++ b/octave_packages/m/statistics/distributions/poisspdf.m @@ -0,0 +1,85 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} poisspdf (@var{x}, @var{lambda}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the Poisson distribution with parameter @var{lambda}. +## @end deftypefn + +## Author: KH +## Description: PDF of the Poisson distribution + +function pdf = poisspdf (x, lambda) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (lambda)) + [retval, x, lambda] = common_size (x, lambda); + if (retval > 0) + error ("poisspdf: X and LAMBDA must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (lambda)) + error ("poisspdf: X and LAMBDA must not be complex"); + endif + + if (isa (x, "single") || isa (lambda, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(lambda > 0); + pdf(k) = NaN; + + k = (x >= 0) & (x < Inf) & (x == fix (x)) & (lambda > 0); + if (isscalar (lambda)) + pdf(k) = exp (x(k) * log (lambda) - lambda - gammaln (x(k) + 1)); + else + pdf(k) = exp (x(k) .* log (lambda(k)) - lambda(k) - gammaln (x(k) + 1)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 2 Inf]; +%! y = [0, exp(-1)*[1 1 0.5], 0]; +%!assert(poisspdf (x, ones(1,5)), y, eps); +%!assert(poisspdf (x, 1), y, eps); +%!assert(poisspdf (x, [1 0 NaN 1 1]), [y(1) NaN NaN y(4:5)], eps); +%!assert(poisspdf ([x, NaN], 1), [y, NaN], eps); + +%% Test class of input preserved +%!assert(poisspdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(poisspdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error poisspdf () +%!error poisspdf (1) +%!error poisspdf (1,2,3) +%!error poisspdf (ones(3),ones(2)) +%!error poisspdf (ones(2),ones(3)) +%!error poisspdf (i, 2) +%!error poisspdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/poissrnd.m b/octave_packages/m/statistics/distributions/poissrnd.m new file mode 100644 index 0000000..6d841e9 --- /dev/null +++ b/octave_packages/m/statistics/distributions/poissrnd.m @@ -0,0 +1,122 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} poissrnd (@var{lambda}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, @var{r}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} poissrnd (@var{lambda}, [@var{sz}]) +## Return a matrix of random samples from the Poisson distribution with +## parameter @var{lambda}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{lambda}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the Poisson distribution + +function rnd = poissrnd (lambda, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + sz = size (lambda); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("poissrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("poissrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (lambda) && !isequal (size (lambda), sz)) + error ("poissrnd: LAMBDA must be scalar or of size SZ"); + endif + + if (iscomplex (lambda)) + error ("poissrnd: LAMBDA must not be complex"); + endif + + if (isa (lambda, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (lambda)) + if (lambda >= 0 && lambda < Inf) + rnd = randp (lambda, sz); + if (strcmp (cls, "single")) + rnd = single (rnd); + endif + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = (lambda >= 0) & (lambda < Inf); + rnd(k) = randp (lambda(k)); + endif + +endfunction + +%!assert(size (poissrnd (2)), [1, 1]); +%!assert(size (poissrnd (ones(2,1))), [2, 1]); +%!assert(size (poissrnd (ones(2,2))), [2, 2]); +%!assert(size (poissrnd (1, 3)), [3, 3]); +%!assert(size (poissrnd (1, [4 1])), [4, 1]); +%!assert(size (poissrnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (poissrnd (2)), "double"); +%!assert(class (poissrnd (single(2))), "single"); +%!assert(class (poissrnd (single([2 2]))), "single"); + +%% Test input validation +%!error poissrnd () +%!error poissrnd (1, -1) +%!error poissrnd (1, ones(2)) +%!error poissrnd (1, 2, ones(2)) +%!error poissrnd (i) +%!error poissrnd (1, 2, -1) +%!error poissrnd (1, [2 -1 2]) +%!error poissrnd (ones(2,2), 3) +%!error poissrnd (ones(2,2), [3, 2]) +%!error poissrnd (ones(2,2), 2, 3) + +%!assert (poissrnd (0, 1, 1), 0) +%!assert (poissrnd ([0, 0, 0], [1, 3]), [0 0 0]) + diff --git a/octave_packages/m/statistics/distributions/stdnormal_cdf.m b/octave_packages/m/statistics/distributions/stdnormal_cdf.m new file mode 100644 index 0000000..1de4ae0 --- /dev/null +++ b/octave_packages/m/statistics/distributions/stdnormal_cdf.m @@ -0,0 +1,57 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} stdnormal_cdf (@var{x}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the standard normal distribution +## (mean = 0, standard deviation = 1). +## @end deftypefn + +## Author: KH +## Description: CDF of the standard normal distribution + +function cdf = stdnormal_cdf (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("stdnormal_cdf: X must not be complex"); + endif + + cdf = erfc (x / (-sqrt(2))) / 2; + +endfunction + + +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = [0, 0.5, 1/2*(1+erf(1/sqrt(2))), 1]; +%!assert(stdnormal_cdf ([x, NaN]), [y, NaN]); + +%% Test class of input preserved +%!assert(stdnormal_cdf (single([x, NaN])), single([y, NaN]), eps("single")); + +%% Test input validation +%!error stdnormal_cdf () +%!error stdnormal_cdf (1,2) +%!error stdnormal_cdf (i) + diff --git a/octave_packages/m/statistics/distributions/stdnormal_inv.m b/octave_packages/m/statistics/distributions/stdnormal_inv.m new file mode 100644 index 0000000..d128181 --- /dev/null +++ b/octave_packages/m/statistics/distributions/stdnormal_inv.m @@ -0,0 +1,57 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} stdnormal_inv (@var{x}) +## For each element of @var{x}, compute the quantile (the +## inverse of the CDF) at @var{x} of the standard normal distribution +## (mean = 0, standard deviation = 1). +## @end deftypefn + +## Author: KH +## Description: Quantile function of the standard normal distribution + +function inv = stdnormal_inv (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("stdnormal_inv: X must not be complex"); + endif + + inv = sqrt (2) * erfinv (2 * x - 1); + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(stdnormal_inv (x), [NaN -Inf 0 Inf NaN]); + +%% Test class of input preserved +%!assert(stdnormal_inv ([x, NaN]), [NaN -Inf 0 Inf NaN NaN]); +%!assert(stdnormal_inv (single([x, NaN])), single([NaN -Inf 0 Inf NaN NaN])); + +%% Test input validation +%!error stdnormal_inv () +%!error stdnormal_inv (1,2) +%!error stdnormal_inv (i) + diff --git a/octave_packages/m/statistics/distributions/stdnormal_pdf.m b/octave_packages/m/statistics/distributions/stdnormal_pdf.m new file mode 100644 index 0000000..29b4341 --- /dev/null +++ b/octave_packages/m/statistics/distributions/stdnormal_pdf.m @@ -0,0 +1,57 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} stdnormal_pdf (@var{x}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the standard normal distribution (mean = 0, +## standard deviation = 1). +## @end deftypefn + +## Author: TT +## Description: PDF of the standard normal distribution + +function pdf = stdnormal_pdf (x) + + if (nargin != 1) + print_usage (); + endif + + if (iscomplex (x)) + error ("stdnormal_pdf: X must not be complex"); + endif + + pdf = (2 * pi)^(- 1/2) * exp (- x .^ 2 / 2); + +endfunction + + +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = 1/sqrt(2*pi)*exp (-x.^2/2); +%!assert(stdnormal_pdf ([x, NaN]), [y, NaN], eps); + +%% Test class of input preserved +%!assert(stdnormal_pdf (single([x, NaN])), single([y, NaN]), eps("single")); + +%% Test input validation +%!error stdnormal_pdf () +%!error stdnormal_pdf (1,2) +%!error stdnormal_pdf (i) + diff --git a/octave_packages/m/statistics/distributions/stdnormal_rnd.m b/octave_packages/m/statistics/distributions/stdnormal_rnd.m new file mode 100644 index 0000000..b0d7970 --- /dev/null +++ b/octave_packages/m/statistics/distributions/stdnormal_rnd.m @@ -0,0 +1,74 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} stdnormal_rnd (@var{r}) +## @deftypefnx {Function File} {} stdnormal_rnd (@var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} stdnormal_rnd ([@var{sz}]) +## Return a matrix of random samples from the standard normal distribution +## (mean = 0, standard deviation = 1). +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the standard normal distribution + +function rnd = stdnormal_rnd (varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("stdnormal_rnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 1) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("stdnormal_rnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + rnd = randn (sz); + +endfunction + + +%!assert(size (stdnormal_rnd (3)), [3, 3]); +%!assert(size (stdnormal_rnd ([4 1])), [4, 1]); +%!assert(size (stdnormal_rnd (4,1)), [4, 1]); + +%% Test input validation +%!error stdnormal_rnd () +%!error stdnormal_rnd (-1) +%!error stdnormal_rnd (ones(2)) +%!error stdnormal_rnd ([2 -1 2]) +%!error stdnormal_rnd (1, ones(2)) +%!error stdnormal_rnd (1, -1) + diff --git a/octave_packages/m/statistics/distributions/tcdf.m b/octave_packages/m/statistics/distributions/tcdf.m new file mode 100644 index 0000000..c026d99 --- /dev/null +++ b/octave_packages/m/statistics/distributions/tcdf.m @@ -0,0 +1,94 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} tcdf (@var{x}, @var{n}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the t (Student) distribution with +## @var{n} degrees of freedom, i.e., PROB (t(@var{n}) @leq{} @var{x}). +## @end deftypefn + +## Author: KH +## Description: CDF of the t distribution + +function cdf = tcdf (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("tcdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("tcdf: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = !isinf (x) & (n > 0); + if (isscalar (n)) + cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 / n), n/2, 1/2) / 2; + else + cdf(k) = betainc (1 ./ (1 + x(k) .^ 2 ./ n(k)), n(k)/2, 1/2) / 2; + endif + k &= (x > 0); + if (any (k(:))) + cdf(k) = 1 - cdf(k); + endif + + k = isnan (x) | !(n > 0); + cdf(k) = NaN; + + k = (x == Inf) & (n > 0); + cdf(k) = 1; + +endfunction + + +%!shared x,y +%! x = [-Inf 0 1 Inf]; +%! y = [0 1/2 3/4 1]; +%!assert(tcdf (x, ones(1,4)), y, eps); +%!assert(tcdf (x, 1), y, eps); +%!assert(tcdf (x, [0 1 NaN 1]), [NaN 1/2 NaN 1], eps); +%!assert(tcdf ([x(1:2) NaN x(4)], 1), [y(1:2) NaN y(4)], eps); + +%% Test class of input preserved +%!assert(tcdf ([x, NaN], 1), [y, NaN], eps); +%!assert(tcdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(tcdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error tcdf () +%!error tcdf (1) +%!error tcdf (1,2,3) +%!error tcdf (ones(3),ones(2)) +%!error tcdf (ones(2),ones(3)) +%!error tcdf (i, 2) +%!error tcdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/tinv.m b/octave_packages/m/statistics/distributions/tinv.m new file mode 100644 index 0000000..e635a1e --- /dev/null +++ b/octave_packages/m/statistics/distributions/tinv.m @@ -0,0 +1,108 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} tinv (@var{x}, @var{n}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the t (Student) distribution with @var{n} +## degrees of freedom. This function is analogous to looking in a table +## for the t-value of a single-tailed distribution. +## @end deftypefn + +## For very large n, the "correct" formula does not really work well, +## and the quantiles of the standard normal distribution are used +## directly. + +## Author: KH +## Description: Quantile function of the t distribution + +function inv = tinv (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("tinv: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("tinv: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x == 0) & (n > 0); + inv(k) = -Inf; + + k = (x == 1) & (n > 0); + inv(k) = Inf; + + if (isscalar (n)) + k = (x > 0) & (x < 1); + if ((n > 0) && (n < 10000)) + inv(k) = (sign (x(k) - 1/2) + .* sqrt (n * (1 ./ betainv (2*min (x(k), 1 - x(k)), + n/2, 1/2) - 1))); + elseif (n >= 10000) + ## For large n, use the quantiles of the standard normal + inv(k) = stdnormal_inv (x(k)); + endif + else + k = (x > 0) & (x < 1) & (n > 0) & (n < 10000); + inv(k) = (sign (x(k) - 1/2) + .* sqrt (n(k) .* (1 ./ betainv (2*min (x(k), 1 - x(k)), + n(k)/2, 1/2) - 1))); + + ## For large n, use the quantiles of the standard normal + k = (x > 0) & (x < 1) & (n >= 10000); + inv(k) = stdnormal_inv (x(k)); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(tinv (x, ones(1,5)), [NaN -Inf 0 Inf NaN]); +%!assert(tinv (x, 1), [NaN -Inf 0 Inf NaN], eps); +%!assert(tinv (x, [1 0 NaN 1 1]), [NaN NaN NaN Inf NaN], eps); +%!assert(tinv ([x(1:2) NaN x(4:5)], 1), [NaN -Inf NaN Inf NaN]); + +%% Test class of input preserved +%!assert(tinv ([x, NaN], 1), [NaN -Inf 0 Inf NaN NaN], eps); +%!assert(tinv (single([x, NaN]), 1), single([NaN -Inf 0 Inf NaN NaN]), eps("single")); +%!assert(tinv ([x, NaN], single(1)), single([NaN -Inf 0 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error tinv () +%!error tinv (1) +%!error tinv (1,2,3) +%!error tinv (ones(3),ones(2)) +%!error tinv (ones(2),ones(3)) +%!error tinv (i, 2) +%!error tinv (2, i) + diff --git a/octave_packages/m/statistics/distributions/tpdf.m b/octave_packages/m/statistics/distributions/tpdf.m new file mode 100644 index 0000000..05e5206 --- /dev/null +++ b/octave_packages/m/statistics/distributions/tpdf.m @@ -0,0 +1,93 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} tpdf (@var{x}, @var{n}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of the @var{t} (Student) distribution with @var{n} +## degrees of freedom. +## @end deftypefn + +## Author: KH +## Description: PDF of the t distribution + +function pdf = tpdf (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (!isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("tpdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("tpdf: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(n > 0) | !(n < Inf); + pdf(k) = NaN; + + k = !isinf (x) & !isnan (x) & (n > 0) & (n < Inf); + if (isscalar (n)) + pdf(k) = (exp (- (n + 1) * log (1 + x(k) .^ 2 / n)/2) + / (sqrt (n) * beta (n/2, 1/2))); + else + pdf(k) = (exp (- (n(k) + 1) .* log (1 + x(k) .^ 2 ./ n(k))/2) + ./ (sqrt (n(k)) .* beta (n(k)/2, 1/2))); + endif + +endfunction + + +%!test +%! x = rand (10,1); +%! y = 1./(pi * (1 + x.^2)); +%! assert(tpdf (x, 1), y, 5*eps); + +%!shared x,y +%! x = [-Inf 0 0.5 1 Inf]; +%! y = 1./(pi * (1 + x.^2)); +%!assert(tpdf (x, ones(1,5)), y, eps); +%!assert(tpdf (x, 1), y, eps); +%!assert(tpdf (x, [0 NaN 1 1 1]), [NaN NaN y(3:5)], eps); + +%% Test class of input preserved +%!assert(tpdf ([x, NaN], 1), [y, NaN], eps); +%!assert(tpdf (single([x, NaN]), 1), single([y, NaN]), eps("single")); +%!assert(tpdf ([x, NaN], single(1)), single([y, NaN]), eps("single")); + +%% Test input validation +%!error tpdf () +%!error tpdf (1) +%!error tpdf (1,2,3) +%!error tpdf (ones(3),ones(2)) +%!error tpdf (ones(2),ones(3)) +%!error tpdf (i, 2) +%!error tpdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/trnd.m b/octave_packages/m/statistics/distributions/trnd.m new file mode 100644 index 0000000..bf1cc24 --- /dev/null +++ b/octave_packages/m/statistics/distributions/trnd.m @@ -0,0 +1,117 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} trnd (@var{n}) +## @deftypefnx {Function File} {} trnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} trnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} trnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the t (Student) distribution with +## @var{n} degrees of freedom. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the t distribution + +function rnd = trnd (n, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + sz = size (n); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("trnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("trnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("trnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("trnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n)) + if ((n > 0) && (n < Inf)) + rnd = randn (sz) ./ sqrt (2*randg (n/2, sz) / n); + else + rnd = NaN (sz, cls); + endif + else + rnd = NaN (sz, cls); + + k = (n > 0) & (n < Inf); + rnd(k) = randn (sum (k(:)), 1) ./ sqrt (2*randg (n(k)/2) ./ n(k))(:); + endif + +endfunction + + +%!assert(size (trnd (2)), [1, 1]); +%!assert(size (trnd (ones(2,1))), [2, 1]); +%!assert(size (trnd (ones(2,2))), [2, 2]); +%!assert(size (trnd (1, 3)), [3, 3]); +%!assert(size (trnd (1, [4 1])), [4, 1]); +%!assert(size (trnd (1, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (trnd (1)), "double"); +%!assert(class (trnd (single(1))), "single"); +%!assert(class (trnd (single([1 1]))), "single"); + +%% Test input validation +%!error trnd () +%!error trnd (1, -1) +%!error trnd (1, ones(2)) +%!error trnd (i) +%!error trnd (1, [2 -1 2]) +%!error trnd (1, 2, ones(2)) +%!error trnd (1, 2, -1) +%!error trnd (ones(2,2), 3) +%!error trnd (ones(2,2), [3, 2]) +%!error trnd (ones(2,2), 2, 3) + diff --git a/octave_packages/m/statistics/distributions/unidcdf.m b/octave_packages/m/statistics/distributions/unidcdf.m new file mode 100644 index 0000000..1b97140 --- /dev/null +++ b/octave_packages/m/statistics/distributions/unidcdf.m @@ -0,0 +1,89 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unidcdf (@var{x}, @var{n}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of a discrete uniform distribution which assumes +## the integer values 1--@var{n} with equal probability. +## @end deftypefn + +function cdf = unidcdf (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidcdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidcdf: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + knan = isnan (x) | ! (n > 0 & n == fix (n)); + if (any (knan(:))) + cdf(knan) = NaN; + endif + + k = (x >= n) & !knan; + cdf(k) = 1; + + k = (x >= 1) & (x < n) & !knan; + if (isscalar (n)) + cdf(k) = floor (x(k)) / n; + else + cdf(k) = floor (x(k)) ./ n(k); + endif + +endfunction + + +%!shared x,y +%! x = [0 1 2.5 10 11]; +%! y = [0, 0.1 0.2 1.0 1.0]; +%!assert(unidcdf (x, 10*ones(1,5)), y); +%!assert(unidcdf (x, 10), y); +%!assert(unidcdf (x, 10*[0 1 NaN 1 1]), [NaN 0.1 NaN y(4:5)]); +%!assert(unidcdf ([x(1:2) NaN Inf x(5)], 10), [y(1:2) NaN 1 y(5)]); + +%% Test class of input preserved +%!assert(unidcdf ([x, NaN], 10), [y, NaN]); +%!assert(unidcdf (single([x, NaN]), 10), single([y, NaN])); +%!assert(unidcdf ([x, NaN], single(10)), single([y, NaN])); + +%% Test input validation +%!error unidcdf () +%!error unidcdf (1) +%!error unidcdf (1,2,3) +%!error unidcdf (ones(3),ones(2)) +%!error unidcdf (ones(2),ones(3)) +%!error unidcdf (i, 2) +%!error unidcdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/unidinv.m b/octave_packages/m/statistics/distributions/unidinv.m new file mode 100644 index 0000000..8bfe8bf --- /dev/null +++ b/octave_packages/m/statistics/distributions/unidinv.m @@ -0,0 +1,81 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unidinv (@var{x}, @var{n}) +## For each element of @var{x}, compute the quantile (the inverse of +## the CDF) at @var{x} of the discrete uniform distribution which assumes +## the integer values 1--@var{n} with equal probability. +## @end deftypefn + +function inv = unidinv (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidcdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidinv: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + ## For Matlab compatibility, unidinv(0) = NaN + k = (x > 0) & (x <= 1) & (n > 0 & n == fix (n)); + if (isscalar (n)) + inv(k) = floor (x(k) * n); + else + inv(k) = floor (x(k) .* n(k)); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(unidinv (x, 10*ones(1,5)), [NaN NaN 5 10 NaN], eps); +%!assert(unidinv (x, 10), [NaN NaN 5 10 NaN], eps); +%!assert(unidinv (x, 10*[0 1 NaN 1 1]), [NaN NaN NaN 10 NaN], eps); +%!assert(unidinv ([x(1:2) NaN x(4:5)], 10), [NaN NaN NaN 10 NaN], eps); + +%% Test class of input preserved +%!assert(unidinv ([x, NaN], 10), [NaN NaN 5 10 NaN NaN], eps); +%!assert(unidinv (single([x, NaN]), 10), single([NaN NaN 5 10 NaN NaN]), eps); +%!assert(unidinv ([x, NaN], single(10)), single([NaN NaN 5 10 NaN NaN]), eps); + +%% Test input validation +%!error unidinv () +%!error unidinv (1) +%!error unidinv (1,2,3) +%!error unidinv (ones(3),ones(2)) +%!error unidinv (ones(2),ones(3)) +%!error unidinv (i, 2) +%!error unidinv (2, i) + diff --git a/octave_packages/m/statistics/distributions/unidpdf.m b/octave_packages/m/statistics/distributions/unidpdf.m new file mode 100644 index 0000000..a9cd582 --- /dev/null +++ b/octave_packages/m/statistics/distributions/unidpdf.m @@ -0,0 +1,87 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 2007-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unidpdf (@var{x}, @var{n}) +## For each element of @var{x}, compute the probability density function +## (PDF) at @var{x} of a discrete uniform distribution which assumes +## the integer values 1--@var{n} with equal probability. +## +## Warning: The underlying implementation uses the double class and +## will only be accurate for @var{n} @leq{} @code{bitmax} +## (@w{@math{2^{53} - 1}} on IEEE-754 compatible systems). +## @end deftypefn + +function pdf = unidpdf (x, n) + + if (nargin != 2) + print_usage (); + endif + + if (! isscalar (n)) + [retval, x, n] = common_size (x, n); + if (retval > 0) + error ("unidpdf: X and N must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (n)) + error ("unidpdf: X and N must not be complex"); + endif + + if (isa (x, "single") || isa (n, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | ! (n > 0 & n == fix (n)); + pdf(k) = NaN; + + k = !k & (x >= 1) & (x <= n) & (x == fix (x)); + if (isscalar (n)) + pdf(k) = 1 / n; + else + pdf(k) = 1 ./ n(k); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 1 2 10 11]; +%! y = [0 0 0.1 0.1 0.1 0]; +%!assert(unidpdf (x, 10*ones(1,6)), y); +%!assert(unidpdf (x, 10), y); +%!assert(unidpdf (x, 10*[0 NaN 1 1 1 1]), [NaN NaN y(3:6)]); +%!assert(unidpdf ([x, NaN], 10), [y, NaN]); + +%% Test class of input preserved +%!assert(unidpdf (single([x, NaN]), 10), single([y, NaN])); +%!assert(unidpdf ([x, NaN], single(10)), single([y, NaN])); + +%% Test input validation +%!error unidpdf () +%!error unidpdf (1) +%!error unidpdf (1,2,3) +%!error unidpdf (ones(3),ones(2)) +%!error unidpdf (ones(2),ones(3)) +%!error unidpdf (i, 2) +%!error unidpdf (2, i) + diff --git a/octave_packages/m/statistics/distributions/unidrnd.m b/octave_packages/m/statistics/distributions/unidrnd.m new file mode 100644 index 0000000..3dac7fe --- /dev/null +++ b/octave_packages/m/statistics/distributions/unidrnd.m @@ -0,0 +1,111 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 2005-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unidrnd (@var{n}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, @var{r}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} unidrnd (@var{n}, [@var{sz}]) +## Return a matrix of random samples from the discrete uniform distribution +## which assumes the integer values 1--@var{n} with equal probability. +## @var{n} may be a scalar or a multi-dimensional array. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the size of +## @var{n}. +## @end deftypefn + +## Author: jwe + +function rnd = unidrnd (n, varargin) + + if (nargin < 1) + print_usage (); + endif + + if (nargin == 1) + sz = size (n); + elseif (nargin == 2) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("unidrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 2) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("unidrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (n) && !isequal (size (n), sz)) + error ("unidrnd: N must be scalar or of size SZ"); + endif + + if (iscomplex (n)) + error ("unidrnd: N must not be complex"); + endif + + if (isa (n, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (n)) + if (n > 0 && n == fix (n)) + rnd = ceil (rand (sz) * n); + else + rnd = NaN (sz, cls); + endif + else + rnd = ceil (rand (sz) .* n); + + k = ! (n > 0 & n == fix (n)); + rnd(k) = NaN; + endif + +endfunction + + +%!assert(size (unidrnd (2)), [1, 1]); +%!assert(size (unidrnd (ones(2,1))), [2, 1]); +%!assert(size (unidrnd (ones(2,2))), [2, 2]); +%!assert(size (unidrnd (10, [4 1])), [4, 1]); +%!assert(size (unidrnd (10, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (unidrnd (2)), "double"); +%!assert(class (unidrnd (single(2))), "single"); +%!assert(class (unidrnd (single([2 2]))), "single"); + +%% Test input validation +%!error unidrnd () +%!error unidrnd (10, [1;2;3]) +%!error unidrnd (10, 2, ones(2)) +%!error unidrnd (10*ones(2), 2, 1) +%!error unidrnd (i) + diff --git a/octave_packages/m/statistics/distributions/unifcdf.m b/octave_packages/m/statistics/distributions/unifcdf.m new file mode 100644 index 0000000..3f0af16 --- /dev/null +++ b/octave_packages/m/statistics/distributions/unifcdf.m @@ -0,0 +1,98 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unifcdf (@var{x}) +## @deftypefnx {Function File} {} unifcdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the cumulative distribution +## function (CDF) at @var{x} of the uniform distribution on the interval +## [@var{a}, @var{b}]. +## +## Default values are @var{a} = 0, @var{b} = 1. +## @end deftypefn + +## Author: KH +## Description: CDF of the uniform distribution + +function cdf = unifcdf (x, a = 0, b = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("unifcdf: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifcdf: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + cdf = zeros (size (x), "single"); + else + cdf = zeros (size (x)); + endif + + k = isnan (x) | !(a < b); + cdf(k) = NaN; + + k = (x >= b) & (a < b); + cdf(k) = 1; + + k = (x > a) & (x < b); + if (isscalar (a) && isscalar (b)) + cdf(k) = (x(k) < b) .* (x(k) - a) / (b - a); + else + cdf(k) = (x(k) < b(k)) .* (x(k) - a(k)) ./ (b(k) - a(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2] + 1; +%! y = [0 0 0.5 1 1]; +%!assert(unifcdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(unifcdf (x, 1, 2*ones(1,5)), y); +%!assert(unifcdf (x, ones(1,5), 2), y); +%!assert(unifcdf (x, [2 1 NaN 1 1], 2), [NaN 0 NaN 1 1]); +%!assert(unifcdf (x, 1, 2*[0 1 NaN 1 1]), [NaN 0 NaN 1 1]); +%!assert(unifcdf ([x(1:2) NaN x(4:5)], 1, 2), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(unifcdf ([x, NaN], 1, 2), [y, NaN]); +%!assert(unifcdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(unifcdf ([x, NaN], single(1), 2), single([y, NaN])); +%!assert(unifcdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error unifcdf () +%!error unifcdf (1,2) +%!error unifcdf (1,2,3,4) +%!error unifcdf (ones(3),ones(2),ones(2)) +%!error unifcdf (ones(2),ones(3),ones(2)) +%!error unifcdf (ones(2),ones(2),ones(3)) +%!error unifcdf (i, 2, 2) +%!error unifcdf (2, i, 2) +%!error unifcdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/unifinv.m b/octave_packages/m/statistics/distributions/unifinv.m new file mode 100644 index 0000000..7682758 --- /dev/null +++ b/octave_packages/m/statistics/distributions/unifinv.m @@ -0,0 +1,91 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unifinv (@var{x}) +## @deftypefnx {Function File} {} unifinv (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the quantile (the inverse of the +## CDF) at @var{x} of the uniform distribution on the interval +## [@var{a}, @var{b}]. +## +## Default values are @var{a} = 0, @var{b} = 1. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the uniform distribution + +function inv = unifinv (x, a = 0, b = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("unifinv: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifinv: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + k = (x >= 0) & (x <= 1) & (a < b); + if (isscalar (a) && isscalar (b)) + inv(k) = a + x(k) * (b - a); + else + inv(k) = a(k) + x(k) .* (b(k) - a(k)); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.5 1 2]; +%!assert(unifinv (x, ones(1,5), 2*ones(1,5)), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, 1, 2*ones(1,5)), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, ones(1,5), 2), [NaN 1 1.5 2 NaN]); +%!assert(unifinv (x, [1 2 NaN 1 1], 2), [NaN NaN NaN 2 NaN]); +%!assert(unifinv (x, 1, 2*[1 0 NaN 1 1]), [NaN NaN NaN 2 NaN]); +%!assert(unifinv ([x(1:2) NaN x(4:5)], 1, 2), [NaN 1 NaN 2 NaN]); + +%% Test class of input preserved +%!assert(unifinv ([x, NaN], 1, 2), [NaN 1 1.5 2 NaN NaN]); +%!assert(unifinv (single([x, NaN]), 1, 2), single([NaN 1 1.5 2 NaN NaN])); +%!assert(unifinv ([x, NaN], single(1), 2), single([NaN 1 1.5 2 NaN NaN])); +%!assert(unifinv ([x, NaN], 1, single(2)), single([NaN 1 1.5 2 NaN NaN])); + +%% Test input validation +%!error unifinv () +%!error unifinv (1,2) +%!error unifinv (1,2,3,4) +%!error unifinv (ones(3),ones(2),ones(2)) +%!error unifinv (ones(2),ones(3),ones(2)) +%!error unifinv (ones(2),ones(2),ones(3)) +%!error unifinv (i, 2, 2) +%!error unifinv (2, i, 2) +%!error unifinv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/unifpdf.m b/octave_packages/m/statistics/distributions/unifpdf.m new file mode 100644 index 0000000..f590205 --- /dev/null +++ b/octave_packages/m/statistics/distributions/unifpdf.m @@ -0,0 +1,93 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unifpdf (@var{x}) +## @deftypefnx {Function File} {} unifpdf (@var{x}, @var{a}, @var{b}) +## For each element of @var{x}, compute the probability density function (PDF) +## at @var{x} of the uniform distribution on the interval [@var{a}, @var{b}]. +## +## Default values are @var{a} = 0, @var{b} = 1. +## @end deftypefn + +## Author: KH +## Description: PDF of the uniform distribution + +function pdf = unifpdf (x, a = 0, b = 1) + + if (nargin != 1 && nargin != 3) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, x, a, b] = common_size (x, a, b); + if (retval > 0) + error ("unifpdf: X, A, and B must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (a) || iscomplex (b)) + error ("unifpdf: X, A, and B must not be complex"); + endif + + if (isa (x, "single") || isa (a, "single") || isa (b, "single")) + pdf = zeros (size (x), "single"); + else + pdf = zeros (size (x)); + endif + + k = isnan (x) | !(a < b); + pdf(k) = NaN; + + k = (x >= a) & (x <= b) & (a < b); + if (isscalar (a) && isscalar (b)) + pdf(k) = 1 / (b - a); + else + pdf(k) = 1 ./ (b(k) - a(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 2] + 1; +%! y = [0 1 1 1 0]; +%!assert(unifpdf (x, ones(1,5), 2*ones(1,5)), y); +%!assert(unifpdf (x, 1, 2*ones(1,5)), y); +%!assert(unifpdf (x, ones(1,5), 2), y); +%!assert(unifpdf (x, [2 NaN 1 1 1], 2), [NaN NaN y(3:5)]); +%!assert(unifpdf (x, 1, 2*[0 NaN 1 1 1]), [NaN NaN y(3:5)]); +%!assert(unifpdf ([x, NaN], 1, 2), [y, NaN]); + +%% Test class of input preserved +%!assert(unifpdf (single([x, NaN]), 1, 2), single([y, NaN])); +%!assert(unifpdf (single([x, NaN]), single(1), 2), single([y, NaN])); +%!assert(unifpdf ([x, NaN], 1, single(2)), single([y, NaN])); + +%% Test input validation +%!error unifpdf () +%!error unifpdf (1,2) +%!error unifpdf (1,2,3,4) +%!error unifpdf (ones(3),ones(2),ones(2)) +%!error unifpdf (ones(2),ones(3),ones(2)) +%!error unifpdf (ones(2),ones(2),ones(3)) +%!error unifpdf (i, 2, 2) +%!error unifpdf (2, i, 2) +%!error unifpdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/unifrnd.m b/octave_packages/m/statistics/distributions/unifrnd.m new file mode 100644 index 0000000..695ea4c --- /dev/null +++ b/octave_packages/m/statistics/distributions/unifrnd.m @@ -0,0 +1,132 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} unifrnd (@var{a}, @var{b}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, @var{r}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} unifrnd (@var{a}, @var{b}, [@var{sz}]) +## Return a matrix of random samples from the uniform distribution on +## [@var{a}, @var{b}]. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{a} and @var{b}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the uniform distribution + +function rnd = unifrnd (a, b, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (a) || !isscalar (b)) + [retval, a, b] = common_size (a, b); + if (retval > 0) + error ("unifrnd: A and B must be of common size or scalars"); + endif + endif + + if (iscomplex (a) || iscomplex (b)) + error ("unifrnd: A and B must not be complex"); + endif + + if (nargin == 2) + sz = size (a); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("unifrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("unifrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (a) && !isequal (size (a), sz)) + error ("unifrnd: A and B must be scalar or of size SZ"); + endif + + if (isa (a, "single") || isa (b, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (a) && isscalar (b)) + if ((-Inf < a) && (a < b) && (b < Inf)) + rnd = a + (b - a) * rand (sz); + else + rnd = NaN (sz, cls); + endif + else + rnd = a + (b - a) .* rand (sz); + + k = !(-Inf < a) | !(a < b) | !(b < Inf); + rnd(k) = NaN; + endif + +endfunction + + +%!assert(size (unifrnd (1,2)), [1, 1]); +%!assert(size (unifrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (unifrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (unifrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (unifrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (unifrnd (1, 2, 3)), [3, 3]); +%!assert(size (unifrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (unifrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (unifrnd (1, 2)), "double"); +%!assert(class (unifrnd (single(1), 2)), "single"); +%!assert(class (unifrnd (single([1 1]), 2)), "single"); +%!assert(class (unifrnd (1, single(2))), "single"); +%!assert(class (unifrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error unifrnd () +%!error unifrnd (1) +%!error unifrnd (ones(3),ones(2)) +%!error unifrnd (ones(2),ones(3)) +%!error unifrnd (i, 2) +%!error unifrnd (2, i) +%!error unifrnd (1,2, -1) +%!error unifrnd (1,2, ones(2)) +%!error unifrnd (1, 2, [2 -1 2]) +%!error unifrnd (1,2, 1, ones(2)) +%!error unifrnd (1,2, 1, -1) +%!error unifrnd (ones(2,2), 2, 3) +%!error unifrnd (ones(2,2), 2, [3, 2]) +%!error unifrnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/wblcdf.m b/octave_packages/m/statistics/distributions/wblcdf.m new file mode 100644 index 0000000..dd06bfe --- /dev/null +++ b/octave_packages/m/statistics/distributions/wblcdf.m @@ -0,0 +1,113 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} wblcdf (@var{x}) +## @deftypefnx {Function File} {} wblcdf (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblcdf (@var{x}, @var{scale}, @var{shape}) +## Compute the cumulative distribution function (CDF) at @var{x} of the +## Weibull distribution with scale parameter @var{scale} and shape +## parameter @var{shape}, which is +## @tex +## $$ 1 - e^{-({x \over scale})^{shape}} $$ +## for $x \geq 0$. +## @end tex +## @ifnottex +## +## @example +## 1 - exp (-(x/scale)^shape) +## @end example +## +## @noindent +## for @var{x} @geq{} 0. +## +## Default values are @var{scale} = 1, @var{shape} = 1. +## @end ifnottex +## @end deftypefn + +## Author: KH +## Description: CDF of the Weibull distribution + +function cdf = wblcdf (x, scale = 1, shape = 1) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (!isscalar (shape) || !isscalar (scale)) + [retval, x, shape, scale] = common_size (x, shape, scale); + if (retval > 0) + error ("wblcdf: X, SCALE, and SHAPE must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblcdf: X, SCALE, and SHAPE must not be complex"); + endif + + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + cdf = NaN (size (x), "single"); + else + cdf = NaN (size (x)); + endif + + ok = (shape > 0) & (shape < Inf) & (scale > 0) & (scale < Inf); + + k = (x <= 0) & ok; + cdf(k) = 0; + + k = (x == Inf) & ok; + cdf(k) = 1; + + k = (x > 0) & (x < Inf) & ok; + if (isscalar (shape) && isscalar (scale)) + cdf(k) = 1 - exp (- (x(k) / scale) .^ shape); + else + cdf(k) = 1 - exp (- (x(k) ./ scale(k)) .^ shape(k)); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, 1-exp(-x(2:4)), 1]; +%!assert(wblcdf (x, ones(1,5), ones(1,5)), y); +%!assert(wblcdf (x, 1, ones(1,5)), y); +%!assert(wblcdf (x, ones(1,5), 1), y); +%!assert(wblcdf (x, [0 1 NaN Inf 1], 1), [NaN 0 NaN NaN 1]); +%!assert(wblcdf (x, 1, [0 1 NaN Inf 1]), [NaN 0 NaN NaN 1]); +%!assert(wblcdf ([x(1:2) NaN x(4:5)], 1, 1), [y(1:2) NaN y(4:5)]); + +%% Test class of input preserved +%!assert(wblcdf ([x, NaN], 1, 1), [y, NaN]); +%!assert(wblcdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(wblcdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(wblcdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error wblcdf () +%!error wblcdf (1,2,3,4) +%!error wblcdf (ones(3),ones(2),ones(2)) +%!error wblcdf (ones(2),ones(3),ones(2)) +%!error wblcdf (ones(2),ones(2),ones(3)) +%!error wblcdf (i, 2, 2) +%!error wblcdf (2, i, 2) +%!error wblcdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/wblinv.m b/octave_packages/m/statistics/distributions/wblinv.m new file mode 100644 index 0000000..347d446 --- /dev/null +++ b/octave_packages/m/statistics/distributions/wblinv.m @@ -0,0 +1,99 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} wblinv (@var{x}) +## @deftypefnx {Function File} {} wblinv (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblinv (@var{x}, @var{scale}, @var{shape}) +## Compute the quantile (the inverse of the CDF) at @var{x} of the +## Weibull distribution with scale parameter @var{scale} and shape +## parameter @var{shape}. +## +## Default values are @var{scale} = 1, @var{shape} = 1. +## @end deftypefn + +## Author: KH +## Description: Quantile function of the Weibull distribution + +function inv = wblinv (x, scale = 1, shape = 1) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (!isscalar (scale) || !isscalar (shape)) + [retval, x, scale, shape] = common_size (x, scale, shape); + if (retval > 0) + error ("wblinv: X, SCALE, and SHAPE must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblinv: X, SCALE, and SHAPE must not be complex"); + endif + + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + inv = NaN (size (x), "single"); + else + inv = NaN (size (x)); + endif + + ok = (scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf); + + k = (x == 0) & ok; + inv(k) = 0; + + k = (x == 1) & ok; + inv(k) = Inf; + + k = (x > 0) & (x < 1) & ok; + if (isscalar (scale) && isscalar (shape)) + inv(k) = scale * (- log (1 - x(k))) .^ (1 / shape); + else + inv(k) = scale(k) .* (- log (1 - x(k))) .^ (1 ./ shape(k)); + endif + +endfunction + + +%!shared x +%! x = [-1 0 0.63212055882855778 1 2]; +%!assert(wblinv (x, ones(1,5), ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, 1, ones(1,5)), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, ones(1,5), 1), [NaN 0 1 Inf NaN], eps); +%!assert(wblinv (x, [1 -1 NaN Inf 1], 1), [NaN NaN NaN NaN NaN]); +%!assert(wblinv (x, 1, [1 -1 NaN Inf 1]), [NaN NaN NaN NaN NaN]); +%!assert(wblinv ([x(1:2) NaN x(4:5)], 1, 1), [NaN 0 NaN Inf NaN]); + +%% Test class of input preserved +%!assert(wblinv ([x, NaN], 1, 1), [NaN 0 1 Inf NaN NaN], eps); +%!assert(wblinv (single([x, NaN]), 1, 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(wblinv ([x, NaN], single(1), 1), single([NaN 0 1 Inf NaN NaN]), eps("single")); +%!assert(wblinv ([x, NaN], 1, single(1)), single([NaN 0 1 Inf NaN NaN]), eps("single")); + +%% Test input validation +%!error wblinv () +%!error wblinv (1,2,3,4) +%!error wblinv (ones(3),ones(2),ones(2)) +%!error wblinv (ones(2),ones(3),ones(2)) +%!error wblinv (ones(2),ones(2),ones(3)) +%!error wblinv (i, 2, 2) +%!error wblinv (2, i, 2) +%!error wblinv (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/wblpdf.m b/octave_packages/m/statistics/distributions/wblpdf.m new file mode 100644 index 0000000..c6b59ff --- /dev/null +++ b/octave_packages/m/statistics/distributions/wblpdf.m @@ -0,0 +1,112 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} wblpdf (@var{x}) +## @deftypefnx {Function File} {} wblpdf (@var{x}, @var{scale}) +## @deftypefnx {Function File} {} wblpdf (@var{x}, @var{scale}, @var{shape}) +## Compute the probability density function (PDF) at @var{x} of the +## Weibull distribution with scale parameter @var{scale} and shape +## parameter @var{shape} which is given by +## @tex +## $$ {shape \over scale^{shape}} \cdot x^{shape-1} \cdot e^{-({x \over scale})^{shape}} $$ +## @end tex +## @ifnottex +## +## @example +## shape * scale^(-shape) * x^(shape-1) * exp (-(x/scale)^shape) +## @end example +## +## @end ifnottex +## @noindent +## for @var{x} @geq{} 0. +## +## Default values are @var{scale} = 1, @var{shape} = 1. +## @end deftypefn + +## Author: KH +## Description: PDF of the Weibull distribution + +function pdf = wblpdf (x, scale = 1, shape = 1) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (!isscalar (scale) || !isscalar (shape)) + [retval, x, scale, shape] = common_size (x, scale, shape); + if (retval > 0) + error ("wblpdf: X, SCALE, and SHAPE must be of common size or scalars"); + endif + endif + + if (iscomplex (x) || iscomplex (scale) || iscomplex (shape)) + error ("wblpdf: X, SCALE, and SHAPE must not be complex"); + endif + + if (isa (x, "single") || isa (scale, "single") || isa (shape, "single")) + pdf = NaN (size (x), "single"); + else + pdf = NaN (size (x)); + endif + + ok = ((scale > 0) & (scale < Inf) & (shape > 0) & (shape < Inf)); + + k = (x < 0) & ok; + pdf(k) = 0; + + k = (x >= 0) & (x < Inf) & ok; + if (isscalar (scale) && isscalar (shape)) + pdf(k) = (shape * (scale .^ -shape) + .* (x(k) .^ (shape - 1)) + .* exp (- (x(k) / scale) .^ shape)); + else + pdf(k) = (shape(k) .* (scale(k) .^ -shape(k)) + .* (x(k) .^ (shape(k) - 1)) + .* exp (- (x(k) ./ scale(k)) .^ shape(k))); + endif + +endfunction + + +%!shared x,y +%! x = [-1 0 0.5 1 Inf]; +%! y = [0, exp(-x(2:4)), NaN]; +%!assert(wblpdf (x, ones(1,5), ones(1,5)), y); +%!assert(wblpdf (x, 1, ones(1,5)), y); +%!assert(wblpdf (x, ones(1,5), 1), y); +%!assert(wblpdf (x, [0 NaN Inf 1 1], 1), [NaN NaN NaN y(4:5)]); +%!assert(wblpdf (x, 1, [0 NaN Inf 1 1]), [NaN NaN NaN y(4:5)]); +%!assert(wblpdf ([x, NaN], 1, 1), [y, NaN]); + +%% Test class of input preserved +%!assert(wblpdf (single([x, NaN]), 1, 1), single([y, NaN])); +%!assert(wblpdf ([x, NaN], single(1), 1), single([y, NaN])); +%!assert(wblpdf ([x, NaN], 1, single(1)), single([y, NaN])); + +%% Test input validation +%!error wblpdf () +%!error wblpdf (1,2,3,4) +%!error wblpdf (ones(3),ones(2),ones(2)) +%!error wblpdf (ones(2),ones(3),ones(2)) +%!error wblpdf (ones(2),ones(2),ones(3)) +%!error wblpdf (i, 2, 2) +%!error wblpdf (2, i, 2) +%!error wblpdf (2, 2, i) + diff --git a/octave_packages/m/statistics/distributions/wblrnd.m b/octave_packages/m/statistics/distributions/wblrnd.m new file mode 100644 index 0000000..8ad9716 --- /dev/null +++ b/octave_packages/m/statistics/distributions/wblrnd.m @@ -0,0 +1,132 @@ +## Copyright (C) 2012 Rik Wehbring +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} wblrnd (@var{scale}, @var{shape}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{r}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, @var{r}, @var{c}, @dots{}) +## @deftypefnx {Function File} {} wblrnd (@var{scale}, @var{shape}, [@var{sz}]) +## Return a matrix of random samples from the Weibull distribution with +## parameters @var{scale} and @var{shape}. +## +## When called with a single size argument, return a square matrix with +## the dimension specified. When called with more than one scalar argument the +## first two arguments are taken as the number of rows and columns and any +## further arguments specify additional matrix dimensions. The size may also +## be specified with a vector of dimensions @var{sz}. +## +## If no size arguments are given then the result matrix is the common size of +## @var{scale} and @var{shape}. +## @end deftypefn + +## Author: KH +## Description: Random deviates from the Weibull distribution + +function rnd = wblrnd (scale, shape, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (!isscalar (scale) || !isscalar (shape)) + [retval, scale, shape] = common_size (scale, shape); + if (retval > 0) + error ("wblrnd: SCALE and SHAPE must be of common size or scalars"); + endif + endif + + if (iscomplex (scale) || iscomplex (shape)) + error ("wblrnd: SCALE and SHAPE must not be complex"); + endif + + if (nargin == 2) + sz = size (scale); + elseif (nargin == 3) + if (isscalar (varargin{1}) && varargin{1} >= 0) + sz = [varargin{1}, varargin{1}]; + elseif (isrow (varargin{1}) && all (varargin{1} >= 0)) + sz = varargin{1}; + else + error ("wblrnd: dimension vector must be row vector of non-negative integers"); + endif + elseif (nargin > 3) + if (any (cellfun (@(x) (!isscalar (x) || x < 0), varargin))) + error ("wblrnd: dimensions must be non-negative integers"); + endif + sz = [varargin{:}]; + endif + + if (!isscalar (scale) && !isequal (size (scale), sz)) + error ("wblrnd: SCALE and SHAPE must be scalar or of size SZ"); + endif + + if (isa (scale, "single") || isa (shape, "single")) + cls = "single"; + else + cls = "double"; + endif + + if (isscalar (scale) && isscalar (shape)) + if ((scale > 0) && (scale < Inf) && (shape > 0) && (shape < Inf)) + rnd = scale * rande (sz) .^ (1/shape); + else + rnd = NaN (sz, cls); + endif + else + rnd = scale .* rande (sz) .^ (1./shape); + + k = (scale <= 0) | (scale == Inf) | (shape <= 0) | (shape == Inf); + rnd(k) = NaN; + endif + +endfunction + + +%!assert(size (wblrnd (1,2)), [1, 1]); +%!assert(size (wblrnd (ones(2,1), 2)), [2, 1]); +%!assert(size (wblrnd (ones(2,2), 2)), [2, 2]); +%!assert(size (wblrnd (1, 2*ones(2,1))), [2, 1]); +%!assert(size (wblrnd (1, 2*ones(2,2))), [2, 2]); +%!assert(size (wblrnd (1, 2, 3)), [3, 3]); +%!assert(size (wblrnd (1, 2, [4 1])), [4, 1]); +%!assert(size (wblrnd (1, 2, 4, 1)), [4, 1]); + +%% Test class of input preserved +%!assert(class (wblrnd (1, 2)), "double"); +%!assert(class (wblrnd (single(1), 2)), "single"); +%!assert(class (wblrnd (single([1 1]), 2)), "single"); +%!assert(class (wblrnd (1, single(2))), "single"); +%!assert(class (wblrnd (1, single([2 2]))), "single"); + +%% Test input validation +%!error wblrnd () +%!error wblrnd (1) +%!error wblrnd (ones(3),ones(2)) +%!error wblrnd (ones(2),ones(3)) +%!error wblrnd (i, 2) +%!error wblrnd (2, i) +%!error wblrnd (1,2, -1) +%!error wblrnd (1,2, ones(2)) +%!error wblrnd (1, 2, [2 -1 2]) +%!error wblrnd (1,2, 1, ones(2)) +%!error wblrnd (1,2, 1, -1) +%!error wblrnd (ones(2,2), 2, 3) +%!error wblrnd (ones(2,2), 2, [3, 2]) +%!error wblrnd (ones(2,2), 2, 2, 3) + diff --git a/octave_packages/m/statistics/distributions/wienrnd.m b/octave_packages/m/statistics/distributions/wienrnd.m new file mode 100644 index 0000000..556ff38 --- /dev/null +++ b/octave_packages/m/statistics/distributions/wienrnd.m @@ -0,0 +1,54 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} wienrnd (@var{t}, @var{d}, @var{n}) +## Return a simulated realization of the @var{d}-dimensional Wiener Process +## on the interval [0, @var{t}]. If @var{d} is omitted, @var{d} = 1 is +## used. The first column of the return matrix contains time, the +## remaining columns contain the Wiener process. +## +## The optional parameter @var{n} gives the number of summands used for +## simulating the process over an interval of length 1. If @var{n} is +## omitted, @var{n} = 1000 is used. +## @end deftypefn + +## Author: FL +## Description: Simulate a Wiener process + +function retval = wienrnd (t, d, n) + + if (nargin == 1) + d = 1; + n = 1000; + elseif (nargin == 2) + n = 1000; + elseif (nargin > 3) + print_usage (); + endif + + if (!isscalar (t) || !isscalar (d) || !isscalar (n)) + error ("wienrnd: T, D and N must all be positive integers"); + endif + + retval = randn (n * t, d); + retval = cumsum (retval) / sqrt (n); + + retval = [((1: n*t)' / n), retval]; + +endfunction diff --git a/octave_packages/m/statistics/models/logistic_regression.m b/octave_packages/m/statistics/models/logistic_regression.m new file mode 100644 index 0000000..8973945 --- /dev/null +++ b/octave_packages/m/statistics/models/logistic_regression.m @@ -0,0 +1,192 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{theta}, @var{beta}, @var{dev}, @var{dl}, @var{d2l}, @var{p}] =} logistic_regression (@var{y}, @var{x}, @var{print}, @var{theta}, @var{beta}) +## Perform ordinal logistic regression. +## +## Suppose @var{y} takes values in @var{k} ordered categories, and let +## @code{gamma_i (@var{x})} be the cumulative probability that @var{y} +## falls in one of the first @var{i} categories given the covariate +## @var{x}. Then +## +## @example +## [theta, beta] = logistic_regression (y, x) +## @end example +## +## @noindent +## fits the model +## +## @example +## logit (gamma_i (x)) = theta_i - beta' * x, i = 1 @dots{} k-1 +## @end example +## +## The number of ordinal categories, @var{k}, is taken to be the number +## of distinct values of @code{round (@var{y})}. If @var{k} equals 2, +## @var{y} is binary and the model is ordinary logistic regression. The +## matrix @var{x} is assumed to have full column rank. +## +## Given @var{y} only, @code{theta = logistic_regression (y)} +## fits the model with baseline logit odds only. +## +## The full form is +## +## @example +## @group +## [theta, beta, dev, dl, d2l, gamma] +## = logistic_regression (y, x, print, theta, beta) +## @end group +## @end example +## +## @noindent +## in which all output arguments and all input arguments except @var{y} +## are optional. +## +## Setting @var{print} to 1 requests summary information about the fitted +## model to be displayed. Setting @var{print} to 2 requests information +## about convergence at each iteration. Other values request no +## information to be displayed. The input arguments @var{theta} and +## @var{beta} give initial estimates for @var{theta} and @var{beta}. +## +## The returned value @var{dev} holds minus twice the log-likelihood. +## +## The returned values @var{dl} and @var{d2l} are the vector of first +## and the matrix of second derivatives of the log-likelihood with +## respect to @var{theta} and @var{beta}. +## +## @var{p} holds estimates for the conditional distribution of @var{y} +## given @var{x}. +## @end deftypefn + +## Original for MATLAB written by Gordon K Smyth , +## U of Queensland, Australia, on Nov 19, 1990. Last revision Aug 3, +## 1992. + +## Author: Gordon K Smyth , +## Adapted-By: KH +## Description: Ordinal logistic regression + +## Uses the auxiliary functions logistic_regression_derivatives and +## logistic_regression_likelihood. + +function [theta, beta, dev, dl, d2l, p] = logistic_regression (y, x, print, theta, beta) + + ## check input + y = round (vec (y)); + [my, ny] = size (y); + if (nargin < 2) + x = zeros (my, 0); + endif; + [mx, nx] = size (x); + if (mx != my) + error ("logistic_regression: X and Y must have the same number of observations"); + endif + + ## initial calculations + x = -x; + tol = 1e-6; incr = 10; decr = 2; + ymin = min (y); ymax = max (y); yrange = ymax - ymin; + z = (y * ones (1, yrange)) == ((y * 0 + 1) * (ymin : (ymax - 1))); + z1 = (y * ones (1, yrange)) == ((y * 0 + 1) * ((ymin + 1) : ymax)); + z = z(:, any (z)); + z1 = z1 (:, any(z1)); + [mz, nz] = size (z); + + ## starting values + if (nargin < 3) + print = 0; + endif; + if (nargin < 4) + beta = zeros (nx, 1); + endif; + if (nargin < 5) + g = cumsum (sum (z))' ./ my; + theta = log (g ./ (1 - g)); + endif; + tb = [theta; beta]; + + ## likelihood and derivatives at starting values + [g, g1, p, dev] = logistic_regression_likelihood (y, x, tb, z, z1); + [dl, d2l] = logistic_regression_derivatives (x, z, z1, g, g1, p); + epsilon = std (vec (d2l)) / 1000; + + ## maximize likelihood using Levenberg modified Newton's method + iter = 0; + while (abs (dl' * (d2l \ dl) / length (dl)) > tol) + iter = iter + 1; + tbold = tb; + devold = dev; + tb = tbold - d2l \ dl; + [g, g1, p, dev] = logistic_regression_likelihood (y, x, tb, z, z1); + if ((dev - devold) / (dl' * (tb - tbold)) < 0) + epsilon = epsilon / decr; + else + while ((dev - devold) / (dl' * (tb - tbold)) > 0) + epsilon = epsilon * incr; + if (epsilon > 1e+15) + error ("logistic_regression: epsilon too large"); + endif + tb = tbold - (d2l - epsilon * eye (size (d2l))) \ dl; + [g, g1, p, dev] = logistic_regression_likelihood (y, x, tb, z, z1); + disp ("epsilon"); disp (epsilon); + endwhile + endif + [dl, d2l] = logistic_regression_derivatives (x, z, z1, g, g1, p); + if (print == 2) + disp ("Iteration"); disp (iter); + disp ("Deviance"); disp (dev); + disp ("First derivative"); disp (dl'); + disp ("Eigenvalues of second derivative"); disp (eig (d2l)'); + endif + endwhile + + ## tidy up output + + theta = tb (1 : nz, 1); + beta = tb ((nz + 1) : (nz + nx), 1); + + if (print >= 1) + printf ("\n"); + printf ("Logistic Regression Results:\n"); + printf ("\n"); + printf ("Number of Iterations: %d\n", iter); + printf ("Deviance: %f\n", dev); + printf ("Parameter Estimates:\n"); + printf (" Theta S.E.\n"); + se = sqrt (diag (inv (-d2l))); + for i = 1 : nz + printf (" %8.4f %8.4f\n", tb (i), se (i)); + endfor + if (nx > 0) + printf (" Beta S.E.\n"); + for i = (nz + 1) : (nz + nx) + printf (" %8.4f %8.4f\n", tb (i), se (i)); + endfor + endif + endif + + if (nargout == 6) + if (nx > 0) + e = ((x * beta) * ones (1, nz)) + ((y * 0 + 1) * theta'); + else + e = (y * 0 + 1) * theta'; + endif + gamma = diff ([(y * 0), (exp (e) ./ (1 + exp (e))), (y * 0 + 1)]')'; + endif + +endfunction diff --git a/octave_packages/m/statistics/models/private/logistic_regression_derivatives.m b/octave_packages/m/statistics/models/private/logistic_regression_derivatives.m new file mode 100644 index 0000000..f8a3081 --- /dev/null +++ b/octave_packages/m/statistics/models/private/logistic_regression_derivatives.m @@ -0,0 +1,47 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{dl}, @var{d2l}] =} logistic_regression_derivatives (@var{x}, @var{z}, @var{z1}, @var{g}, @var{g1}, @var{p}) +## Calculate derivatives of the log-likelihood for ordinal logistic regression +## model. +## Private function called by @code{logistic_regression}. +## @seealso{logistic_regression} +## @end deftypefn + +## Author: Gordon K. Smyth +## Adapted-By: KH +## Description: Derivates of log-likelihood in logistic regression + +function [dl, d2l] = logistic_regression_derivatives (x, z, z1, g, g1, p) + + if (nargin != 6) + print_usage (); + endif + + ## first derivative + v = g .* (1 - g) ./ p; v1 = g1 .* (1 - g1) ./ p; + dlogp = [(diag (v) * z - diag (v1) * z1), (diag (v - v1) * x)]; + dl = sum (dlogp)'; + + ## second derivative + w = v .* (1 - 2 * g); w1 = v1 .* (1 - 2 * g1); + d2l = [z, x]' * diag (w) * [z, x] - [z1, x]' * diag (w1) * [z1, x] ... + - dlogp' * dlogp; + +endfunction diff --git a/octave_packages/m/statistics/models/private/logistic_regression_likelihood.m b/octave_packages/m/statistics/models/private/logistic_regression_likelihood.m new file mode 100644 index 0000000..984a059 --- /dev/null +++ b/octave_packages/m/statistics/models/private/logistic_regression_likelihood.m @@ -0,0 +1,43 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{g}, @var{g1}, @var{p}, @var{dev}] =} logistic_regression_likelihood (@var{y}, @var{x}, @var{beta}, @var{z}, @var{z1}) +## Calculate the likelihood for the ordinal logistic regression model. +## Private function called by @code{logistic_regression}. +## @seealso{logistic_regression} +## @end deftypefn + +## Author: Gordon K. Smyth +## Adapted-By: KH +## Description: Likelihood in logistic regression + +function [g, g1, p, dev] = logistic_regression_likelihood (y, x, beta, z, z1) + + if (nargin != 5) + print_usage (); + endif + + e = exp ([z, x] * beta); e1 = exp ([z1, x] * beta); + g = e ./ (1 + e); g1 = e1 ./ (1 + e1); + g = max (y == max (y), g); g1 = min (y > min(y), g1); + + p = g - g1; + dev = -2 * sum (log (p)); + +endfunction diff --git a/octave_packages/m/statistics/tests/anova.m b/octave_packages/m/statistics/tests/anova.m new file mode 100644 index 0000000..d2776f0 --- /dev/null +++ b/octave_packages/m/statistics/tests/anova.m @@ -0,0 +1,110 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{f}, @var{df_b}, @var{df_w}] =} anova (@var{y}, @var{g}) +## Perform a one-way analysis of variance (ANOVA). The goal is to test +## whether the population means of data taken from @var{k} different +## groups are all equal. +## +## Data may be given in a single vector @var{y} with groups specified by +## a corresponding vector of group labels @var{g} (e.g., numbers from 1 +## to @var{k}). This is the general form which does not impose any +## restriction on the number of data in each group or the group labels. +## +## If @var{y} is a matrix and @var{g} is omitted, each column of @var{y} +## is treated as a group. This form is only appropriate for balanced +## ANOVA in which the numbers of samples from each group are all equal. +## +## Under the null of constant means, the statistic @var{f} follows an F +## distribution with @var{df_b} and @var{df_w} degrees of freedom. +## +## The p-value (1 minus the CDF of this distribution at @var{f}) is +## returned in @var{pval}. +## +## If no output argument is given, the standard one-way ANOVA table is +## printed. +## @end deftypefn + +## Author: KH +## Description: One-way analysis of variance (ANOVA) + +function [pval, f, df_b, df_w] = anova (y, g) + + if ((nargin < 1) || (nargin > 2)) + print_usage (); + elseif (nargin == 1) + if (isvector (y)) + error ("anova: for `anova (Y)', Y must not be a vector"); + endif + [group_count, k] = size (y); + n = group_count * k; + group_mean = mean (y); + else + if (! isvector (y)) + error ("anova: for `anova (Y, G)', Y must be a vector"); + endif + n = length (y); + if (! isvector (g) || (length (g) != n)) + error ("anova: G must be a vector of the same length as Y"); + endif + s = sort (g); + i = find (s (2 : n) > s(1 : (n-1))); + k = length (i) + 1; + if (k == 1) + error ("anova: there should be at least 2 groups"); + else + group_label = s ([1, (reshape (i, 1, k-1) + 1)]); + endif + for i = 1 : k; + v = y (find (g == group_label (i))); + group_count (i) = length (v); + group_mean (i) = mean (v); + endfor + + endif + + total_mean = mean (y(:)); + SSB = sum (group_count .* (group_mean - total_mean) .^ 2); + SST = sumsq (reshape (y, n, 1) - total_mean); + SSW = SST - SSB; + df_b = k - 1; + df_w = n - k; + v_b = SSB / df_b; + v_w = SSW / df_w; + f = v_b / v_w; + pval = 1 - fcdf (f, df_b, df_w); + + if (nargout == 0) + ## This eventually needs to be done more cleanly ... + printf ("\n"); + printf ("One-way ANOVA Table:\n"); + printf ("\n"); + printf ("Source of Variation Sum of Squares df Empirical Var\n"); + printf ("*********************************************************\n"); + printf ("Between Groups %15.4f %4d %13.4f\n", SSB, df_b, v_b); + printf ("Within Groups %15.4f %4d %13.4f\n", SSW, df_w, v_w); + printf ("---------------------------------------------------------\n"); + printf ("Total %15.4f %4d\n", SST, n - 1); + printf ("\n"); + printf ("Test Statistic f %15.4f\n", f); + printf ("p-value %15.4f\n", pval); + printf ("\n"); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/bartlett_test.m b/octave_packages/m/statistics/tests/bartlett_test.m new file mode 100644 index 0000000..35308a7 --- /dev/null +++ b/octave_packages/m/statistics/tests/bartlett_test.m @@ -0,0 +1,67 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{chisq}, @var{df}] =} bartlett_test (@var{x1}, @dots{}) +## Perform a Bartlett test for the homogeneity of variances in the data +## vectors @var{x1}, @var{x2}, @dots{}, @var{xk}, where @var{k} > 1. +## +## Under the null of equal variances, the test statistic @var{chisq} +## approximately follows a chi-square distribution with @var{df} degrees of +## freedom. +## +## The p-value (1 minus the CDF of this distribution at @var{chisq}) is +## returned in @var{pval}. +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: KH +## Description: Bartlett test for homogeneity of variances + +function [pval, chisq, df] = bartlett_test (varargin) + + k = nargin; + if (k < 2) + print_usage (); + endif + + f = zeros (k, 1); + v = zeros (k, 1); + + for i = 1 : k; + x = varargin{i}; + if (! isvector (x)) + error ("bartlett_test: all arguments must be vectors"); + endif + f(i) = length (x) - 1; + v(i) = var (x); + endfor + + f_tot = sum (f); + v_tot = sum (f .* v) / f_tot; + c = 1 + (sum (1 ./ f) - 1 / f_tot) / (3 * (k - 1)); + chisq = (f_tot * log (v_tot) - sum (f .* log (v))) / c; + df = k; + pval = 1 - chi2cdf (chisq, df); + + if (nargout == 0) + printf(" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/chisquare_test_homogeneity.m b/octave_packages/m/statistics/tests/chisquare_test_homogeneity.m new file mode 100644 index 0000000..8cf32bf --- /dev/null +++ b/octave_packages/m/statistics/tests/chisquare_test_homogeneity.m @@ -0,0 +1,68 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{chisq}, @var{df}] =} chisquare_test_homogeneity (@var{x}, @var{y}, @var{c}) +## Given two samples @var{x} and @var{y}, perform a chisquare test for +## homogeneity of the null hypothesis that @var{x} and @var{y} come from +## the same distribution, based on the partition induced by the +## (strictly increasing) entries of @var{c}. +## +## For large samples, the test statistic @var{chisq} approximately follows a +## chisquare distribution with @var{df} = @code{length (@var{c})} +## degrees of freedom. +## +## The p-value (1 minus the CDF of this distribution at @var{chisq}) is +## returned in @var{pval}. +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: KH +## Description: Chi-square test for homogeneity + +function [pval, chisq, df] = chisquare_test_homogeneity (x, y, c) + + if (nargin != 3) + print_usage (); + endif + + if (! (isvector(x) && isvector(y) && isvector(c))) + error ("chisquare_test_homogeneity: X, Y and C must be vectors"); + endif + ## Now test c for strictly increasing entries + df = length (c); + if (any ((c(2 : df) - c(1 : (df - 1))) <= 0)) + error ("chisquare_test_homogeneity: C must be increasing"); + endif + + c = [(reshape (c, 1, df)), Inf]; + l_x = length (x); + x = reshape (x, l_x, 1); + n_x = sum (x * ones (1, df+1) < ones (l_x, 1) * c); + l_y = length (y); + y = reshape (y, l_y, 1); + n_y = sum(y * ones (1, df+1) < ones (l_y, 1) * c); + chisq = l_x * l_y * sum ((n_x/l_x - n_y/l_y).^2 ./ (n_x + n_y)); + pval = 1 - chi2cdf (chisq, df); + + if (nargout == 0) + printf(" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/chisquare_test_independence.m b/octave_packages/m/statistics/tests/chisquare_test_independence.m new file mode 100644 index 0000000..7353e4b --- /dev/null +++ b/octave_packages/m/statistics/tests/chisquare_test_independence.m @@ -0,0 +1,53 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{chisq}, @var{df}] =} chisquare_test_independence (@var{x}) +## Perform a chi-square test for independence based on the contingency +## table @var{x}. Under the null hypothesis of independence, +## @var{chisq} approximately has a chi-square distribution with +## @var{df} degrees of freedom. +## +## The p-value (1 minus the CDF of this distribution at chisq) of the +## test is returned in @var{pval}. +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: KH +## Description: Chi-square test for independence + +function [pval, chisq, df] = chisquare_test_independence (x) + + if (nargin != 1) + print_usage (); + endif + + [r, s] = size (x); + df = (r - 1) * (s - 1); + n = sum (sum (x)); + y = sum (x')' * sum (x) / n; + x = (x - y) .^2 ./ y; + chisq = sum (sum (x)); + pval = 1 - chi2cdf (chisq, df); + + if (nargout == 0) + printf(" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/cor_test.m b/octave_packages/m/statistics/tests/cor_test.m new file mode 100644 index 0000000..f275147 --- /dev/null +++ b/octave_packages/m/statistics/tests/cor_test.m @@ -0,0 +1,135 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cor_test (@var{x}, @var{y}, @var{alt}, @var{method}) +## Test whether two samples @var{x} and @var{y} come from uncorrelated +## populations. +## +## The optional argument string @var{alt} describes the alternative +## hypothesis, and can be @code{"!="} or @code{"<>"} (non-zero), +## @code{">"} (greater than 0), or @code{"<"} (less than 0). The +## default is the two-sided case. +## +## The optional argument string @var{method} specifies which +## correlation coefficient to use for testing. If @var{method} is +## @code{"pearson"} (default), the (usual) Pearson's product moment +## correlation coefficient is used. In this case, the data should come +## from a bivariate normal distribution. Otherwise, the other two +## methods offer nonparametric alternatives. If @var{method} is +## @code{"kendall"}, then Kendall's rank correlation tau is used. If +## @var{method} is @code{"spearman"}, then Spearman's rank correlation +## rho is used. Only the first character is necessary. +## +## The output is a structure with the following elements: +## +## @table @var +## @item pval +## The p-value of the test. +## +## @item stat +## The value of the test statistic. +## +## @item dist +## The distribution of the test statistic. +## +## @item params +## The parameters of the null distribution of the test statistic. +## +## @item alternative +## The alternative hypothesis. +## +## @item method +## The method used for testing. +## @end table +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: FL +## Adapted-by: KH +## Description: Test for zero correlation + +function t = cor_test (x, y, alt, method) + + if ((nargin < 2) || (nargin > 4)) + print_usage (); + endif + + if (!isvector (x) || !isvector (y) || length (x) != length (y)) + error ("cor_test: X and Y must be vectors of the same length"); + endif + + if (nargin < 3) + alt = "!="; + elseif (! ischar (alt)) + error ("cor_test: ALT must be a string"); + endif + + if (nargin < 4) + method = "pearson"; + elseif (! ischar (method)) + error ("cor_test: METHOD must be a string"); + endif + + n = length (x); + m = method (1); + + if (m == "p") + r = corr (x, y); + df = n - 2; + t.method = "Pearson's product moment correlation"; + t.params = df; + t.stat = sqrt (df) .* r / sqrt (1 - r.^2); + t.dist = "t"; + cdf = tcdf (t.stat, df); + elseif (m == "k") + tau = kendall (x, y); + t.method = "Kendall's rank correlation tau"; + t.params = []; + t.stat = tau / sqrt ((2 * (2*n+5)) / (9*n*(n-1))); + t.dist = "stdnormal"; + cdf = stdnormal_cdf (t.stat); + elseif (m == "s") + rho = spearman (x, y); + t.method = "Spearman's rank correlation rho"; + t.params = []; + t.stat = sqrt (n-1) * (rho - 6/(n^3-n)); + t.dist = "stdnormal"; + cdf = stdnormal_cdf (t.stat); + else + error ("cor_test: METHOD `%s' not recognized", method); + endif + + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + t.pval = 2 * min (cdf, 1 - cdf); + elseif (strcmp (alt, ">")) + t.pval = 1 - cdf; + elseif (strcmp (alt, "<")) + t.pval = cdf; + else + error ("cor_test: alternative `%s' not recognized", alt); + endif + + t.alternative = alt; + + if (nargout == 0) + printf ("pval: %g\n", t.pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/f_test_regression.m b/octave_packages/m/statistics/tests/f_test_regression.m new file mode 100644 index 0000000..7aa9809 --- /dev/null +++ b/octave_packages/m/statistics/tests/f_test_regression.m @@ -0,0 +1,77 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{f}, @var{df_num}, @var{df_den}] =} f_test_regression (@var{y}, @var{x}, @var{rr}, @var{r}) +## Perform an F test for the null hypothesis rr * b = r in a classical +## normal regression model y = X * b + e. +## +## Under the null, the test statistic @var{f} follows an F distribution +## with @var{df_num} and @var{df_den} degrees of freedom. +## +## The p-value (1 minus the CDF of this distribution at @var{f}) is +## returned in @var{pval}. +## +## If not given explicitly, @var{r} = 0. +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: KH +## Description: Test linear hypotheses in linear regression model + +function [pval, f, df_num, df_den] = f_test_regression (y, x, rr, r) + + if (nargin < 3 || nargin > 4) + print_usage (); + endif + + [T, k] = size (x); + if (! (isvector (y) && (length (y) == T))) + error ("f_test_regression: Y must be a vector of length rows (X)"); + endif + y = reshape (y, T, 1); + + [q, c_R ] = size (rr); + if (c_R != k) + error ("f_test_regression: RR must have as many columns as X"); + endif + + if (nargin == 4) + s_r = size (r); + if ((min (s_r) != 1) || (max (s_r) != q)) + error ("f_test_regression: R must be a vector of length rows (RR)"); + endif + r = reshape (r, q, 1); + else + r = zeros (q, 1); + endif + + df_num = q; + df_den = T - k; + + [b, v] = ols (y, x); + diff = rr * b - r; + f = diff' * inv (rr * inv (x' * x) * rr') * diff / (q * v); + pval = 1 - fcdf (f, df_num, df_den); + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/hotelling_test.m b/octave_packages/m/statistics/tests/hotelling_test.m new file mode 100644 index 0000000..6759a35 --- /dev/null +++ b/octave_packages/m/statistics/tests/hotelling_test.m @@ -0,0 +1,72 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{tsq}] =} hotelling_test (@var{x}, @var{m}) +## For a sample @var{x} from a multivariate normal distribution with unknown +## mean and covariance matrix, test the null hypothesis that @code{mean +## (@var{x}) == @var{m}}. +## +## Hotelling's @math{T^2} is returned in @var{tsq}. Under the null, +## @math{(n-p) T^2 / (p(n-1))} has an F distribution with @math{p} and +## @math{n-p} degrees of freedom, where @math{n} and @math{p} are the +## numbers of samples and variables, respectively. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Test for mean of a multivariate normal + +function [pval, Tsq] = hotelling_test (x, m) + + if (nargin != 2) + print_usage (); + endif + + if (isvector (x)) + if (! isscalar (m)) + error ("hotelling_test: if X is a vector, M must be a scalar"); + endif + n = length (x); + p = 1; + elseif (ismatrix (x)) + [n, p] = size (x); + if (n <= p) + error ("hotelling_test: X must have more rows than columns"); + endif + if (isvector (m) && length (m) == p) + m = reshape (m, 1, p); + else + error ("hotelling_test: if X is a matrix, M must be a vector of length columns (X)"); + endif + else + error ("hotelling_test: X must be a matrix or vector"); + endif + + d = mean (x) - m; + Tsq = n * d * (cov (x) \ d'); + pval = 1 - fcdf ((n-p) * Tsq / (p * (n-1)), p, n-p); + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/hotelling_test_2.m b/octave_packages/m/statistics/tests/hotelling_test_2.m new file mode 100644 index 0000000..e830145 --- /dev/null +++ b/octave_packages/m/statistics/tests/hotelling_test_2.m @@ -0,0 +1,86 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{tsq}] =} hotelling_test_2 (@var{x}, @var{y}) +## For two samples @var{x} from multivariate normal distributions with +## the same number of variables (columns), unknown means and unknown +## equal covariance matrices, test the null hypothesis @code{mean +## (@var{x}) == mean (@var{y})}. +## +## Hotelling's two-sample @math{T^2} is returned in @var{tsq}. Under the null, +## @tex +## $$ +## {n_x+n_y-p-1) T^2 \over p(n_x+n_y-2)} +## $$ +## @end tex +## @ifnottex +## +## @example +## (n_x+n_y-p-1) T^2 / (p(n_x+n_y-2)) +## @end example +## +## @end ifnottex +## @noindent +## has an F distribution with @math{p} and @math{n_x+n_y-p-1} degrees of +## freedom, where @math{n_x} and @math{n_y} are the sample sizes and +## @math{p} is the number of variables. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Compare means of two multivariate normals + +function [pval, Tsq] = hotelling_test_2 (x, y) + + if (nargin != 2) + print_usage (); + endif + + if (isvector (x)) + n_x = length (x); + if (! isvector (y)) + error ("hotelling_test_2: if X is a vector, Y must also be a vector"); + else + n_y = length (y); + p = 1; + endif + elseif (ismatrix (x)) + [n_x, p] = size (x); + [n_y, q] = size (y); + if (p != q) + error ("hotelling_test_2: X and Y must have the same number of columns"); + endif + else + error ("hotelling_test_2: X and Y must be matrices (or vectors)"); + endif + + d = mean (x) - mean (y); + S = ((n_x - 1) * cov (x) + (n_y - 1) * cov (y)) / (n_x + n_y - 2); + Tsq = (n_x * n_y / (n_x + n_y)) * d * (S \ d'); + pval = 1 - fcdf ((n_x + n_y - p - 1) * Tsq / (p * (n_x + n_y - 2)), + p, n_x + n_y - p - 1); + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/kolmogorov_smirnov_test.m b/octave_packages/m/statistics/tests/kolmogorov_smirnov_test.m new file mode 100644 index 0000000..ff01503 --- /dev/null +++ b/octave_packages/m/statistics/tests/kolmogorov_smirnov_test.m @@ -0,0 +1,126 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{ks}] =} kolmogorov_smirnov_test (@var{x}, @var{dist}, @var{params}, @var{alt}) +## Perform a Kolmogorov-Smirnov test of the null hypothesis that the +## sample @var{x} comes from the (continuous) distribution dist. I.e., +## if F and G are the CDFs corresponding to the sample and dist, +## respectively, then the null is that F == G. +## +## The optional argument @var{params} contains a list of parameters of +## @var{dist}. For example, to test whether a sample @var{x} comes from +## a uniform distribution on [2,4], use +## +## @example +## kolmogorov_smirnov_test(x, "unif", 2, 4) +## @end example +## +## @noindent +## @var{dist} can be any string for which a function @var{dist_cdf} +## that calculates the CDF of distribution @var{dist} exists. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative F +## != G@. In this case, the test statistic @var{ks} follows a two-sided +## Kolmogorov-Smirnov distribution. If @var{alt} is @code{">"}, the +## one-sided alternative F > G is considered. Similarly for @code{"<"}, +## the one-sided alternative F > G is considered. In this case, the +## test statistic @var{ks} has a one-sided Kolmogorov-Smirnov +## distribution. The default is the two-sided case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: KH +## Description: One-sample Kolmogorov-Smirnov test + +function [pval, ks] = kolmogorov_smirnov_test (x, dist, varargin) + + if (nargin < 2) + print_usage (); + endif + + if (! isvector (x)) + error ("kolmogorov_smirnov_test: X must be a vector"); + endif + + n = length (x); + s = sort (x); + try + f = str2func (sprintf ("%scdf", dist)); + catch + try + f = str2func (sprintf ("%s_cdf", dist)); + catch + error ("kolmogorov_smirnov_test: no %scdf or %s_cdf function found", + dist, dist); + end_try_catch + end_try_catch + + alt = "!="; + + args{1} = s; + nvargs = numel (varargin); + if (nvargs > 0) + if (ischar (varargin{end})) + alt = varargin{end}; + args(2:nvargs) = varargin(1:end-1); + else + args(2:nvargs+1) = varargin; + endif + endif + + z = reshape (feval (f, args{:}), 1, n); + + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + ks = sqrt (n) * max (max ([abs(z - (0:(n-1))/n); abs(z - (1:n)/n)])); + pval = 1 - kolmogorov_smirnov_cdf (ks); + elseif (strcmp (alt, ">")) + ks = sqrt (n) * max (max ([z - (0:(n-1))/n; z - (1:n)/n])); + pval = exp (- 2 * ks^2); + elseif (strcmp (alt, "<")) + ks = - sqrt (n) * min (min ([z - (0:(n-1))/n; z - (1:n)/n])); + pval = exp (- 2 * ks^2); + else + error ("kolmogorov_smirnov_test: alternative %s not recognized", alt); + endif + + if (nargout == 0) + printf ("pval: %g\n", pval); + endif + +endfunction + +%!error +%! kolmogorov_smirnov_test (1); +%!error +%! kolmogorov_smirnov_test ({}, "unif", 2, 4); +%!error +%! kolmogorov_smirnov_test (1, "not_a_dist"); +%!error +%! kolmogorov_smirnov_test (1, "unif", 2, 4, "bla"); +%!test # for recognition of unifcdf function +%! assert (kolmogorov_smirnov_test (0:100, "unif", 0, 100), 1.0, eps); +%!test # for recognition of logistic_cdf function +%! assert (kolmogorov_smirnov_test (0:100, "logistic"), 0); +%!test # F < G +%! assert (kolmogorov_smirnov_test (50:100, "unif", 0, 50, "<")); diff --git a/octave_packages/m/statistics/tests/kolmogorov_smirnov_test_2.m b/octave_packages/m/statistics/tests/kolmogorov_smirnov_test_2.m new file mode 100644 index 0000000..2cadd1c --- /dev/null +++ b/octave_packages/m/statistics/tests/kolmogorov_smirnov_test_2.m @@ -0,0 +1,104 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{ks}, @var{d}] =} kolmogorov_smirnov_test_2 (@var{x}, @var{y}, @var{alt}) +## Perform a 2-sample Kolmogorov-Smirnov test of the null hypothesis +## that the samples @var{x} and @var{y} come from the same (continuous) +## distribution. I.e., if F and G are the CDFs corresponding to the +## @var{x} and @var{y} samples, respectively, then the null is that F == +## G. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative F +## != G@. In this case, the test statistic @var{ks} follows a two-sided +## Kolmogorov-Smirnov distribution. If @var{alt} is @code{">"}, the +## one-sided alternative F > G is considered. Similarly for @code{"<"}, +## the one-sided alternative F < G is considered. In this case, the +## test statistic @var{ks} has a one-sided Kolmogorov-Smirnov +## distribution. The default is the two-sided case. +## +## The p-value of the test is returned in @var{pval}. +## +## The third returned value, @var{d}, is the test statistic, the maximum +## vertical distance between the two cumulative distribution functions. +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: KH +## Description: Two-sample Kolmogorov-Smirnov test + +function [pval, ks, d] = kolmogorov_smirnov_test_2 (x, y, alt) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (! (isvector (x) && isvector (y))) + error ("kolmogorov_smirnov_test_2: both X and Y must be vectors"); + endif + + if (nargin == 2) + alt = "!="; + else + if (! ischar (alt)) + error ("kolmogorov_smirnov_test_2: ALT must be a string"); + endif + endif + + n_x = length (x); + n_y = length (y); + n = n_x * n_y / (n_x + n_y); + x = reshape (x, n_x, 1); + y = reshape (y, n_y, 1); + [s, i] = sort ([x; y]); + count (find (i <= n_x)) = 1 / n_x; + count (find (i > n_x)) = - 1 / n_y; + + z = cumsum (count); + ds = diff (s); + if (any (ds == 0)) + ## There are some ties, so keep only those changes. + warning ("cannot compute correct p-values with ties"); + elems = [find(ds); n_x+n_y]; + z = z(elems); + endif + + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + d = max (abs (z)); + ks = sqrt (n) * d; + pval = 1 - kolmogorov_smirnov_cdf (ks); + elseif (strcmp (alt, ">")) + d = max (z); + ks = sqrt (n) * d; + pval = exp (-2 * ks^2); + elseif (strcmp (alt, "<")) + d = min (z); + ks = -sqrt (n) * d; + pval = exp (-2 * ks^2); + else + error ("kolmogorov_smirnov_test_2: option %s not recognized", alt); + endif + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/kruskal_wallis_test.m b/octave_packages/m/statistics/tests/kruskal_wallis_test.m new file mode 100644 index 0000000..50410ba --- /dev/null +++ b/octave_packages/m/statistics/tests/kruskal_wallis_test.m @@ -0,0 +1,98 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{k}, @var{df}] =} kruskal_wallis_test (@var{x1}, @dots{}) +## Perform a Kruskal-Wallis one-factor "analysis of variance". +## +## Suppose a variable is observed for @var{k} > 1 different groups, and +## let @var{x1}, @dots{}, @var{xk} be the corresponding data vectors. +## +## Under the null hypothesis that the ranks in the pooled sample are not +## affected by the group memberships, the test statistic @var{k} is +## approximately chi-square with @var{df} = @var{k} - 1 degrees of +## freedom. +## +## If the data contains ties (some value appears more than once) +## @var{k} is divided by +## +## 1 - @var{sum_ties} / (@var{n}^3 - @var{n}) +## +## where @var{sum_ties} is the sum of @var{t}^2 - @var{t} over each group +## of ties where @var{t} is the number of ties in the group and @var{n} +## is the total number of values in the input data. For more info on +## this adjustment see "Use of Ranks in One-Criterion Variance Analysis" +## in Journal of the American Statistical Association, Vol. 47, +## No. 260 (Dec 1952) by William H. Kruskal and W. Allen Wallis. +## +## The p-value (1 minus the CDF of this distribution at @var{k}) is +## returned in @var{pval}. +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: KH +## Description: Kruskal-Wallis test + +function [pval, k, df] = kruskal_wallis_test (varargin) + + m = nargin; + if (m < 2) + print_usage (); + endif + + n = []; + p = []; + + for i = 1 : m; + x = varargin{i}; + if (! isvector (x)) + error ("kruskal_wallis_test: all arguments must be vectors"); + endif + l = length (x); + n = [n, l]; + p = [p, (reshape (x, 1, l))]; + endfor + + r = ranks (p); + + k = 0; + j = 0; + for i = 1 : m; + k = k + (sum (r ((j + 1) : (j + n(i))))) ^ 2 / n(i); + j = j + n(i); + endfor + + n = length (p); + k = 12 * k / (n * (n + 1)) - 3 * (n + 1); + + ## Adjust the result to takes ties into account. + sum_ties = sum (polyval ([1, 0, -1, 0], runlength (sort (p)))); + k = k / (1 - sum_ties / (n^3 - n)); + + df = m - 1; + pval = 1 - chi2cdf (k, df); + + if (nargout == 0) + printf ("pval: %g\n", pval); + endif + +endfunction + +## Test with ties +%!assert (abs(kruskal_wallis_test([86 86], [74]) - 0.157299207050285) < 0.0000000000001) diff --git a/octave_packages/m/statistics/tests/manova.m b/octave_packages/m/statistics/tests/manova.m new file mode 100644 index 0000000..01f7551 --- /dev/null +++ b/octave_packages/m/statistics/tests/manova.m @@ -0,0 +1,161 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} manova (@var{x}, @var{g}) +## Perform a one-way multivariate analysis of variance (MANOVA). The +## goal is to test whether the p-dimensional population means of data +## taken from @var{k} different groups are all equal. All data are +## assumed drawn independently from p-dimensional normal distributions +## with the same covariance matrix. +## +## The data matrix is given by @var{x}. As usual, rows are observations +## and columns are variables. The vector @var{g} specifies the +## corresponding group labels (e.g., numbers from 1 to @var{k}). +## +## The LR test statistic (Wilks' Lambda) and approximate p-values are +## computed and displayed. +## @end deftypefn + +## Three test statistics (Wilks, Hotelling-Lawley, and Pillai-Bartlett) +## and corresponding approximate p-values are calculated and displayed. +## (Currently NOT because the fcdf respectively betai code is too bad.) + +## Author: TF +## Adapted-By: KH +## Description: One-way multivariate analysis of variance (MANOVA) + +function manova (x, g) + + if (nargin != 2) + print_usage (); + endif + + if (isvector (x)) + error ("manova: Y must not be a vector"); + endif + + [n, p] = size (x); + + if (!isvector (g) || (length (g) != n)) + error ("manova: G must be a vector of length rows (Y)"); + endif + + s = sort (g); + i = find (s (2:n) > s(1:(n-1))); + k = length (i) + 1; + + if (k == 1) + error ("manova: there should be at least 2 groups"); + else + group_label = s ([1, (reshape (i, 1, k - 1) + 1)]); + endif + + x = x - ones (n, 1) * mean (x); + SST = x' * x; + + s = zeros (1, p); + SSB = zeros (p, p); + for i = 1 : k; + v = x (find (g == group_label (i)), :); + s = sum (v); + SSB = SSB + s' * s / rows (v); + endfor + n_b = k - 1; + + SSW = SST - SSB; + n_w = n - k; + + l = real (eig (SSB / SSW)); + + if (isa (l, "single")) + l (l < eps ("single")) = 0; + else + l (l < eps) = 0; + endif + + ## Wilks' Lambda + ## ============= + + Lambda = prod (1 ./ (1 + l)); + + delta = n_w + n_b - (p + n_b + 1) / 2; + df_num = p * n_b; + W_pval_1 = 1 - chi2cdf (- delta * log (Lambda), df_num); + + if (p < 3) + eta = p; + else + eta = sqrt ((p^2 * n_b^2 - 4) / (p^2 + n_b^2 - 5)); + endif + + df_den = delta * eta - df_num / 2 + 1; + + WT = exp (- log (Lambda) / eta) - 1; + W_pval_2 = 1 - fcdf (WT * df_den / df_num, df_num, df_den); + + if (0) + + ## Hotelling-Lawley Test + ## ===================== + + HL = sum (l); + + theta = min (p, n_b); + u = (abs (p - n_b) - 1) / 2; + v = (n_w - p - 1) / 2; + + df_num = theta * (2 * u + theta + 1); + df_den = 2 * (theta * v + 1); + + HL_pval = 1 - fcdf (HL * df_den / df_num, df_num, df_den); + + ## Pillai-Bartlett + ## =============== + + PB = sum (l ./ (1 + l)); + + df_den = theta * (2 * v + theta + 1); + PB_pval = 1 - fcdf (PB * df_den / df_num, df_num, df_den); + + printf ("\n"); + printf ("One-way MANOVA Table:\n"); + printf ("\n"); + printf ("Test Test Statistic Approximate p\n"); + printf ("**************************************************\n"); + printf ("Wilks %10.4f %10.9f \n", Lambda, W_pval_1); + printf (" %10.9f \n", W_pval_2); + printf ("Hotelling-Lawley %10.4f %10.9f \n", HL, HL_pval); + printf ("Pillai-Bartlett %10.4f %10.9f \n", PB, PB_pval); + printf ("\n"); + + endif + + printf ("\n"); + printf ("MANOVA Results:\n"); + printf ("\n"); + printf ("# of groups: %d\n", k); + printf ("# of samples: %d\n", n); + printf ("# of variables: %d\n", p); + printf ("\n"); + printf ("Wilks' Lambda: %5.4f\n", Lambda); + printf ("Approximate p: %10.9f (chisquare approximation)\n", W_pval_1); + printf (" %10.9f (F approximation)\n", W_pval_2); + printf ("\n"); + +endfunction diff --git a/octave_packages/m/statistics/tests/mcnemar_test.m b/octave_packages/m/statistics/tests/mcnemar_test.m new file mode 100644 index 0000000..594d70a --- /dev/null +++ b/octave_packages/m/statistics/tests/mcnemar_test.m @@ -0,0 +1,67 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{chisq}, @var{df}] =} mcnemar_test (@var{x}) +## For a square contingency table @var{x} of data cross-classified on +## the row and column variables, McNemar's test can be used for testing +## the null hypothesis of symmetry of the classification probabilities. +## +## Under the null, @var{chisq} is approximately distributed as chisquare +## with @var{df} degrees of freedom. +## +## The p-value (1 minus the CDF of this distribution at @var{chisq}) is +## returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: McNemar's test for symmetry + +function [pval, chisq, df] = mcnemar_test (x) + + if (nargin != 1) + print_usage (); + endif + + if (! (min (size (x)) > 1) && issquare (x)) + error ("mcnemar_test: X must be a square matrix of size > 1"); + elseif (! (all (all (x >= 0)) && all (all (x == fix (x))))) + error ("mcnemar_test: all entries of X must be non-negative integers"); + endif + + r = rows (x); + df = r * (r - 1) / 2; + if (r == 2) + num = max (abs (x - x') - 1, 0) .^ 2; + else + num = abs (x - x') .^ 2; + endif + + chisq = sum (sum (triu (num ./ (x + x'), 1))); + pval = 1 - chi2cdf (chisq, df); + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction + + + diff --git a/octave_packages/m/statistics/tests/prop_test_2.m b/octave_packages/m/statistics/tests/prop_test_2.m new file mode 100644 index 0000000..072a24d --- /dev/null +++ b/octave_packages/m/statistics/tests/prop_test_2.m @@ -0,0 +1,80 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{z}] =} prop_test_2 (@var{x1}, @var{n1}, @var{x2}, @var{n2}, @var{alt}) +## If @var{x1} and @var{n1} are the counts of successes and trials in +## one sample, and @var{x2} and @var{n2} those in a second one, test the +## null hypothesis that the success probabilities @var{p1} and @var{p2} +## are the same. Under the null, the test statistic @var{z} +## approximately follows a standard normal distribution. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## @var{p1} != @var{p2}. If @var{alt} is @code{">"}, the one-sided +## alternative @var{p1} > @var{p2} is used. Similarly for @code{"<"}, +## the one-sided alternative @var{p1} < @var{p2} is used. +## The default is the two-sided case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Compare two proportions + +function [pval, z] = prop_test_2 (x1, n1, x2, n2, alt) + + if ((nargin < 4) || (nargin > 5)) + print_usage (); + endif + + ## Could do sanity checking on x1, n1, x2, n2 here + + p1 = x1 / n1; + p2 = x2 / n2; + pc = (x1 + x2) / (n1 + n2); + + z = (p1 - p2) / sqrt (pc * (1 - pc) * (1/n1 + 1/n2)); + + cdf = stdnormal_cdf (z); + + if (nargin == 4) + alt = "!="; + endif + + if (! ischar (alt)) + error ("prop_test_2: ALT must be a string"); + endif + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif strcmp (alt, ">") + pval = 1 - cdf; + elseif strcmp (alt, "<") + pval = cdf; + else + error ("prop_test_2: option %s not recognized", alt); + endif + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/run_test.m b/octave_packages/m/statistics/tests/run_test.m new file mode 100644 index 0000000..c21ce7f --- /dev/null +++ b/octave_packages/m/statistics/tests/run_test.m @@ -0,0 +1,58 @@ +## Copyright (C) 1995-2012 Friedrich Leisch +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{chisq}] =} run_test (@var{x}) +## Perform a chi-square test with 6 degrees of freedom based on the +## upward runs in the columns of @var{x}. Can be used to test whether +## @var{x} contains independent data. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value is displayed. +## @end deftypefn + +## Author: FL +## Description: Run test for independence + +function [pval, chisq] = run_test (x) + + if (nargin != 1) + print_usage (); + endif + + A = [4529.4, 9044.9, 13568, 18091, 22615, 27892; + 9044.4, 18097, 27139, 36187, 45234, 55789; + 13568, 27139, 40721, 54281, 67852, 83685; + 18091, 36187, 54281, 72414, 90470, 111580; + 22615, 45234, 67852, 90470, 113262, 139476; + 27892, 55789, 83685, 111580, 139476, 172860]; + + b = [1/6; 5/24; 11/120; 19/720; 29/5040; 1/840]; + + n = rows (x); + r = run_count (x, 6) - n * b * ones (1, columns(x)); + + chisq = diag (r' * A * r)' / n; + pval = chi2cdf (chisq, 6); + + if (nargout == 0) + printf("pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/sign_test.m b/octave_packages/m/statistics/tests/sign_test.m new file mode 100644 index 0000000..2b6a206 --- /dev/null +++ b/octave_packages/m/statistics/tests/sign_test.m @@ -0,0 +1,83 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{b}, @var{n}] =} sign_test (@var{x}, @var{y}, @var{alt}) +## For two matched-pair samples @var{x} and @var{y}, perform a sign test +## of the null hypothesis PROB (@var{x} > @var{y}) == PROB (@var{x} < +## @var{y}) == 1/2. Under the null, the test statistic @var{b} roughly +## follows a binomial distribution with parameters @code{@var{n} = sum +## (@var{x} != @var{y})} and @var{p} = 1/2. +## +## With the optional argument @code{alt}, the alternative of interest +## can be selected. If @var{alt} is @code{"!="} or @code{"<>"}, the +## null hypothesis is tested against the two-sided alternative PROB +## (@var{x} < @var{y}) != 1/2. If @var{alt} is @code{">"}, the +## one-sided alternative PROB (@var{x} > @var{y}) > 1/2 ("x is +## stochastically greater than y") is considered. Similarly for +## @code{"<"}, the one-sided alternative PROB (@var{x} > @var{y}) < 1/2 +## ("x is stochastically less than y") is considered. The default is +## the two-sided case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Sign test + +function [pval, b, n] = sign_test (x, y, alt) + + if ((nargin < 2) || (nargin > 3)) + print_usage (); + endif + + if (! (isvector (x) && isvector (y) && (length (x) == length (y)))) + error ("sign_test: X and Y must be vectors of the same length"); + endif + + n = length (x); + x = reshape (x, 1, n); + y = reshape (y, 1, n); + n = sum (x != y); + b = sum (x > y); + cdf = binomial_cdf (b, n, 1/2); + + if (nargin == 2) + alt = "!="; + endif + + if (! ischar (alt)) + error ("sign_test: ALT must be a string"); + endif + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif strcmp (alt, ">") + pval = 1 - cdf; + elseif strcmp (alt, "<") + pval = cdf; + else + error ("sign_test: option %s not recognized", alt); + endif + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/t_test.m b/octave_packages/m/statistics/tests/t_test.m new file mode 100644 index 0000000..5538c45 --- /dev/null +++ b/octave_packages/m/statistics/tests/t_test.m @@ -0,0 +1,83 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{t}, @var{df}] =} t_test (@var{x}, @var{m}, @var{alt}) +## For a sample @var{x} from a normal distribution with unknown mean and +## variance, perform a t-test of the null hypothesis @code{mean +## (@var{x}) == @var{m}}. Under the null, the test statistic @var{t} +## follows a Student distribution with @code{@var{df} = length (@var{x}) +## - 1} degrees of freedom. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## @code{mean (@var{x}) != @var{m}}. If @var{alt} is @code{">"}, the +## one-sided alternative @code{mean (@var{x}) > @var{m}} is considered. +## Similarly for @var{"<"}, the one-sided alternative @code{mean +## (@var{x}) < @var{m}} is considered. The default is the two-sided +## case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Student's one-sample t test + +function [pval, t, df] = t_test (x, m, alt) + + if ((nargin < 2) || (nargin > 3)) + print_usage (); + endif + + if (! isvector (x)) + error ("t_test: X must be a vector"); + endif + if (! isscalar (m)) + error ("t_test: M must be a scalar"); + endif + + n = length (x); + df = n - 1; + t = sqrt (n) * (sum (x) / n - m) / std (x); + cdf = tcdf (t, df); + + if (nargin == 2) + alt = "!="; + endif + + if (! ischar (alt)) + error ("t_test: ALT must be a string"); + endif + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif strcmp (alt, ">") + pval = 1 - cdf; + elseif strcmp (alt, "<") + pval = cdf; + else + error ("t_test: option %s not recognized", alt); + endif + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/t_test_2.m b/octave_packages/m/statistics/tests/t_test_2.m new file mode 100644 index 0000000..f8fc8e3 --- /dev/null +++ b/octave_packages/m/statistics/tests/t_test_2.m @@ -0,0 +1,84 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{t}, @var{df}] =} t_test_2 (@var{x}, @var{y}, @var{alt}) +## For two samples x and y from normal distributions with unknown means +## and unknown equal variances, perform a two-sample t-test of the null +## hypothesis of equal means. Under the null, the test statistic +## @var{t} follows a Student distribution with @var{df} degrees of +## freedom. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## @code{mean (@var{x}) != mean (@var{y})}. If @var{alt} is @code{">"}, +## the one-sided alternative @code{mean (@var{x}) > mean (@var{y})} is +## used. Similarly for @code{"<"}, the one-sided alternative @code{mean +## (@var{x}) < mean (@var{y})} is used. The default is the two-sided +## case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Student's two-sample t test + +function [pval, t, df] = t_test_2 (x, y, alt) + + if ((nargin < 2) || (nargin > 3)) + print_usage (); + endif + + if (! (isvector (x) && isvector (y))) + error ("t_test_2: both X and Y must be vectors"); + endif + + n_x = length (x); + n_y = length (y); + df = n_x + n_y - 2; + mu_x = sum (x) / n_x; + mu_y = sum (y) / n_y; + v = sumsq (x - mu_x) + sumsq (y - mu_y); + t = (mu_x - mu_y) * sqrt ((n_x * n_y * df) / (v * (n_x + n_y))); + cdf = tcdf (t, df); + + if (nargin == 2) + alt = "!="; + endif + + if (! ischar (alt)) + error ("t_test_2: ALT must be a string"); + endif + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif strcmp (alt, ">") + pval = 1 - cdf; + elseif strcmp (alt, "<") + pval = cdf; + else + error ("t_test_2: option %s not recognized", alt); + endif + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/t_test_regression.m b/octave_packages/m/statistics/tests/t_test_regression.m new file mode 100644 index 0000000..bf50fc6 --- /dev/null +++ b/octave_packages/m/statistics/tests/t_test_regression.m @@ -0,0 +1,96 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{t}, @var{df}] =} t_test_regression (@var{y}, @var{x}, @var{rr}, @var{r}, @var{alt}) +## Perform an t test for the null hypothesis @code{@var{rr} * @var{b} = +## @var{r}} in a classical normal regression model @code{@var{y} = +## @var{x} * @var{b} + @var{e}}. Under the null, the test statistic @var{t} +## follows a @var{t} distribution with @var{df} degrees of freedom. +## +## If @var{r} is omitted, a value of 0 is assumed. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## @code{@var{rr} * @var{b} != @var{r}}. If @var{alt} is @code{">"}, the +## one-sided alternative @code{@var{rr} * @var{b} > @var{r}} is used. +## Similarly for @var{"<"}, the one-sided alternative @code{@var{rr} * +## @var{b} < @var{r}} is used. The default is the two-sided case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Test one linear hypothesis in linear regression model + +function [pval, t, df] = t_test_regression (y, x, rr, r, alt) + + if (nargin == 3) + r = 0; + alt = "!="; + elseif (nargin == 4) + if (ischar (r)) + alt = r; + r = 0; + else + alt = "!="; + endif + elseif (! (nargin == 5)) + print_usage (); + endif + + if (! isscalar (r)) + error ("t_test_regression: R must be a scalar"); + elseif (! ischar (alt)) + error ("t_test_regression: ALT must be a string"); + endif + + [T, k] = size (x); + if (! (isvector (y) && (length (y) == T))) + error ("t_test_regression: Y must be a vector of length rows (X)"); + endif + s = size (rr); + if (! ((max (s) == k) && (min (s) == 1))) + error ("t_test_regression: RR must be a vector of length columns (X)"); + endif + + rr = reshape (rr, 1, k); + y = reshape (y, T, 1); + [b, v] = ols (y, x); + df = T - k; + t = (rr * b - r) / sqrt (v * rr * inv (x' * x) * rr'); + cdf = tcdf (t, df); + + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif strcmp (alt, ">") + pval = 1 - cdf; + elseif strcmp (alt, "<") + pval = cdf; + else + error ("t_test_regression: the value `%s' for alt is not possible", alt); + endif + + if (nargout == 0) + printf ("pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/u_test.m b/octave_packages/m/statistics/tests/u_test.m new file mode 100644 index 0000000..8f2dc18 --- /dev/null +++ b/octave_packages/m/statistics/tests/u_test.m @@ -0,0 +1,85 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{z}] =} u_test (@var{x}, @var{y}, @var{alt}) +## For two samples @var{x} and @var{y}, perform a Mann-Whitney U-test of +## the null hypothesis PROB (@var{x} > @var{y}) == 1/2 == PROB (@var{x} +## < @var{y}). Under the null, the test statistic @var{z} approximately +## follows a standard normal distribution. Note that this test is +## equivalent to the Wilcoxon rank-sum test. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## PROB (@var{x} > @var{y}) != 1/2. If @var{alt} is @code{">"}, the +## one-sided alternative PROB (@var{x} > @var{y}) > 1/2 is considered. +## Similarly for @code{"<"}, the one-sided alternative PROB (@var{x} > +## @var{y}) < 1/2 is considered. The default is the two-sided case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## This implementation is still incomplete---for small sample sizes, +## the normal approximation is rather bad ... + +## Author: KH +## Description: Mann-Whitney U-test + +function [pval, z] = u_test (x, y, alt) + + if ((nargin < 2) || (nargin > 3)) + print_usage (); + endif + + if (! (isvector (x) && isvector (y))) + error ("u_test: both X and Y must be vectors"); + endif + + n_x = length (x); + n_y = length (y); + r = ranks ([(reshape (x, 1, n_x)), (reshape (y, 1, n_y))]); + z = (sum (r(1 : n_x)) - n_x * (n_x + n_y + 1) / 2) ... + / sqrt (n_x * n_y * (n_x + n_y + 1) / 12); + + cdf = stdnormal_cdf (z); + + if (nargin == 2) + alt = "!="; + endif + + if (! ischar (alt)) + error("u_test: ALT must be a string"); + endif + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif (strcmp (alt, ">")) + pval = cdf; + elseif (strcmp (alt, "<")) + pval = 1 - cdf; + else + error ("u_test: option %s not recognized", alt); + endif + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/var_test.m b/octave_packages/m/statistics/tests/var_test.m new file mode 100644 index 0000000..311da56 --- /dev/null +++ b/octave_packages/m/statistics/tests/var_test.m @@ -0,0 +1,80 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{f}, @var{df_num}, @var{df_den}] =} var_test (@var{x}, @var{y}, @var{alt}) +## For two samples @var{x} and @var{y} from normal distributions with +## unknown means and unknown variances, perform an F-test of the null +## hypothesis of equal variances. Under the null, the test statistic +## @var{f} follows an F-distribution with @var{df_num} and @var{df_den} +## degrees of freedom. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## @code{var (@var{x}) != var (@var{y})}. If @var{alt} is @code{">"}, +## the one-sided alternative @code{var (@var{x}) > var (@var{y})} is +## used. Similarly for "<", the one-sided alternative @code{var +## (@var{x}) > var (@var{y})} is used. The default is the two-sided +## case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: F test to compare two variances + +function [pval, f, df_num, df_den] = var_test (x, y, alt) + + if ((nargin < 2) || (nargin > 3)) + print_usage (); + endif + + if (! (isvector (x) && isvector (y))) + error ("var_test: both X and Y must be vectors"); + endif + + df_num = length (x) - 1; + df_den = length (y) - 1; + f = var (x) / var (y); + cdf = fcdf (f, df_num, df_den); + + if (nargin == 2) + alt = "!="; + endif + + if (! ischar (alt)) + error ("var_test: ALT must be a string"); + endif + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif (strcmp (alt, ">")) + pval = 1 - cdf; + elseif (strcmp (alt, "<")) + pval = cdf; + else + error ("var_test: option %s not recognized", alt); + endif + + if (nargout == 0) + printf ("pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/welch_test.m b/octave_packages/m/statistics/tests/welch_test.m new file mode 100644 index 0000000..9627e0d --- /dev/null +++ b/octave_packages/m/statistics/tests/welch_test.m @@ -0,0 +1,85 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{t}, @var{df}] =} welch_test (@var{x}, @var{y}, @var{alt}) +## For two samples @var{x} and @var{y} from normal distributions with +## unknown means and unknown and not necessarily equal variances, +## perform a Welch test of the null hypothesis of equal means. +## Under the null, the test statistic @var{t} approximately follows a +## Student distribution with @var{df} degrees of freedom. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## @code{mean (@var{x}) != @var{m}}. If @var{alt} is @code{">"}, the +## one-sided alternative mean(x) > @var{m} is considered. Similarly for +## @code{"<"}, the one-sided alternative mean(x) < @var{m} is +## considered. The default is the two-sided case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Welch two-sample t test + +function [pval, t, df] = welch_test (x, y, alt) + + if ((nargin < 2) || (nargin > 3)) + print_usage (); + endif + + if (! (isvector (x) && isvector (y))) + error ("welch_test: both X and Y must be vectors"); + endif + + n_x = length (x); + n_y = length (y); + mu_x = sum (x) / n_x; + mu_y = sum (y) / n_y; + v_x = sumsq (x - mu_x) / (n_x * (n_x - 1)); + v_y = sumsq (y - mu_y) / (n_y * (n_y - 1)); + c = v_x / (v_x + v_y); + df = 1 / (c^2 / (n_x - 1) + (1 - c)^2 / (n_y - 1)); + t = (mu_x - mu_y) / sqrt (v_x + v_y); + cdf = tcdf (t, df); + + if (nargin == 2) + alt = "!="; + endif + + if (! ischar (alt)) + error ("welch_test: ALT must be a string"); + endif + if (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif (strcmp (alt, ">")) + pval = 1 - cdf; + elseif (strcmp (alt, "<")) + pval = cdf; + else + error ("welch_test: option %s not recognized", alt); + endif + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/wilcoxon_test.m b/octave_packages/m/statistics/tests/wilcoxon_test.m new file mode 100644 index 0000000..5e1f10c --- /dev/null +++ b/octave_packages/m/statistics/tests/wilcoxon_test.m @@ -0,0 +1,91 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{z}] =} wilcoxon_test (@var{x}, @var{y}, @var{alt}) +## For two matched-pair sample vectors @var{x} and @var{y}, perform a +## Wilcoxon signed-rank test of the null hypothesis PROB (@var{x} > +## @var{y}) == 1/2. Under the null, the test statistic @var{z} +## approximately follows a standard normal distribution when @var{n} > 25. +## +## @strong{Caution:} This function assumes a normal distribution for @var{z} +## and thus is invalid for @var{n} @leq{} 25. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## PROB (@var{x} > @var{y}) != 1/2. If alt is @code{">"}, the one-sided +## alternative PROB (@var{x} > @var{y}) > 1/2 is considered. Similarly +## for @code{"<"}, the one-sided alternative PROB (@var{x} > @var{y}) < +## 1/2 is considered. The default is the two-sided case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed. +## @end deftypefn + +## Author: KH +## Description: Wilcoxon signed-rank test + +function [pval, z] = wilcoxon_test (x, y, alt) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (! (isvector (x) && isvector (y) && (length (x) == length (y)))) + error ("wilcoxon_test: X and Y must be vectors of the same length"); + endif + + n = length (x); + x = reshape (x, 1, n); + y = reshape (y, 1, n); + d = x - y; + d = d (find (d != 0)); + n = length (d); + if (n > 25) + r = ranks (abs (d)); + z = sum (r (find (d > 0))); + z = ((z - n * (n + 1) / 4) / sqrt (n * (n + 1) * (2 * n + 1) / 24)); + else + error ("wilcoxon_test: implementation requires more than 25 different pairs"); + endif + + cdf = stdnormal_cdf (z); + + if (nargin == 2) + alt = "!="; + endif + + if (! ischar (alt)) + error("wilcoxon_test: ALT must be a string"); + elseif (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif (strcmp (alt, ">")) + pval = 1 - cdf; + elseif (strcmp (alt, "<")) + pval = cdf; + else + error ("wilcoxon_test: option %s not recognized", alt); + endif + + if (nargout == 0) + printf (" pval: %g\n", pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/z_test.m b/octave_packages/m/statistics/tests/z_test.m new file mode 100644 index 0000000..0a34dec --- /dev/null +++ b/octave_packages/m/statistics/tests/z_test.m @@ -0,0 +1,87 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{z}] =} z_test (@var{x}, @var{m}, @var{v}, @var{alt}) +## Perform a Z-test of the null hypothesis @code{mean (@var{x}) == +## @var{m}} for a sample @var{x} from a normal distribution with unknown +## mean and known variance @var{v}. Under the null, the test statistic +## @var{z} follows a standard normal distribution. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## @code{mean (@var{x}) != @var{m}}. If @var{alt} is @code{">"}, the +## one-sided alternative @code{mean (@var{x}) > @var{m}} is considered. +## Similarly for @code{"<"}, the one-sided alternative @code{mean +## (@var{x}) < @var{m}} is considered. The default is the two-sided +## case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed +## along with some information. +## @end deftypefn + +## Author: KH +## Description: Test for mean of a normal sample with known variance + +function [pval, z] = z_test (x, m, v, alt) + + if ((nargin < 3) || (nargin > 4)) + print_usage (); + endif + + if (! isvector (x)) + error ("z_test: X must be a vector"); + endif + if (! isscalar (m)) + error ("z_test: M must be a scalar"); + endif + if (! (isscalar (v) && (v > 0))) + error ("z_test: V must be a positive scalar"); + endif + + n = length (x); + z = sqrt (n/v) * (sum (x) / n - m); + cdf = stdnormal_cdf (z); + + if (nargin == 3) + alt = "!="; + endif + + if (! ischar (alt)) + error ("z_test: ALT must be a string"); + elseif (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif (strcmp (alt, ">")) + pval = 1 - cdf; + elseif (strcmp (alt, "<")) + pval = cdf; + else + error ("z_test: option %s not recognized", alt); + endif + + if (nargout == 0) + s = cstrcat ("Z-test of mean(x) == %g against mean(x) %s %g,\n", + "with known var(x) == %g:\n", + " pval = %g\n"); + printf (s, m, alt, m, v, pval); + endif + +endfunction diff --git a/octave_packages/m/statistics/tests/z_test_2.m b/octave_packages/m/statistics/tests/z_test_2.m new file mode 100644 index 0000000..5f34185 --- /dev/null +++ b/octave_packages/m/statistics/tests/z_test_2.m @@ -0,0 +1,88 @@ +## Copyright (C) 1995-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{pval}, @var{z}] =} z_test_2 (@var{x}, @var{y}, @var{v_x}, @var{v_y}, @var{alt}) +## For two samples @var{x} and @var{y} from normal distributions with +## unknown means and known variances @var{v_x} and @var{v_y}, perform a +## Z-test of the hypothesis of equal means. Under the null, the test +## statistic @var{z} follows a standard normal distribution. +## +## With the optional argument string @var{alt}, the alternative of +## interest can be selected. If @var{alt} is @code{"!="} or +## @code{"<>"}, the null is tested against the two-sided alternative +## @code{mean (@var{x}) != mean (@var{y})}. If alt is @code{">"}, the +## one-sided alternative @code{mean (@var{x}) > mean (@var{y})} is used. +## Similarly for @code{"<"}, the one-sided alternative @code{mean +## (@var{x}) < mean (@var{y})} is used. The default is the two-sided +## case. +## +## The p-value of the test is returned in @var{pval}. +## +## If no output argument is given, the p-value of the test is displayed +## along with some information. +## @end deftypefn + +## Author: KH +## Description: Compare means of two normal samples with known variances + +function [pval, z] = z_test_2 (x, y, v_x, v_y, alt) + + if ((nargin < 4) || (nargin > 5)) + print_usage (); + endif + + if (! (isvector (x) && isvector (y))) + error("z_test_2: both X and Y must be vectors"); + elseif (! (isscalar (v_x) && (v_x > 0) + && isscalar (v_y) && (v_y > 0))) + error ("z_test_2: both V_X and V_Y must be positive scalars"); + endif + + n_x = length (x); + n_y = length (y); + mu_x = sum (x) / n_x; + mu_y = sum (y) / n_y; + z = (mu_x - mu_y) / sqrt (v_x / n_x + v_y / n_y); + cdf = stdnormal_cdf (z); + + if (nargin == 4) + alt = "!="; + endif + + if (! ischar (alt)) + error ("z_test_2: ALT must be a string"); + elseif (strcmp (alt, "!=") || strcmp (alt, "<>")) + pval = 2 * min (cdf, 1 - cdf); + elseif (strcmp (alt, ">")) + pval = 1 - cdf; + elseif (strcmp (alt, "<")) + pval = cdf; + else + error ("z_test_2: option %s not recognized", alt); + endif + + if (nargout == 0) + s = cstrcat ("Two-sample Z-test of mean(x) == mean(y) against ", + "mean(x) %s mean(y),\n", + "with known var(x) == %g and var(y) == %g:\n", + " pval = %g\n"); + printf (s, alt, v_x, v_y, pval); + endif + +endfunction diff --git a/octave_packages/m/strings/base2dec.m b/octave_packages/m/strings/base2dec.m new file mode 100644 index 0000000..0bc5e3a --- /dev/null +++ b/octave_packages/m/strings/base2dec.m @@ -0,0 +1,136 @@ +## Copyright (C) 2000-2012 Daniel Calvelo +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} base2dec (@var{s}, @var{base}) +## Convert @var{s} from a string of digits in base @var{base} to a decimal +## integer (base 10). +## +## @example +## @group +## base2dec ("11120", 3) +## @result{} 123 +## @end group +## @end example +## +## If @var{s} is a string matrix, return a column vector with one value per +## row of @var{s}. If a row contains invalid symbols then the +## corresponding value will be NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## value per cell element in @var{s}. +## +## If @var{base} is a string, the characters of @var{base} are used as the +## symbols for the digits of @var{s}. Space (' ') may not be used as a +## symbol. +## +## @example +## @group +## base2dec ("yyyzx", "xyz") +## @result{} 123 +## @end group +## @end example +## @seealso{dec2base, bin2dec, hex2dec} +## @end deftypefn + +## Author: Daniel Calvelo +## Adapted-by: Paul Kienzle + +function out = base2dec (s, base) + + if (nargin != 2) + print_usage (); + endif + + if (iscellstr (s)) + s = char (s); + elseif (! ischar (s)) + error ("base2dec: S must be a string or cellstring"); + endif + + symbols = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + if (ischar (base)) + symbols = base; + base = length (symbols); + if (length (unique (symbols)) != base) + error ("base2dec: symbols representing digits must be unique"); + endif + if (any (isspace (symbols))) + error ("base2dec: whitespace characters are not valid symbols"); + endif + elseif (! isscalar (base)) + error ("base2dec: cannot convert from several bases at once"); + elseif (base < 2 || base > length (symbols)) + error ("base2dec: BASE must be between 2 and 36, or a string of symbols"); + else + s = toupper (s); + endif + + ## Right justify the values and squeeze out any spaces. + ## This looks complicated, but indexing solution is very fast + ## compared to alternatives which use cellstr or cellfun or looping. + [nr, nc] = size (s); + if (nc > 1) # Bug #35621 + s = s.'; + nonbl = s != " "; + num_nonbl = sum (nonbl); + nc = max (num_nonbl); + num_blank = nc - num_nonbl; + R = repmat ([1 2; 0 0], 1, nr); + R(2, 1:2:2*nr) = num_blank; + R(2, 2:2:2*nr) = num_nonbl; + idx = repelems ([false, true], R); + idx = reshape (idx, nc, nr); + + ## Create a blank matrix and position the nonblank characters. + s2 = repmat (" ", nc, nr); + s2(idx) = s(nonbl); + s = s2.'; + endif + + ## Lookup value of symbols in symbol table, with invalid symbols + ## evaluating to NaN and space evaluating to 0. + table = NaN (1, 256); + table(toascii (symbols(1:base))) = 0 : base-1; + table(toascii (" ")) = 0; + s = reshape (table(toascii (s)), size (s)); + + ## Multiply the resulting digits by the appropriate power + ## and sum the rows. + out = s * (base .^ (columns(s)-1 : -1 : 0)'); + +endfunction + + +%!assert(base2dec ("11120", 3), 123); +%!assert(base2dec ("yyyzx", "xyz"), 123); +%!assert(base2dec ("-1", 2), NaN); +%!assert(base2dec ({"A1", "1A"}, 16), [161; 26]); + +%% Bug #35621 +%!assert (base2dec (["0"; "1"], 2), [0; 1]) + +%%Test input validation +%!error base2dec (); +%!error base2dec ("11120"); +%!error base2dec ("11120", 3, 4); +%!error base2dec ("11120", "1231"); +%!error base2dec ("11120", "12 3"); +%!error base2dec ("11120", ones(2)); +%!error base2dec ("11120", 37); + diff --git a/octave_packages/m/strings/bin2dec.m b/octave_packages/m/strings/bin2dec.m new file mode 100644 index 0000000..b04194e --- /dev/null +++ b/octave_packages/m/strings/bin2dec.m @@ -0,0 +1,74 @@ +## Copyright (C) 1996-2012 Daniel Calvelo +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} bin2dec (@var{s}) +## Return the decimal number corresponding to the binary number represented +## by the string @var{s}. For example: +## +## @example +## @group +## bin2dec ("1110") +## @result{} 14 +## @end group +## @end example +## +## Spaces are ignored during conversion and may be used to make the binary +## number more readable. +## +## @example +## @group +## bin2dec ("1000 0001") +## @result{} 129 +## @end group +## @end example +## +## If @var{s} is a string matrix, return a column vector with one converted +## number per row of @var{s}; Invalid rows evaluate to NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## converted number per cell element in @var{s}. +## @seealso{dec2bin, base2dec, hex2dec} +## @end deftypefn + +## Author: Daniel Calvelo +## Adapted-by: Paul Kienzle + +function d = bin2dec (s) + + if (nargin != 1) + print_usage (); + endif + + d = base2dec (s, 2); + +endfunction + + +%!assert(bin2dec ("0000"), 0); +%!assert(bin2dec ("1110"), 14); +%!assert(bin2dec ("11111111111111111111111111111111111111111111111111111"), 2^53-1); +%!assert(bin2dec ({"1110", "1111"}), [14; 15]); +%!assert (bin2dec ("1 0 1"), 5) +%!assert (bin2dec (char ("1 0 1", " 1111")), [5; 15]); + +%%Test input validation +%!error bin2dec (); +%!error bin2dec (1); +%!error bin2dec ("1", 2); + diff --git a/octave_packages/m/strings/blanks.m b/octave_packages/m/strings/blanks.m new file mode 100644 index 0000000..031fd83 --- /dev/null +++ b/octave_packages/m/strings/blanks.m @@ -0,0 +1,65 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} blanks (@var{n}) +## Return a string of @var{n} blanks, for example: +## +## @example +## @group +## blanks (10); +## whos ans; +## @result{} +## Attr Name Size Bytes Class +## ==== ==== ==== ===== ===== +## ans 1x10 10 char +## @end group +## @end example +## @seealso{repmat} +## @end deftypefn + +## Author: Kurt Hornik +## Adapted-By: jwe + +function s = blanks (n) + + if (nargin != 1) + print_usage (); + elseif (! (isscalar (n) && n == fix (n) && n >= 0)) + error ("blanks: N must be a non-negative integer"); + endif + + ## If 1:n is empty, the following expression will create an empty + ## character string. Otherwise, it will create a row vector. + s(1:n) = " "; + +endfunction + + +## There really isn't that much to test here +%!assert(blanks (0), "") +%!assert(blanks (5), " ") +%!assert(blanks (10), " ") + +%% Test input validation +%!error blanks () +%!error blanks (1, 2) +%!error blanks (ones (2)) +%!error blanks (2.1) +%!error blanks (-2) + diff --git a/octave_packages/m/strings/cstrcat.m b/octave_packages/m/strings/cstrcat.m new file mode 100644 index 0000000..1d488c3 --- /dev/null +++ b/octave_packages/m/strings/cstrcat.m @@ -0,0 +1,69 @@ +## Copyright (C) 1994-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} cstrcat (@var{s1}, @var{s2}, @dots{}) +## Return a string containing all the arguments concatenated +## horizontally. Trailing white space is preserved. For example: +## +## @example +## @group +## cstrcat ("ab ", "cd") +## @result{} "ab cd" +## @end group +## @end example +## +## @example +## @group +## s = [ "ab"; "cde" ]; +## cstrcat (s, s, s) +## @result{} "ab ab ab " +## "cdecdecde" +## @end group +## @end example +## @seealso{strcat, char, strvcat} +## @end deftypefn + +## Author: jwe + +function st = cstrcat (varargin) + + if (nargin < 1) + print_usage (); + elseif (! iscellstr (varargin)) + error ("cstrcat: expecting arguments to character strings"); + endif + + st = [varargin{:}]; + +endfunction + + +## Test the dimensionality +## 1d +%!assert (cstrcat ("ab ", "ab "), "ab ab ") +## 2d +%!assert (cstrcat (["ab ";"cde"], ["ab ";"cde"]), ["ab ab ";"cdecde"]) + +%!assert (cstrcat ("foo", "bar"), "foobar") +%!assert (cstrcat (["a"; "bb"], ["foo"; "bar"]), ["a foo"; "bbbar"]) + +%% Test input validation +%!error cstrcat (); +%!error cstrcat (1, 2); + diff --git a/octave_packages/m/strings/deblank.m b/octave_packages/m/strings/deblank.m new file mode 100644 index 0000000..bf4279d --- /dev/null +++ b/octave_packages/m/strings/deblank.m @@ -0,0 +1,89 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} deblank (@var{s}) +## Remove trailing whitespace and nulls from @var{s}. If @var{s} +## is a matrix, @var{deblank} trims each row to the length of longest +## string. If @var{s} is a cell array of strings, operate recursively on each +## string element. +## +## Examples: +## +## @example +## @group +## deblank (" abc ") +## @result{} " abc" +## +## deblank ([" abc "; " def "]) +## @result{} [" abc " ; " def"] +## @end group +## @end example +## @seealso{strtrim} +## @end deftypefn + +## Author: Kurt Hornik +## Adapted-By: jwe + +function s = deblank (s) + + if (nargin != 1) + print_usage (); + endif + + if (ischar (s)) + + k = find (! isspace (s) & s != "\0"); + if (isempty (s) || isempty (k)) + s = ""; + else + s = s(:,1:ceil (max (k) / rows (s))); + endif + + elseif (iscell (s)) + + char_idx = cellfun ("isclass", s, "char"); + cell_idx = cellfun ("isclass", s, "cell"); + if (! all (char_idx | cell_idx)) + error ("deblank: S argument must be a string or cellstring"); + endif + + ## Divide work load. Recursive cellfun deblank call is slow + ## and avoided where possible. + s(char_idx) = regexprep (s(char_idx), "[\\s\v\\0]+$", ''); + s(cell_idx) = cellfun ("deblank", s(cell_idx), "UniformOutput", false); + + else + error ("deblank: S argument must be a string or cellstring"); + endif + +endfunction + + +%!assert (deblank (" f o o \0"), " f o o"); +%!assert (deblank (' '), ''); +%!assert (deblank (" "), ""); +%!assert (deblank (""), ""); +%!assert (deblank ({}), {}); +%!assert (deblank ({" abc ", {" def "}}), {" abc", {" def"}}); + +%!error deblank (); +%!error deblank ("foo", "bar"); +%!error deblank (1); +%!error deblank ({[]}); + diff --git a/octave_packages/m/strings/dec2base.m b/octave_packages/m/strings/dec2base.m new file mode 100644 index 0000000..72fc6bc --- /dev/null +++ b/octave_packages/m/strings/dec2base.m @@ -0,0 +1,167 @@ +## Copyright (C) 2000-2012 Daniel Calvelo +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dec2base (@var{d}, @var{base}) +## @deftypefnx {Function File} {} dec2base (@var{d}, @var{base}, @var{len}) +## Return a string of symbols in base @var{base} corresponding to +## the non-negative integer @var{d}. +## +## @example +## @group +## dec2base (123, 3) +## @result{} "11120" +## @end group +## @end example +## +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. +## +## If @var{base} is a string then the characters of @var{base} are used as +## the symbols for the digits of @var{d}. Space (' ') may not be used +## as a symbol. +## +## @example +## @group +## dec2base (123, "aei") +## @result{} "eeeia" +## @end group +## @end example +## +## The optional third argument, @var{len}, specifies the minimum +## number of digits in the result. +## @seealso{base2dec, dec2bin, dec2hex} +## @end deftypefn + +## Author: Daniel Calvelo +## Adapted-by: Paul Kienzle + +function retval = dec2base (d, base, len) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (iscell (d)) + d = cell2mat (d); + endif + + # Create column vector for algorithm + if (! iscolumn (d)) + d = d(:); + endif + + if (! isnumeric (d) || iscomplex (d) || any (d < 0 | d != fix (d))) + error ("dec2base: input must be real non-negative integers"); + endif + + symbols = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + if (ischar (base)) + symbols = base; + base = length (symbols); + if (length (unique (symbols)) != base) + error ("dec2base: symbols representing digits must be unique"); + endif + if (any (isspace (symbols))) + error ("dec2base: whitespace characters are not valid symbols"); + endif + elseif (! isscalar (base)) + error ("dec2base: cannot convert from several bases at once"); + elseif (base < 2 || base > length (symbols)) + error ("dec2base: BASE must be between 2 and 36, or a string of symbols"); + endif + + ## determine number of digits required to handle all numbers, can overflow + ## by 1 digit + max_len = round (log (max (max (d(:)), 1)) / log (base)) + 1; + + if (nargin == 3) + max_len = max (max_len, len); + endif + + ## determine digits for each number + digits = zeros (length (d), max_len); + for k = max_len:-1:1 + digits(:,k) = mod (d, base); + d = round ((d - digits(:,k)) / base); + endfor + + ## convert digits to symbols + retval = reshape (symbols(digits+1), size (digits)); + + ## Check if the first element is the zero symbol. It seems possible + ## that LEN is provided, and is less than the computed MAX_LEN and + ## MAX_LEN is computed to be one larger than necessary, so we would + ## have a leading zero to remove. But if LEN >= MAX_LEN, we should + ## not remove any leading zeros. + if ((nargin == 2 || (nargin == 3 && max_len > len)) + && length (retval) != 1 && ! any (retval(:,1) != symbols(1))) + retval = retval(:,2:end); + endif + +endfunction + + +%!test +%! s0 = ''; +%! for n = 1:13 +%! for b = 2:16 +%! pp = dec2base (b^n+1, b); +%! assert (dec2base(b^n, b), ['1',s0,'0']); +%! assert (dec2base(b^n+1, b), ['1',s0,'1']); +%! endfor +%! s0 = [s0,'0']; +%! endfor + +%!test +%! digits='0123456789ABCDEF'; +%! for n = 1:13 +%! for b = 2:16 +%! pm = dec2base(b^n-1, b); +%! assert (length (pm), n); +%! assert (all (pm==digits(b))); +%! endfor +%! endfor + +%!test +%! for b = 2:16 +%! assert (dec2base (0, b), '0'); +%! endfor + +%!assert(dec2base (0, 2, 4), "0000"); +%!assert(dec2base (2^51-1, 2), ... +%! '111111111111111111111111111111111111111111111111111'); +%!assert(dec2base(uint64(2)^63-1, 16), '7FFFFFFFFFFFFFFF'); +%!assert(dec2base([1, 2; 3, 4], 2, 3), ["001"; "011"; "010"; "100"]); +%!assert(dec2base({1, 2; 3, 4}, 2, 3), ["001"; "011"; "010"; "100"]); + +%%Test input validation +%!error dec2base () +%!error dec2base (1) +%!error dec2base (1, 2, 3, 4) +%!error dec2base ("A") +%!error dec2base (2i) +%!error dec2base (-1) +%!error dec2base (1.1) +%!error dec2base (1, "ABA") +%!error dec2base (1, "A B") +%!error dec2base (1, ones(2)) +%!error dec2base (1, 1) +%!error dec2base (1, 37) + diff --git a/octave_packages/m/strings/dec2bin.m b/octave_packages/m/strings/dec2bin.m new file mode 100644 index 0000000..024dbcf --- /dev/null +++ b/octave_packages/m/strings/dec2bin.m @@ -0,0 +1,63 @@ +## Copyright (C) 1996-2012 Daniel Calvelo +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dec2bin (@var{d}, @var{len}) +## Return a binary number corresponding to the non-negative integer +## @var{d}, as a string of ones and zeros. For example: +## +## @example +## @group +## dec2bin (14) +## @result{} "1110" +## @end group +## @end example +## +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. +## +## The optional second argument, @var{len}, specifies the minimum +## number of digits in the result. +## @seealso{bin2dec, dec2base, dec2hex} +## @end deftypefn + +## Author: Daniel Calvelo +## Adapted-by: Paul Kienzle + +function b = dec2bin (d, len) + + if (nargin == 1) + b = dec2base (d, 2); + elseif (nargin == 2) + b = dec2base (d, 2, len); + else + print_usage (); + endif + +endfunction + + +%!assert(dec2bin (14), "1110"); +%!assert(dec2bin (14, 6), "001110"); +%!assert(dec2bin ({1, 2; 3, 4}), ["001"; "011"; "010"; "100"]); + +%%Test input validation +%!error dec2bin (); +%!error dec2bin (1, 2, 3); + diff --git a/octave_packages/m/strings/dec2hex.m b/octave_packages/m/strings/dec2hex.m new file mode 100644 index 0000000..a2adf55 --- /dev/null +++ b/octave_packages/m/strings/dec2hex.m @@ -0,0 +1,63 @@ +## Copyright (C) 1996-2012 Daniel Calvelo +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} dec2hex (@var{d}, @var{len}) +## Return the hexadecimal string corresponding to the non-negative +## integer @var{d}. For example: +## +## @example +## @group +## dec2hex (2748) +## @result{} "ABC" +## @end group +## @end example +## +## If @var{d} is a matrix or cell array, return a string matrix with one +## row per element in @var{d}, padded with leading zeros to the width of +## the largest value. +## +## The optional second argument, @var{len}, specifies the minimum +## number of digits in the result. +## @seealso{hex2dec, dec2base, dec2bin} +## @end deftypefn + +## Author: Daniel Calvelo +## Adapted-by: Paul Kienzle + +function h = dec2hex (d, len) + + if (nargin == 1) + h = dec2base (d, 16); + elseif (nargin == 2) + h = dec2base (d, 16, len); + else + print_usage (); + endif + +endfunction + + +%!assert(dec2hex (2748), "ABC"); +%!assert(dec2hex (2748, 5), "00ABC"); +%!assert(dec2hex ({2748, 2746}), ["ABC"; "ABA"]); + +%% Test input validation +%!error dec2hex (); +%!error dec2hex (1, 2, 3); + diff --git a/octave_packages/m/strings/findstr.m b/octave_packages/m/strings/findstr.m new file mode 100644 index 0000000..73386d0 --- /dev/null +++ b/octave_packages/m/strings/findstr.m @@ -0,0 +1,143 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} findstr (@var{s}, @var{t}) +## @deftypefnx {Function File} {} findstr (@var{s}, @var{t}, @var{overlap}) +## Return the vector of all positions in the longer of the two strings +## @var{s} and @var{t} where an occurrence of the shorter of the two starts. +## If the optional argument @var{overlap} is true, the returned vector +## can include overlapping positions (this is the default). For example: +## +## @example +## @group +## findstr ("ababab", "a") +## @result{} [1, 3, 5]; +## findstr ("abababa", "aba", 0) +## @result{} [1, 5] +## @end group +## @end example +## +## @strong{Caution:} @code{findstr} is scheduled for deprecation. Use +## @code{strfind} in all new code. +## @seealso{strfind, strmatch, strcmp, strncmp, strcmpi, strncmpi, find} +## @end deftypefn + +## Note that this implementation swaps the strings if second one is longer +## than the first, so try to put the longer one first. +## +## Author: Kurt Hornik +## Adapted-By: jwe + +function v = findstr (s, t, overlap = true) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (all (size (s) > 1) || all (size (t) > 1)) + error ("findstr: arguments must have only one non-singleton dimension"); + endif + + ## Make S be the longer string. + if (length (s) < length (t)) + [s, t] = deal (t, s); + endif + + l_s = length (s); + l_t = length (t); + + if (l_t == 0) + ## zero length target: return empty set + v = []; + + elseif (l_t == 1) + ## length one target: simple find + v = find (s == t); + + elseif (l_t == 2) + ## length two target: find first at i and second at i+1 + v = find (s(1:l_s-1) == t(1) & s(2:l_s) == t(2)); + + else + ## length three or more: match the first three by find then go through + ## the much smaller list to determine which of them are real matches + limit = l_s - l_t + 1; + v = find (s(1:limit) == t(1) + & s(2:limit+1) == t(2) + & s (3:limit+2) == t(3)); + endif + + ## Need to search the index vector if our find was too short + ## (target length > 3), or if we don't allow overlaps. Note though + ## that there cannot be any overlaps if the first character in the + ## target is different from the remaining characters in the target, + ## so a single character, two different characters, or first character + ## different from the second two don't need to be searched. + if (l_t >= 3 || (! overlap && l_t > 1 && any (t(1) == t(2:l_t)))) + ## force strings to be both row vectors or both column vectors + if (all (size (s) != size (t))) + t = t.'; + endif + + ## determine which ones to keep + keep = zeros (size (v)); + ind = 0:l_t-1; + if (overlap) + for idx = 1:length (v) + keep(idx) = all (s(v(idx) + ind) == t); + endfor + else + ## First possible position for next non-overlapping match. + next = 1; + for idx = 1:length (v) + if (v(idx) >= next && s(v(idx) + ind) == t) + keep(idx) = 1; + ## Skip to the next possible match position. + next = v(idx) + l_t; + else + keep(idx) = 0; + endif + endfor + endif + if (! isempty (v)) + v = v(find (keep)); + endif + endif + + if (isempty (v)) + v = []; + endif + + ## Always return a row vector, because that's what the old one did. + if (iscolumn (v)) + v = v.'; + endif + +endfunction + + +%!assert (findstr ("abababa", "a"), [1, 3, 5, 7]) +%!assert (findstr ("abababa", "aba"), [1, 3, 5]); +%!assert (findstr ("aba", "abababa", 0), [1, 5]); + +%% Test input validation +%!error findstr () +%!error findstr ("foo", "bar", 3, 4); +%!error findstr (["AB" ; "CD"], "C"); + diff --git a/octave_packages/m/strings/hex2dec.m b/octave_packages/m/strings/hex2dec.m new file mode 100644 index 0000000..c998684 --- /dev/null +++ b/octave_packages/m/strings/hex2dec.m @@ -0,0 +1,65 @@ +## Copyright (C) 1996-2012 Daniel Calvelo +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} hex2dec (@var{s}) +## Return the integer corresponding to the hexadecimal number represented +## by the string @var{s}. For example: +## +## @example +## @group +## hex2dec ("12B") +## @result{} 299 +## hex2dec ("12b") +## @result{} 299 +## @end group +## @end example +## +## If @var{s} is a string matrix, return a column vector with one converted +## number per row of @var{s}; Invalid rows evaluate to NaN@. +## +## If @var{s} is a cell array of strings, return a column vector with one +## converted number per cell element in @var{s}. +## +## @seealso{dec2hex, base2dec, bin2dec} +## @end deftypefn + +## Author: Daniel Calvelo +## Adapted-by: Paul Kienzle + +function d = hex2dec (s) + + if (nargin != 1) + print_usage (); + endif + + d = base2dec (s, 16); + +endfunction + + +%!assert(hex2dec ("0000"), 0); +%!assert(hex2dec ("1FFFFFFFFFFFFF"), 2^53-1); +%!assert(hex2dec (["12b"; "12B"]), [299; 299]); +%!assert(hex2dec ({"A1", "1A"}), [161; 26]); + +%%Test input validation +%!error hex2dec (); +%!error hex2dec (1); +%!error hex2dec ("1", 2); + diff --git a/octave_packages/m/strings/index.m b/octave_packages/m/strings/index.m new file mode 100644 index 0000000..5369a02 --- /dev/null +++ b/octave_packages/m/strings/index.m @@ -0,0 +1,116 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} index (@var{s}, @var{t}) +## @deftypefnx {Function File} {} index (@var{s}, @var{t}, @var{direction}) +## Return the position of the first occurrence of the string @var{t} in the +## string @var{s}, or 0 if no occurrence is found. @var{s} may also be a +## string array or cell array of strings. +## +## For example: +## +## @example +## @group +## index ("Teststring", "t") +## @result{} 4 +## @end group +## @end example +## +## If @var{direction} is @samp{"first"}, return the first element found. +## If @var{direction} is @samp{"last"}, return the last element found. +## +## @seealso{find, rindex} +## @end deftypefn + +## Author: Kurt Hornik +## Adapted-By: jwe +## This is patterned after the AWK function of the same name. + +function n = index (s, t, direction = "first") + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (ischar (s)) + if (! isrow (s)) + s = cellstr (s); # Handle string arrays by conversion to cellstr + endif + elseif (! iscellstr (s)) + error ("index: S must be a string, string array, or cellstr"); + endif + + f = strfind (s, t); + if (isempty (f)) + f = 0; + elseif (iscell (f)) + f(cellfun ("isempty", f)) = {0}; + endif + + direction = tolower (direction); + + if (strcmp (direction, "first")) + if (iscell (f)) + n = cellfun ("min", f); + else + n = f(1); + endif + elseif (strcmp (direction, "last")) + if (iscell (f)) + n = cellfun ("max", f); + else + n = f(end); + endif + else + error ('index: DIRECTION must be either "first" or "last"'); + endif + +endfunction + + +%!assert (index ("foobarbaz", "b") == 4 && index ("foobarbaz", "z") == 9); + +%!assert (index("astringbstringcstring", "s"), 2) +%!assert (index("astringbstringcstring", "st"), 2) +%!assert (index("astringbstringcstring", "str"), 2) +%!assert (index("astringbstringcstring", "string"), 2) +%!assert (index("abc---", "abc+++"), 0) + +## test everything out in reverse +%!assert (index("astringbstringcstring", "s", "last"), 16) +%!assert (index("astringbstringcstring", "st", "last"), 16) +%!assert (index("astringbstringcstring", "str", "last"), 16) +%!assert (index("astringbstringcstring", "string", "last"), 16) +%!assert (index("abc---", "abc+++", "last"), 0) + +%!test +%! str = char ("Hello", "World", "Goodbye", "World"); +%! assert (index (str, "o"), [5; 2; 2; 2]); +%! assert (index (str, "o", "last"), [5; 2; 3; 2]); +%! str = cellstr (str); +%! assert (index (str, "o"), [5; 2; 2; 2]); +%! assert (index (str, "o", "last"), [5; 2; 3; 2]); + +%% Test input validation +%!error index () +%!error index ("a") +%!error index ("a", "b", "first", "d") +%!error index (1, "bar") +%!error index ("foo", "bar", 3) + diff --git a/octave_packages/m/strings/isletter.m b/octave_packages/m/strings/isletter.m new file mode 100644 index 0000000..bd4ebb3 --- /dev/null +++ b/octave_packages/m/strings/isletter.m @@ -0,0 +1,40 @@ +## Copyright (C) 1998-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isletter (@var{s}) +## Return a logical array which is true where the elements of @var{s} +## are letters and false where they are not. This is an alias for +## the @code{isalpha} function. +## @seealso{isalpha, isdigit, ispunct, isspace, iscntrl, isalnum} +## @end deftypefn + +## Author: jwe + +function retval = isletter (s) + + if (nargin != 1) + print_usage (); + endif + + retval = isalpha (s); + +endfunction + +%!error isletter(); +%!error isletter("a", "b"); diff --git a/octave_packages/m/strings/isstrprop.m b/octave_packages/m/strings/isstrprop.m new file mode 100644 index 0000000..4938cf8 --- /dev/null +++ b/octave_packages/m/strings/isstrprop.m @@ -0,0 +1,135 @@ +## Copyright (C) 2008-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} isstrprop (@var{str}, @var{prop}) +## Test character string properties. For example: +## +## @example +## @group +## isstrprop ("abc123", "alpha") +## @result{} [1, 1, 1, 0, 0, 0] +## @end group +## @end example +## +## If @var{str} is a cell array, @code{isstrpop} is applied recursively +## to each element of the cell array. +## +## Numeric arrays are converted to character strings. +## +## The second argument @var{prop} must be one of +## +## @table @asis +## @item "alpha" +## True for characters that are alphabetic (letters). +## +## @item "alnum" +## @itemx "alphanum" +## True for characters that are alphabetic or digits. +## +## @item "lower" +## True for lowercase letters. +## +## @item "upper" +## True for uppercase letters. +## +## @item "digit" +## True for decimal digits (0-9). +## +## @item "xdigit" +## True for hexadecimal digits (@nospell{a-fA-F0-9}). +## +## @item "space" +## @itemx "wspace" +## True for whitespace characters (space, formfeed, newline, carriage +## return, tab, vertical tab). +## +## @item "punct" +## True for punctuation characters (printing characters except space +## or letter or digit). +## +## @item "cntrl" +## True for control characters. +## +## @item "graph" +## @itemx "graphic" +## True for printing characters except space. +## +## @item "print" +## True for printing characters including space. +## +## @item "ascii" +## True for characters that are in the range of ASCII encoding. +## +## @end table +## +## @seealso{isalpha, isalnum, islower, isupper, isdigit, isxdigit, +## isspace, ispunct, iscntrl, isgraph, isprint, isascii} +## @end deftypefn + +function retval = isstrprop (str, prop) + + if (nargin != 2) + print_usage (); + endif + + switch (prop) + case "alpha" + retval = isalpha (str); + case {"alnum", "alphanum"} + retval = isalnum (str); + case "ascii" + retval = isascii (str); + case "cntrl" + retval = iscntrl (str); + case "digit" + retval = isdigit (str); + case {"graph", "graphic"} + retval = isgraph (str); + case "lower" + retval = islower (str); + case "print" + retval = isprint (str); + case "punct" + retval = ispunct (str); + case {"space", "wspace"} + retval = isspace (str); + case "upper" + retval = isupper (str); + case "xdigit" + retval = isxdigit (str); + otherwise + error ("isstrprop: invalid string property"); + endswitch + +endfunction + + +%!assert (isstrprop ("abc123", "alpha"), logical ([1, 1, 1, 0, 0, 0])) +%!assert (isstrprop ("abc123", "digit"), logical ([0, 0, 0, 1, 1, 1])) +%!assert (isstrprop ("Hello World", "wspace"), isspace ("Hello World")) +%!assert (isstrprop ("Hello World", "graphic"), isgraph ("Hello World")) +%!assert (isstrprop (char ("AbC", "123"), "upper"), logical ([1 0 1; 0 0 0])) +%!assert (isstrprop ({"AbC", "123"}, "lower"), {logical([0 1 0]), logical([0 0 0])}) + +%%Input Validation +%!error isstrprop () +%!error isstrprop ("abc123") +%!error isstrprop ("abc123", "alpha", "alpha") +%!error isstrprop ("abc123", "foo") + diff --git a/octave_packages/m/strings/mat2str.m b/octave_packages/m/strings/mat2str.m new file mode 100644 index 0000000..1294508 --- /dev/null +++ b/octave_packages/m/strings/mat2str.m @@ -0,0 +1,147 @@ +## Copyright (C) 2002-2012 Rolf Fabian +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{s} =} mat2str (@var{x}, @var{n}) +## @deftypefnx {Function File} {@var{s} =} mat2str (@var{x}, @var{n}, "class") +## Format real, complex, and logical matrices as strings. The +## returned string may be used to reconstruct the original matrix by using +## the @code{eval} function. +## +## The precision of the values is given by @var{n}. If @var{n} is a +## scalar then both real and imaginary parts of the matrix are printed +## to the same precision. Otherwise @code{@var{n}(1)} defines the +## precision of the real part and @code{@var{n}(2)} defines the +## precision of the imaginary part. The default for @var{n} is 15. +## +## If the argument "class" is given then the class of @var{x} is +## included in the string in such a way that @code{eval} will result in the +## construction of a matrix of the same class. +## +## @example +## @group +## mat2str ([ -1/3 + i/7; 1/3 - i/7 ], [4 2]) +## @result{} "[-0.3333+0.14i;0.3333-0.14i]" +## +## mat2str ([ -1/3 +i/7; 1/3 -i/7 ], [4 2]) +## @result{} "[-0.3333+0i 0+0.14i;0.3333+0i -0-0.14i]" +## +## mat2str (int16([1 -1]), "class") +## @result{} "int16([1 -1])" +## +## mat2str (logical (eye (2))) +## @result{} "[true false;false true]" +## +## isequal (x, eval (mat2str (x))) +## @result{} 1 +## @end group +## @end example +## +## @seealso{sprintf, num2str, int2str} +## @end deftypefn + +## Author: Rolf Fabian + +function s = mat2str (x, n = 15, cls = "") + + if (nargin < 1 || nargin > 3 || ! (isnumeric (x) || islogical (x))) + print_usage (); + elseif (ndims (x) > 2) + error ("mat2str: X must be two dimensional"); + endif + + if (nargin == 2 && ischar (n)) + cls = n; + n = 15; + elseif (isempty (n)) + n = 15; # Default precision + endif + + x_islogical = islogical (x); + x_iscomplex = iscomplex (x); + + if (x_iscomplex) + if (isscalar (n)) + n = [n, n]; + endif + fmt = sprintf ("%%.%dg%%+.%dgi", n(1), n(2)); + elseif (x_islogical) + v = {"false", "true"}; + fmt = "%s"; + else + fmt = sprintf ("%%.%dg", n(1)); + endif + + nel = numel (x); + + if (nel == 0) + ## Empty, only print brackets + s = "[]"; + elseif (nel == 1) + ## Scalar X, don't print brackets + if (x_iscomplex) + s = sprintf (fmt, real (x), imag (x)); + elseif (x_islogical) + s = v{x+1}; + else + s = sprintf (fmt, x); + endif + else + ## Non-scalar X, print brackets + fmt = cstrcat (fmt, " "); + if (x_iscomplex) + t = x.'; + s = sprintf (fmt, [real(t(:))'; imag(t(:))']); + elseif (x_islogical) + t = v(x+1); + s = cstrcat (sprintf (fmt, t{:})); + else + s = sprintf (fmt, x.'); + endif + + s = cstrcat ("[", s); + s(end) = "]"; + idx = strfind (s, " "); + nc = columns (x); + s(idx(nc:nc:end)) = ";"; + endif + + if (strcmp ("class", cls)) + s = cstrcat (class (x), "(", s, ")"); + endif + +endfunction + + +%!assert (mat2str (0.7), "0.7"); +%!assert (mat2str (pi), "3.14159265358979"); +%!assert (mat2str (pi, 5), "3.1416"); +%!assert (mat2str (single (pi), 5, "class"), "single(3.1416)"); +%!assert (mat2str ([-1/3 + i/7; 1/3 - i/7], [4 2]), "[-0.3333+0.14i;0.3333-0.14i]") +%!assert (mat2str ([-1/3 +i/7; 1/3 -i/7], [4 2]), "[-0.3333+0i 0+0.14i;0.3333+0i -0-0.14i]") +%!assert (mat2str (int16 ([1 -1]), 'class'), "int16([1 -1])") +%!assert (mat2str (true), "true"); +%!assert (mat2str (false), "false"); +%!assert (mat2str (logical (eye (2))), "[true false;false true]"); + +%% Test input validation +%!error mat2str () +%!error mat2str (1,2,3,4) +%!error mat2str (["Hello"]) +%!error mat2str (ones(3,3,2)) + diff --git a/octave_packages/m/strings/regexptranslate.m b/octave_packages/m/strings/regexptranslate.m new file mode 100644 index 0000000..6146d6a --- /dev/null +++ b/octave_packages/m/strings/regexptranslate.m @@ -0,0 +1,87 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} regexptranslate (@var{op}, @var{s}) +## Translate a string for use in a regular expression. This may +## include either wildcard replacement or special character escaping. +## The behavior is controlled by @var{op} which can take the following +## values +## +## @table @asis +## @item "wildcard" +## The wildcard characters @code{.}, @code{*}, and @code{?} are replaced +## with wildcards that are appropriate for a regular expression. +## For example: +## +## @example +## @group +## regexptranslate ("wildcard", "*.m") +## @result{} ".*\.m" +## @end group +## @end example +## +## @item "escape" +## The characters @code{$.?[]}, that have special meaning for regular +## expressions are escaped so that they are treated literally. For example: +## +## @example +## @group +## regexptranslate ("escape", "12.5") +## @result{} "12\.5" +## @end group +## @end example +## +## @end table +## @seealso{regexp, regexpi, regexprep} +## @end deftypefn + +function y = regexptranslate (op, s) + + if nargin != 2 + print_usage (); + endif + + if (! ischar (op)) + error ("regexptranslate: operation OP must be a string"); + endif + + op = tolower (op); + if (strcmp ("wildcard", op)) + y = regexprep (regexprep (regexprep (s, '\.', '\.'), + '\*', '.*'), + '\?', '.'); + elseif (strcmp ("escape", op)) + y = regexprep (s, '([^\w])', '\$1'); + else + error ("regexptranslate: invalid operation OP"); + endif + +endfunction + + +%!assert (regexptranslate ("wildcard", "/a*b?c."), "/a.*b.c\\.") +%!assert (regexptranslate ("escape", '$.?[abc]'), '\$\.\?\[abc\]') + +%% Test input validation +%!error regexptranslate () +%!error regexptranslate ("wildcard") +%!error regexptranslate ("a", "b", "c") +%!error regexptranslate ("foo", "abc") +%!error regexptranslate (10, "abc") + diff --git a/octave_packages/m/strings/rindex.m b/octave_packages/m/strings/rindex.m new file mode 100644 index 0000000..1e924cc --- /dev/null +++ b/octave_packages/m/strings/rindex.m @@ -0,0 +1,67 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rindex (@var{s}, @var{t}) +## Return the position of the last occurrence of the character string +## @var{t} in the character string @var{s}, or 0 if no occurrence is +## found. @var{s} may also be a string array or cell array of strings. +## +## For example: +## +## @example +## @group +## rindex ("Teststring", "t") +## @result{} 6 +## @end group +## @end example +## +## The @code{rindex} function is equivalent to @code{index} with +## @var{direction} set to @samp{"last"}. +## +## @seealso{find, index} +## @end deftypefn + +## Author: Kurt Hornik +## Adapted-By: jwe +## This is patterned after the AWK function of the same name. + +function n = rindex (s, t) + + if (nargin != 2) + print_usage (); + endif + + n = index (s, t, "last"); + +endfunction + + +%!assert(rindex ("foobarbaz", "b") == 7 && rindex ("foobarbaz", "o") == 3); + +%!test +%! str = char ("Hello", "World", "Goodbye", "World"); +%! assert (rindex (str, "o"), [5; 2; 3; 2]); +%! str = cellstr (str); +%! assert (rindex (str, "o"), [5; 2; 3; 2]); + +%% Test input validation +%!error rindex () +%!error rindex ("foo") +%!error rindex ("foo", "bar", "last") + diff --git a/octave_packages/m/strings/str2num.m b/octave_packages/m/strings/str2num.m new file mode 100644 index 0000000..5a9cce2 --- /dev/null +++ b/octave_packages/m/strings/str2num.m @@ -0,0 +1,84 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{x} =} str2num (@var{s}) +## @deftypefnx {Function File} {[@var{x}, @var{state}] =} str2num (@var{s}) +## Convert the string (or character array) @var{s} to a number (or an +## array). Examples: +## +## @example +## @group +## str2num ("3.141596") +## @result{} 3.141596 +## +## str2num (["1, 2, 3"; "4, 5, 6"]) +## @result{} 1 2 3 +## 4 5 6 +## @end group +## @end example +## +## The optional second output, @var{state}, is logically true when the +## conversion is successful. If the conversion fails the numeric output, +## @var{x}, is empty and @var{state} is false. +## +## @strong{Caution:} As @code{str2num} uses the @code{eval} function +## to do the conversion, @code{str2num} will execute any code contained +## in the string @var{s}. Use @code{str2double} for a safer and faster +## conversion. +## +## For cell array of strings use @code{str2double}. +## @seealso{str2double, eval} +## @end deftypefn + +## Author: jwe + +function [m, state] = str2num (s) + + if (nargin != 1) + print_usage (); + elseif (! ischar (s)) + error ("str2num: S must be a string or string array"); + endif + + s(:, end+1) = ";"; + s = sprintf ("m = [%s];", reshape (s', 1, numel (s))); + state = true; + eval (s, "m = []; state = false;"); + if (ischar (m)) + m = []; + state = false; + endif + +endfunction + + +%!assert(str2num ("-1.3e2"), -130); +%!assert(str2num ("[1, 2; 3, 4]"), [1, 2; 3, 4]); + +%!test +%! [x, state] = str2num ("pi"); +%! assert (state); +%! [x, state] = str2num ("Hello World"); +%! assert (! state); + +%% Test input validation +%!error str2num () +%!error str2num ("string", 1) +%!error str2num ({"string"}) + diff --git a/octave_packages/m/strings/strcat.m b/octave_packages/m/strings/strcat.m new file mode 100644 index 0000000..9b14067 --- /dev/null +++ b/octave_packages/m/strings/strcat.m @@ -0,0 +1,127 @@ +## Copyright (C) 1994-2012 John W. Eaton +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} strcat (@var{s1}, @var{s2}, @dots{}) +## Return a string containing all the arguments concatenated +## horizontally. If the arguments are cells strings, @code{strcat} +## returns a cell string with the individual cells concatenated. +## For numerical input, each element is converted to the +## corresponding ASCII character. Trailing white space is eliminated. +## For example: +## +## @example +## @group +## s = [ "ab"; "cde" ]; +## strcat (s, s, s) +## @result{} +## "ab ab ab " +## "cdecdecde" +## @end group +## @end example +## +## @example +## @group +## s = @{ "ab"; "cde" @}; +## strcat (s, s, s) +## @result{} +## @{ +## [1,1] = ababab +## [2,1] = cdecdecde +## @} +## @end group +## @end example +## +## @seealso{cstrcat, char, strvcat} +## @end deftypefn + +## Author: jwe + +function st = strcat (varargin) + + if (nargin > 0) + if (nargin == 1) + st = varargin{1}; + elseif (nargin > 1) + ## Convert to cells of strings + uo = "uniformoutput"; + reals = cellfun ("isreal", varargin); + if (any (reals)) + varargin(reals) = cellfun ("char", varargin(reals), uo, false); + endif + chars = cellfun ("isclass", varargin, "char"); + allchar = all (chars); + varargin(chars) = cellfun ("cellstr", varargin(chars), uo, false); + if (! all (cellfun ("isclass", varargin, "cell"))) + error ("strcat: inputs must be strings or cells of strings"); + endif + + ## We don't actually need to bring all cells to common size, because + ## cellfun can now expand scalar cells. + err = common_size (varargin{:}); + + if (err) + error ("strcat: arguments must be the same size, or be scalars"); + endif + + ## Cellfun handles everything for us. + st = cellfun ("horzcat", varargin{:}, uo, false); + + if (allchar) + ## If all inputs were strings, return strings. + st = char (st); + endif + endif + else + print_usage (); + endif + +endfunction + +## test the dimensionality +## 1d +%!assert(strcat("ab ", "ab "), "abab") +%!assert(strcat({"ab "}, "ab "), {"ab ab"}) +%!assert(strcat("ab ", {"ab "}), {"abab "}) +%!assert(strcat({"ab "}, {"ab "}), {"ab ab "}) +%!assert(strcat("", "ab"), "ab") +%!assert(strcat("", {"ab"}, {""}), {"ab"}) +## 2d +%!assert(strcat(["ab ";"cde"], ["ab ";"cde"]), ["abab ";"cdecde"]) + +## test for deblanking implied trailing spaces of character input +%!assert((strcmp (strcat ("foo", "bar"), "foobar") +%! && strcmp (strcat (["a"; "bb"], ["foo"; "bar"]), ["afoo "; "bbbar"]))); + +## test for mixing character and cell inputs +%!assert(all (strcmp (strcat ("a", {"bc", "de"}, "f"), {"abcf", "adef"}))) + +## test for scalar strings with vector strings +%!assert(all (strcmp (strcat (["a"; "b"], "c"), ["ac"; "bc"]))) + +## test with cells with strings of differing lengths +%!assert(all (strcmp (strcat ({"a", "bb"}, "ccc"), {"accc", "bbccc"}))) +%!assert(all (strcmp (strcat ("a", {"bb", "ccc"}), {"abb", "accc"}))) + +%!error strcat (); + +%!assert (strcat (1, 2), strcat (char(1), char(2))) + +%!assert (strcat ('', 2), strcat ([], char(2))) + diff --git a/octave_packages/m/strings/strchr.m b/octave_packages/m/strings/strchr.m new file mode 100644 index 0000000..7dada7e --- /dev/null +++ b/octave_packages/m/strings/strchr.m @@ -0,0 +1,80 @@ +## Copyright (C) 2008-2012 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}) +## @deftypefnx {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}, @var{n}) +## @deftypefnx {Function File} {@var{idx} =} strchr (@var{str}, @var{chars}, @var{n}, @var{direction}) +## @deftypefnx {Function File} {[@var{i}, @var{j}] =} strchr (@dots{}) +## Search for the string @var{str} for occurrences of characters from +## the set @var{chars}. The return value(s), as well as the @var{n} and +## @var{direction} arguments behave identically as in @code{find}. +## +## This will be faster than using regexp in most cases. +## +## @seealso{find} +## @end deftypefn + +function varargout = strchr (str, chars, varargin) + + if (nargin < 2) + print_usage (); + elseif (! ischar (str)) + error ("strchr: STR argument must be a string or string array"); + elseif (! ischar (chars)) + error ("strchr: CHARS argument must be a string"); + endif + + if (isempty (chars)) + mask = false (size (str)); + elseif (length (chars) <= 4) + ## With a few characters, it pays off to build the mask incrementally. + ## We do it via a for loop to save memory. + mask = str == chars(1); + for i = 2:length (chars) + mask |= str == chars(i); + endfor + else + ## Index the str into a mask of valid values. + ## This is slower than it could be because of the +1 issue. + f = false (256, 1); + f(uint8(chars)+1) = true; + ## Default goes via double -- unnecessarily long. + si = uint32 (str); + ## in-place is faster than str+1 + ++si; + mask = reshape (f(si), size (str)); + endif + + varargout = cell (1, nargout); + varargout{1} = []; + [varargout{:}] = find (mask, varargin{:}); + +endfunction + + +%!assert (strchr ("Octave is the best software", ""), zeros (1,0)) +%!assert (strchr ("Octave is the best software", "best"), [3, 6, 9, 11, 13, 15, 16, 17, 18, 20, 23, 27]) +%!assert (strchr ("Octave is the best software", "software"), [3, 4, 6, 9, 11, 13, 16, 17, 18, 20, 21, 22, 23, 24, 25, 26, 27]) + +%% Test input validation +%!error strchr () +%!error strchr (1) +%!error strchr (1, "aeiou") +%!error strchr ("aeiou", 1) + diff --git a/octave_packages/m/strings/strjust.m b/octave_packages/m/strings/strjust.m new file mode 100644 index 0000000..b1873a3 --- /dev/null +++ b/octave_packages/m/strings/strjust.m @@ -0,0 +1,112 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2009 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} strjust (@var{s}) +## @deftypefnx {Function File} {} strjust (@var{s}, @var{pos}) +## Return the text, @var{s}, justified according to @var{pos}, which may +## be @samp{"left"}, @samp{"center"}, or @samp{"right"}. If @var{pos} +## is omitted it defaults to @samp{"right"}. +## +## Null characters are replaced by spaces. All other character +## data are treated as non-white space. +## +## Example: +## +## @example +## @group +## strjust (["a"; "ab"; "abc"; "abcd"]) +## @result{} +## " a" +## " ab" +## " abc" +## "abcd" +## @end group +## @end example +## @seealso{deblank, strrep, strtrim, untabify} +## @end deftypefn + +function y = strjust (s, pos = "right") + + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (! ischar (s) || ndims (s) > 2) + error ("strjust: S must be a string or 2-D character matrix"); + endif + + if (isempty (s)) + y = s; + return; + endif + + ## Apparently, Matlab considers nulls to be blanks as well; however, does + ## not preserve the nulls, but rather converts them to blanks. That's a + ## bit unexpected, but it allows simpler processing, because we can move + ## just the nonblank characters. So we'll do the same here. + + [nr, nc] = size (s); + ## Find the indices of all nonblanks. + nonbl = s != " " & s != "\0"; + [idx, jdx] = find (nonbl); + + if (strcmpi (pos, "right")) + ## We wish to find the maximum column index for each row. Because jdx is + ## sorted, we can take advantage of the fact that assignment is processed + ## sequentially and for duplicate indices the last value will remain. + maxs = repmat (nc, [nr, 1]); + maxs(idx) = jdx; + shift = nc - maxs; + elseif (strcmpi (pos, "left")) + ## See above for explanation. + mins = ones (nr, 1); + mins(flipud (idx(:))) = flipud (jdx(:)); + shift = 1 - mins; + else + ## Use both of the above to achieve centering. + mins = ones (nr, 1); + mins(flipud (idx(:))) = flipud (jdx(:)); + maxs = repmat (nc, [nr, 1]); + maxs(idx) = jdx; + shift = floor ((nc + 1 - maxs - mins) / 2); + endif + + ## Adjust the column indices. + jdx += shift(idx); + + ## Create a blank matrix and position the nonblank characters. + y = repmat (" ", nr, nc); + y(sub2ind ([nr, nc], idx, jdx)) = s(nonbl); + +endfunction + + +%!assert (strjust (["a"; "ab"; "abc"; "abcd"]), +%! [" a";" ab"; " abc"; "abcd"]); +%!assert (strjust ([" a"; " ab"; "abc"; "abcd"], "left"), +%! ["a "; "ab "; "abc "; "abcd"]); +%!assert (strjust (["a"; "ab"; "abc"; "abcd"], "CENTER"), +%! [" a "; " ab"; "abc "; "abcd"]); +%!assert (strjust (["";""]), ""); + +%% Test input validation +%!error strjust () +%!error strjust (["a";"ab"], "center", 1) +%!error strjust (ones(3,3)) +%!error strjust (char (ones(3,3,3))) + diff --git a/octave_packages/m/strings/strmatch.m b/octave_packages/m/strings/strmatch.m new file mode 100644 index 0000000..1ae8abb --- /dev/null +++ b/octave_packages/m/strings/strmatch.m @@ -0,0 +1,119 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## Copyright (C) 2003 Alois Schloegl +## Copyright (C) 2010 VZLU Prague +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} strmatch (@var{s}, @var{A}) +## @deftypefnx {Function File} {} strmatch (@var{s}, @var{A}, "exact") +## Return indices of entries of @var{A} which begin with the string @var{s}. +## The second argument @var{A} must be a string, character matrix, or a cell +## array of strings. If the third argument @code{"exact"} is not given, then +## @var{s} only needs to match @var{A} up to the length of @var{s}. +## Trailing spaces and nulls in @var{s} and @var{A} are ignored when matching. +## option. +## +## For example: +## +## @example +## @group +## strmatch ("apple", "apple juice") +## @result{} 1 +## +## strmatch ("apple", ["apple "; "apple juice"; "an apple"]) +## @result{} [1; 2] +## +## strmatch ("apple", ["apple "; "apple juice"; "an apple"], "exact") +## @result{} [1] +## @end group +## @end example +## +## @strong{Caution:} @code{strmatch} is scheduled for deprecation. Use +## @code{strcmpi} or @code{strncmpi} in all new code. +## @seealso{strfind, findstr, strcmp, strncmp, strcmpi, strncmpi, find} +## @end deftypefn + +## Author: Paul Kienzle, Alois Schloegl +## Adapted-by: jwe + +function idx = strmatch (s, A, exact) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (! ischar (s) || (! isempty (s) && ! isvector (s))) + error ("strmatch: S must be a string"); + elseif (! (ischar (A) || iscellstr (A))) + error ("strmatch: A must be a string or cell array of strings"); + endif + + ## Trim blanks and nulls from search string + s = regexprep (s, "[ \\0]+$", ''); + len = length (s); + + exact = nargin == 3 && ischar (exact) && strcmp (exact, "exact"); + + if (ischar (A)) + [nr, nc] = size (A); + if (len > nc) + idx = []; + else + match = all (bsxfun (@eq, A(:,1:len), s), 2); + if (exact) + AA = A(:,len+1:nc); + match &= all (AA == " " | AA == "\0", 2); + endif + idx = find (match); + endif + else + if (len > 0) + idx = find (strncmp (s, A, len)); + else + idx = find (strcmp (s, A)); + endif + if (exact) + ## We can't just use strcmp, because we need to ignore spaces at end. + B = regexprep (A(idx), "[ \\0]+$", ''); + idx = idx(strcmp (s, B)); + endif + endif + +endfunction + + +%!assert (strmatch("a", {"aaa", "bab", "bbb"}), 1); +%!assert (strmatch ("apple", "apple juice"), 1); +%!assert (strmatch ("apple", ["apple pie"; "apple juice"; "an apple"]), [1; 2]); +%!assert (strmatch ("apple", {"apple pie"; "apple juice"; "tomato"}), [1; 2]); +%!assert (strmatch ("apple pie", "apple"), []); +%!assert (strmatch ("a ", "a"), 1); +%!assert (strmatch ("a", "a \0", "exact"), 1); +%!assert (strmatch ("a b", {"a b", "a c", "c d"}), 1); +%!assert (strmatch ("", {"", "foo", "bar", ""}), [1, 4]); +%!assert (strmatch ('', { '', '% comment', 'var a = 5', ''}, 'exact'), [1,4]); + +%% Test input validation +%!error strmatch(); +%!error strmatch("a"); +%!error strmatch("a", "aaa", "exact", 1); +%!error strmatch(1, "aaa"); +%!error strmatch(char ("a", "bb"), "aaa"); +%!error strmatch("a", 1); +%!error strmatch("a", {"hello", [1]}); + diff --git a/octave_packages/m/strings/strsplit.m b/octave_packages/m/strings/strsplit.m new file mode 100644 index 0000000..9821ae4 --- /dev/null +++ b/octave_packages/m/strings/strsplit.m @@ -0,0 +1,118 @@ +## Copyright (C) 2009-2012 Jaroslav Hajek +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{cstr}] =} strsplit (@var{s}, @var{sep}) +## @deftypefnx {Function File} {[@var{cstr}] =} strsplit (@var{s}, @var{sep}, @var{strip_empty}) +## Split the string @var{s} using one or more separators @var{sep} and return +## a cell array of strings. Consecutive separators and separators at +## boundaries result in empty strings, unless @var{strip_empty} is true. +## The default value of @var{strip_empty} is false. +## +## 2-D character arrays are split at separators and at the original column +## boundaries. +## +## Example: +## +## @example +## @group +## strsplit ("a,b,c", ",") +## @result{} +## @{ +## [1,1] = a +## [1,2] = b +## [1,3] = c +## @} +## +## strsplit (["a,b" ; "cde"], ",") +## @result{} +## @{ +## [1,1] = a +## [1,2] = b +## [1,3] = cde +## @} +## @end group +## @end example +## @seealso{strtok} +## @end deftypefn + +function cstr = strsplit (s, sep, strip_empty = false) + + if (nargin < 2 || nargin > 3) + print_usage (); + elseif (! ischar (s) || ! ischar (sep)) + error ("strsplit: S and SEP must be string values"); + elseif (! isscalar (strip_empty)) + error ("strsplit: STRIP_EMPTY must be a scalar value"); + endif + + if (isempty (s)) + cstr = cell (size (s)); + else + if (rows (s) > 1) + ## For 2-D arrays, add separator character at line boundaries + ## and transform to single string + s(:, end+1) = sep(1); + s = reshape (s.', 1, numel (s)); + s(end) = []; + endif + + ## Split s according to delimiter + if (isscalar (sep)) + ## Single separator + idx = find (s == sep); + else + ## Multiple separators + idx = strchr (s, sep); + endif + + ## Get substring lengths. + if (isempty (idx)) + strlens = length (s); + else + strlens = [idx(1)-1, diff(idx)-1, numel(s)-idx(end)]; + endif + ## Remove separators. + s(idx) = []; + if (strip_empty) + ## Omit zero lengths. + strlens = strlens(strlens != 0); + endif + + ## Convert! + cstr = mat2cell (s, 1, strlens); + endif + +endfunction + + +%!assert (strsplit ("road to hell", " "), {"road", "to", "hell"}) +%!assert (strsplit ("road to^hell", " ^"), {"road", "to", "hell"}) +%!assert (strsplit ("road to--hell", " -", true), {"road", "to", "hell"}) +%!assert (strsplit (["a,bc";",de"], ","), {"a", "bc", ones(1,0), "de "}) +%!assert (strsplit (["a,bc";",de"], ",", true), {"a", "bc", "de "}) +%!assert (strsplit (["a,bc";",de"], ", ", true), {"a", "bc", "de"}) + +%% Test input validation +%!error strsplit () +%!error strsplit ("abc") +%!error strsplit ("abc", "b", true, 4) +%!error strsplit (123, "b") +%!error strsplit ("abc", 1) +%!error strsplit ("abc", "def", ones(3,3)) + diff --git a/octave_packages/m/strings/strtok.m b/octave_packages/m/strings/strtok.m new file mode 100644 index 0000000..c598001 --- /dev/null +++ b/octave_packages/m/strings/strtok.m @@ -0,0 +1,224 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{tok}, @var{rem}] =} strtok (@var{str}) +## @deftypefnx {Function File} {[@var{tok}, @var{rem}] =} strtok (@var{str}, @var{delim}) +## +## Find all characters in the string @var{str} up to, but not including, the +## first character which is in the string @var{delim}. If @var{rem} is +## requested, it contains the remainder of the string, starting at the first +## delimiter. Leading delimiters are ignored. If @var{delim} is not +## specified, whitespace is assumed. @var{str} may also be a cell array of +## strings in which case the function executes on every individual string +## and returns a cell array of tokens and remainders. +## +## Examples: +## +## @example +## @group +## strtok ("this is the life") +## @result{} "this" +## +## [tok, rem] = strtok ("14*27+31", "+-*/") +## @result{} +## tok = 14 +## rem = *27+31 +## @end group +## @end example +## @seealso{index, strsplit, strchr, isspace} +## @end deftypefn + +function [tok, rem] = strtok (str, delim) + + if (nargin < 1 || nargin > 2) + print_usage (); + elseif (! (ischar (str) || iscellstr (str))) + error ("strtok: STR must be a string or cell array of strings."); + elseif (ischar (str) && ! isvector (str) &&! isempty (str)) + error ("strtok: STR cannot be a 2-D character array."); + endif + + if (nargin < 2 || isempty (delim)) + ws_delim = true; + else + ws_delim = false; + endif + + if (isempty (str)) + tok = rem = ""; + elseif (ischar (str)) + if (ws_delim) + idx = isspace (str); + elseif (length (delim) <= 7) + ## Build index of delimiters incrementally for low N. + idx = str == delim(1); + for i = 2:length (delim) + idx |= str == delim(i); + endfor + else + ## Index the str into a mask of valid values. Faster for large N. + f = false (256, 1); + ## This is slower than it could be because of the +1 issue. + f(uint8(delim)+1) = true; + ## Default goes via double -- unnecessarily long. + si = uint32 (str); + ## in-place is faster than str+1 + ++si; + idx = f(si); + endif + + idx_dlim = find (idx, 1); + idx_nodlim = find (! idx, 1); + if (isempty (idx_dlim)) + ## No delimiter. Return whole string. + tok = str; + rem = ""; + elseif (idx_dlim > idx_nodlim) + ## Normal case. No leading delimiters and at least 1 delimiter in STR. + tok = str(1:idx_dlim-1); + rem = str(idx_dlim:end); + else + ## Leading delimiter found. + idx_dlim = find (idx(idx_nodlim+1:end), 1); + if (isempty (idx_dlim)) + ## No further delimiters. Return STR stripped of delimiter prefix. + tok = str(idx_nodlim:end); + rem = ""; + else + ## Strip delimiter prefix. Return STR up to 1st delimiter + tok = str(idx_nodlim:(idx_dlim + idx_nodlim -1)); + rem = str((idx_dlim + idx_nodlim):end); + endif + endif + else # Cell array of strings + if (ws_delim) + delim = '\s'; + endif + ptn = [ '^[' delim ']*','([^' delim ']+)','([' delim '].*)$' ]; + matches = regexp (str, ptn, "tokens"); + eidx = cellfun ("isempty", matches); + midx = ! eidx; + tok = cell (size (str)); + tok(eidx) = regexprep (str(eidx), [ '^[' delim ']+' ], ''); + ## Unwrap doubly nested cell array from regexp + tmp = [matches{midx}]; + if (! isempty (tmp)) + tmp = [tmp{:}]; + endif + tok(midx) = tmp(1:2:end); + if (isargout (2)) + rem = cell (size (str)); + rem(eidx) = {""}; + rem(midx) = tmp(2:2:end); + endif + endif + +endfunction + + +%!demo +%! strtok("this is the life") +%! % split at the first space, returning "this" + +%!demo +%! s = "14*27+31" +%! while (1) +%! [t, s] = strtok (s, "+-*/"); +%! printf ("<%s>", t); +%! if (isempty (s)) +%! break; +%! endif +%! printf ("<%s>", s(1)); +%! endwhile +%! printf("\n"); +%! % ---------------------------------------------------- +%! % Demonstrates processing of an entire string split on +%! % a variety of delimiters. Tokens and delimiters are +%! % printed one after another in angle brackets. + +%% Test the tokens for all cases +%!assert (strtok (""), ""); # no string +%!assert (strtok ("this"), "this"); # no delimiter in string +%!assert (strtok ("this "), "this"); # delimiter at end +%!assert (strtok ("this is"), "this"); # delimiter in middle +%!assert (strtok (" this"), "this"); # delimiter at start +%!assert (strtok (" this "), "this"); # delimiter at start and end +%!assert (strtok (" "), ""(1:0)); # delimiter only + +%% Test the remainder for all cases +%!test [t,r] = strtok (""); assert (r, ""); +%!test [t,r] = strtok ("this"); assert (r, ""); +%!test [t,r] = strtok ("this "); assert (r, " "); +%!test [t,r] = strtok ("this is"); assert (r, " is"); +%!test [t,r] = strtok (" this"); assert (r, ""); +%!test [t,r] = strtok (" this "); assert (r, " "); +%!test [t,r] = strtok (" "); assert (r, ""); + +%% Test all tokens and remainders with cell array input +%!test +%! str = {"", "this", "this ", "this is", " this", " this ", " "}; +%! [t, r] = strtok (str); +%! assert (t{1}, ""); +%! assert (r{1}, ""); +%! assert (t{2}, "this"); +%! assert (r{2}, ""); +%! assert (t{3}, "this"); +%! assert (r{3}, " "); +%! assert (t{4}, "this"); +%! assert (r{4}, " is"); +%! assert (t{5}, "this"); +%! assert (r{5}, ""); +%! assert (t{6}, "this"); +%! assert (r{6}, " "); +%! assert (t{7}, ""); +%! assert (r{7}, ""); + +%% Simple check for 2, 3, and 4 delimeters +%!assert(strtok ("this is", "i "), "th"); +%!assert(strtok ("this is", "ij "), "th"); +%!assert(strtok ("this is", "ijk "), "th"); + +%% Test all cases for 8 delimiters since a different +%!# algorithm is used when more than 7 delimiters +%!assert (strtok ("","jklmnop "), ""); +%!assert (strtok ("this","jklmnop "), "this"); +%!assert (strtok ("this ","jklmnop "), "this"); +%!assert (strtok ("this is","jklmnop "), "this"); +%!assert (strtok (" this","jklmnop "), "this"); +%!assert (strtok (" this ","jklmnop "), "this"); +%!assert (strtok (" ","jklmnop "), ""(1:0)); + +%% Test 'bad' string orientations +%!assert (strtok (" this ".'), "this".'); # delimiter at start and end +%!assert (strtok (" this ".',"jkl "), "this".'); + +%% Test with TAB, LF, VT, FF, and CR +%!test +%! for ch = "\t\n\v\f\r" +%! [t, r] = strtok (cstrcat ("beg", ch, "end")); +%! assert (t, "beg"); +%! assert (r, cstrcat (ch, "end")) +%! endfor + +%% Test input validation +%!error strtok () +%!error strtok ("a", "b", "c") +%!error strtok (1, "b") +%!error strtok (char ("hello", "world"), "l") + diff --git a/octave_packages/m/strings/strtrim.m b/octave_packages/m/strings/strtrim.m new file mode 100644 index 0000000..7f68f0e --- /dev/null +++ b/octave_packages/m/strings/strtrim.m @@ -0,0 +1,88 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} strtrim (@var{s}) +## Remove leading and trailing whitespace from @var{s}. If +## @var{s} is a matrix, @var{strtrim} trims each row to the length of +## longest string. If @var{s} is a cell array of strings, operate recursively +## on each string element. For example: +## +## @example +## @group +## strtrim (" abc ") +## @result{} "abc" +## +## strtrim ([" abc "; " def "]) +## @result{} ["abc " ; " def"] +## @end group +## @end example +## @seealso{deblank} +## @end deftypefn + +## Author: John Swensen + +## This function was derived from deblank. + +function s = strtrim (s) + + if (nargin != 1) + print_usage (); + endif + + if (ischar (s)) + + k = find (! isspace (s)); + if (isempty (s) || isempty (k)) + s = ""; + else + s = s(:, ceil (min (k) / rows (s)):ceil (max (k) / rows (s))); + endif + + elseif (iscell (s)) + + char_idx = cellfun ("isclass", s, "char"); + cell_idx = cellfun ("isclass", s, "cell"); + if (! all (char_idx | cell_idx)) + error ("strtrim: S argument must be a string or cellstring"); + endif + + ## Divide work load. Recursive cellfun strtrim call is slow + ## and avoided where possible. + s(char_idx) = regexprep (s(char_idx), "^[\\s\v]+|[\\s\v]+$", ''); + s(cell_idx) = cellfun ("strtrim", s(cell_idx), "UniformOutput", false); + + else + error ("strtrim: S argument must be a string or cellstring"); + endif + +endfunction + + +%!assert (strtrim (" abc "), "abc"); +%!assert (strtrim (" "), ""); +%!assert (strtrim ("abc"), "abc"); +%!assert (strtrim ([" abc "; " def "]), ["abc "; " def"]); +%!assert (strtrim ({" abc "; " def "}), {"abc"; "def"}); +%!assert (strtrim ({" abc ", {" def "}}), {"abc", {"def"}}); + +%!error strtrim (); +%!error strtrim ("abc", "def"); +%!error strtrim (1); +%!error strtrim ({[]}); + diff --git a/octave_packages/m/strings/strtrunc.m b/octave_packages/m/strings/strtrunc.m new file mode 100644 index 0000000..4d3745d --- /dev/null +++ b/octave_packages/m/strings/strtrunc.m @@ -0,0 +1,78 @@ +## Copyright (C) 2006-2012 William Poetra Yoga Hadisoeseno +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} strtrunc (@var{s}, @var{n}) +## Truncate the character string @var{s} to length @var{n}. If @var{s} +## is a character matrix, then the number of columns is adjusted. +## If @var{s} is a cell array of strings, then the operation is performed +## on each cell element and the new cell array is returned. +## @end deftypefn + +function s = strtrunc (s, n) + + if (nargin != 2) + print_usage (); + endif + + n = fix (n); + if (! isscalar (n) || n < 0) + error ("strtrunc: length N must be a positive integer (N >= 0)"); + endif + + if (ischar (s)) + if (n < columns (s)) + s = s(:, 1:n); + endif + elseif (iscellstr (s)) + ## Convoluted approach converts cellstr to char matrix, trims the character + ## matrix using indexing, and then converts back to cellstr with mat2cell. + ## This approach is 24X faster than using cellfun with call to strtrunc + idx = cellfun ("size", s, 2) > n; + rows = cellfun ("size", s(idx), 1); + if (! isempty (rows)) + s(idx) = mat2cell (char (s(idx))(:, 1:n), rows); + endif + else + error ("strtrunc: S must be a character string or a cell array of strings"); + endif + +endfunction + + +%!assert (strtrunc("abcdefg", 4), "abcd"); +%!assert (strtrunc("abcdefg", 10), "abcdefg"); +%!assert (strtrunc(char ("abcdef", "fedcba"), 3), ["abc"; "fed"]); +%!assert (strtrunc({"abcdef", "fedcba"}, 3), {"abc", "fed"}); +%!assert (strtrunc({"", "1", "21", "321"}, 1), {"", "1", "2", "3"}) +%!assert (strtrunc({"1", "", "2"}, 1), {"1", "", "2"}) +%!test +%! cstr = {"line1"; ["line2"; "line3"]; "line4"}; +%! y = strtrunc (cstr, 4); +%! assert (size (y), [3, 1]); +%! assert (size (y{2}), [2, 4]); +%! assert (y{2}, repmat ("line", 2, 1)); + +%% Test input validation +%!error strtrunc () +%!error strtrunc ("abcd") +%!error strtrunc ("abcd", 4, 5) +%!error strtrunc ("abcd", ones (2,2)) +%!error strtrunc ("abcd", -1) +%!error strtrunc (1, 1) + diff --git a/octave_packages/m/strings/substr.m b/octave_packages/m/strings/substr.m new file mode 100644 index 0000000..359d120 --- /dev/null +++ b/octave_packages/m/strings/substr.m @@ -0,0 +1,113 @@ +## Copyright (C) 1996-2012 Kurt Hornik +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} substr (@var{s}, @var{offset}) +## @deftypefnx {Function File} {} substr (@var{s}, @var{offset}, @var{len}) +## Return the substring of @var{s} which starts at character number +## @var{offset} and is @var{len} characters long. +## +## Position numbering for offsets begins with 1. If @var{offset} is negative, +## extraction starts that far from the end of the string. +## +## If @var{len} is omitted, the substring extends to the end of @var{S}. A +## negative value for @var{len} extracts to within @var{len} characters of +## the end of the string +## +## Examples: +## +## @example +## @group +## substr ("This is a test string", 6, 9) +## @result{} "is a test" +## substr ("This is a test string", -11) +## @result{} "test string" +## substr ("This is a test string", -11, -7) +## @result{} "test" +## @end group +## @end example +## +## This function is patterned after the equivalent function in Perl. +## @end deftypefn + +## Author: Kurt Hornik +## Adapted-By: jwe + +function t = substr (s, offset, len) + + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + if (! ischar (s)) + error ("substr: S must be a string or string array"); + elseif (! isscalar (offset) || (nargin == 3 && ! isscalar (len))) + error ("substr: OFFSET and LEN must be scalar integers"); + endif + + offset = fix (offset); + nc = columns (s); + if (abs (offset) > nc || offset == 0) + error ("substr: OFFSET = %d out of range", offset); + endif + + if (offset <= 0) + offset += nc + 1; + endif + + if (nargin == 2) + eos = nc; + else + len = fix (len); + if (len < 0) + eos = nc + len; + else + eos = offset + len - 1; + endif + endif + + if (eos > nc) + error ("substr: length LEN = %d out of range", len); + elseif (offset > eos && len != 0) + error ("substr: No overlap with chosen values of OFFSET and LEN"); + endif + + t = s(:, offset:eos); + +endfunction + + +%!assert (substr ("This is a test string", 6, 9), "is a test"); +%!assert (substr ("This is a test string", -11), "test string"); +%!assert (substr ("This is a test string", -11, 4), "test"); +%!assert (substr ("This is a test string", -11, -7), "test"); +%!assert (substr ("This is a test string", 1, -7), "This is a test"); +%!assert (isempty (substr ("This is a test string", 1, 0))); + +%% Test input validation +%!error substr () +%!error substr ("foo", 2, 3, 4) +%!error substr (ones (5, 1), 1, 1) +%!error substr ("foo", ones(2,2)) +%!error substr ("foo", 1, ones(2,2)) +%!error substr ("foo", 0) +%!error substr ("foo", 5) +%!error substr ("foo", 1, 5) +%!error substr ("foo", -1, 5) +%!error substr ("foo", 2, -5) + diff --git a/octave_packages/m/strings/untabify.m b/octave_packages/m/strings/untabify.m new file mode 100644 index 0000000..3b90689 --- /dev/null +++ b/octave_packages/m/strings/untabify.m @@ -0,0 +1,123 @@ +## Copyright (C) 2010-2012 Ben Abbott +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 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 Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} untabify (@var{t}) +## @deftypefnx {Function File} {} untabify (@var{t}, @var{tw}) +## @deftypefnx {Function File} {} untabify (@var{t}, @var{tw}, @var{deblank}) +## Replace TAB characters in @var{t}, with spaces. +## The tab width is specified by @var{tw}, or defaults to eight. +## The input, @var{t}, may be either a 2-D character array, or a cell +## array of character strings. The output is the same class +## as the input. +## +## If the optional argument @var{deblank} is true, then the spaces will +## be removed from the end of the character data. +## +## The following example reads a file and writes an untabified version +## of the same file with trailing spaces stripped. +## +## @example +## @group +## fid = fopen ("tabbed_script.m"); +## text = char (fread (fid, "uchar")'); +## fclose (fid); +## fid = fopen ("untabified_script.m", "w"); +## text = untabify (strsplit (text, "\n"), 8, true); +## fprintf (fid, "%s\n", text@{:@}); +## fclose (fid); +## @end group +## @end example +## +## @seealso{strjust, strsplit, deblank} +## @end deftypefn + +## Author: Ben Abbott +## Created: 2010-10-15 + +function s = untabify (t, tw = 8, dblank = false) + + if (nargin < 1 || nargin > 3) + print_usage (); + elseif (! (ischar (t) || iscellstr (t))) + error ("untabify: T must be a string or cellstring"); + endif + + if (ischar (t)) + s = replace_tabs (t, tw); + else + s = cellfun (@(str) replace_tabs (str, tw), t, "uniformoutput", false); + endif + + if (dblank) + s = deblank (s); + endif + +endfunction + +function s = replace_tabs (t, tw) + + if (ndims (t) != 2) + error ("untabify: character strings to untabify must have 2 dimensions"); + endif + + if (isempty (t)) + s = t; + else + nr = rows (t); + sc = cell (nr, 1); + for j = 1:nr + n = 1:numel(t(j,:)); + m = find (t(j,:) == "\t"); + t(j,m) = " "; + for i = 1:numel(m) + k = tw * ceil (n(m(i)) / tw); + dn = k - n(m(i)); + n(m(i):end) += dn; + endfor + sc{j} = blanks (n(end)); + sc{j}(n) = t(j,:); + endfor + s = char (sc); + endif + +endfunction + + +%!test +%! s = untabify ("\thello\t"); +%! assert (s, [blanks(8) "hello" blanks(3)]); + +%!test +%! s = untabify ("\thello\t", 2); +%! assert (s, [blanks(2) "hello" blanks(1)]); + +%!test +%! s = untabify ("\thello\t", 4, true); +%! assert (s, [blanks(4) "hello"]); + +%!assert (isempty (untabify (""))) + +%!test +%! s = char (randi ([97 97+25], 3, 3)); +%! assert (untabify (s), char (untabify (cellstr (s)))); + +%!error untabify () +%!error untabify (1,2,3,4) +%!error untabify (1) + diff --git a/octave_packages/m/strings/validatestring.m b/octave_packages/m/strings/validatestring.m new file mode 100644 index 0000000..08877c0 --- /dev/null +++ b/octave_packages/m/strings/validatestring.m @@ -0,0 +1,163 @@ +## Copyright (C) 2008-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{validstr} =} validatestring (@var{str}, @var{strarray}) +## @deftypefnx {Function File} {@var{validstr} =} validatestring (@var{str}, @var{strarray}, @var{funcname}) +## @deftypefnx {Function File} {@var{validstr} =} validatestring (@var{str}, @var{strarray}, @var{funcname}, @var{varname}) +## @deftypefnx {Function File} {@var{validstr} =} validatestring (@dots{}, @var{position}) +## Verify that @var{str} is an element, or substring of an element, in +## @var{strarray}. +## +## When @var{str} is a character string to be tested, and @var{strarray} is a +## cellstr of valid values, then @var{validstr} will be the validated form +## of @var{str} where validation is defined as @var{str} being a member +## or substring of @var{validstr}. This is useful for both verifying +## and expanding short options, such as "r", to their longer forms, such as +## "red". If @var{str} is a substring of @var{validstr}, and there are +## multiple matches, the shortest match will be returned if all matches are +## substrings of each other. Otherwise, an error will be raised because the +## expansion of @var{str} is ambiguous. All comparisons are case insensitive. +## +## The additional inputs @var{funcname}, @var{varname}, and @var{position} +## are optional and will make any generated validation error message more +## specific. +## +## Examples: +## @c Set example in small font to prevent overfull line +## +## @smallexample +## @group +## validatestring ("r", @{"red", "green", "blue"@}) +## @result{} "red" +## +## validatestring ("b", @{"red", "green", "blue", "black"@}) +## @result{} error: validatestring: multiple unique matches were found for 'b': +## blue, black +## @end group +## @end smallexample +## +## @seealso{strcmp, strcmpi} +## @end deftypefn + +## Author: Bill Denney + +function str = validatestring (str, strarray, varargin) + + if (nargin < 2 || nargin > 5) + print_usage (); + endif + + position = 0; + ## Process input arguments + if (! isempty (varargin) && isnumeric (varargin{end})) + position = varargin{end}; + varargin(end) = []; + endif + + funcname = varname = ""; + char_idx = cellfun ("isclass", varargin, "char"); + n_chararg = sum (char_idx); + if (n_chararg > 2) + error ("validatestring: invalid number of character inputs (3)"); + elseif (n_chararg == 2) + [funcname, varname] = deal (varargin{char_idx}); + elseif (n_chararg == 1) + funcname = varargin{char_idx}; + endif + + ## Check the inputs + if (! ischar (str)) + error ("validatestring: STR must be a character string"); + elseif (! isrow (str)) + error ("validatestring: STR must be a single row vector"); + elseif (! iscellstr (strarray)) + error ("validatestring: STRARRAY must be a cellstr"); + elseif (! isempty (funcname) && ! isrow (funcname)) + error ("validatestring: FUNCNAME must be a single row vector"); + elseif (! isempty (varname) && ! isrow (varname)) + error ("validatestring: VARNAME must be a single row vector"); + elseif (position < 0) + error ("validatestring: POSITION must be >= 0"); + endif + + ## Make static part of error string that uses funcname, varname, and position + errstr = ""; + if (! isempty (funcname)) + errstr = sprintf ("Function: %s ", funcname); + endif + if (! isempty (varname)) + errstr = sprintf ("%sVariable: %s ", errstr, varname); + endif + if (position > 0) + errstr = sprintf ("%sArgument position %d ", errstr, position); + endif + if (! isempty (errstr)) + errstr(end:end+1) = ":\n"; + endif + + matches = strncmpi (str, strarray(:), numel (str)); + nmatches = sum (matches); + if (nmatches == 0) + error ("validatestring: %s'%s' does not match any of\n%s", errstr, str, + sprintf ("%s, ", strarray{:})(1:end-2)); + elseif (nmatches == 1) + str = strarray{matches}; + else + ## Are the matches substrings of each other? + ## If true, choose the shortest. If not, raise an error. + match_idx = find (matches); + match_len = cellfun ("length", strarray(match_idx)); + [min_len, min_idx] = min (match_len); + short_str = strarray{match_idx(min_idx)}; + submatch = strncmpi (short_str, strarray(match_idx), min_len); + if (all (submatch)) + str = short_str; + else + error ("validatestring: %smultiple unique matches were found for '%s':\n%s", + errstr, str, sprintf ("%s, ", strarray{match_idx})(1:end-2)); + endif + endif + +endfunction + + +%!shared strarray +%! strarray = {"octave" "Oct" "octopus" "octaves"}; +%!assert (validatestring ("octave", strarray), "octave") +%!assert (validatestring ("oct", strarray), "Oct") +%!assert (validatestring ("octa", strarray), "octave") +%! strarray = {"abc1" "def" "abc2"}; +%!assert (validatestring ("d", strarray), "def") +%!error <'xyz' does not match any> validatestring ("xyz", strarray) +%!error validatestring ("xyz", strarray, "DUMMY_TEST") +%!error validatestring ("xyz", strarray, "DUMMY_TEST", "DUMMY_VAR") +%!error validatestring ("xyz", strarray, "DUMMY_TEST", "DUMMY_VAR", 5) +%!error validatestring ("abc", strarray) + +%% Test input validation +%!error validatestring ("xyz") +%!error validatestring ("xyz", {"xyz"}, "3", "4", 5, 6) +%!error validatestring ("xyz", {"xyz"}, "3", "4", "5") +%!error validatestring (1, {"xyz"}, "3", "4", 5) +%!error validatestring ("xyz".', {"xyz"}, "3", "4", 5) +%!error validatestring ("xyz", "xyz", "3", "4", 5) +%!error validatestring ("xyz", {"xyz"}, "33".', "4", 5) +%!error validatestring ("xyz", {"xyz"}, "3", "44".', 5) +%!error validatestring ("xyz", {"xyz"}, "3", "4", -5) + diff --git a/octave_packages/m/testfun/assert.m b/octave_packages/m/testfun/assert.m new file mode 100644 index 0000000..e520bf5 --- /dev/null +++ b/octave_packages/m/testfun/assert.m @@ -0,0 +1,337 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} assert (@var{cond}) +## @deftypefnx {Function File} {} assert (@var{cond}, @var{errmsg}, @dots{}) +## @deftypefnx {Function File} {} assert (@var{cond}, @var{msg_id}, @var{errmsg}, @dots{}) +## @deftypefnx {Function File} {} assert (@var{observed}, @var{expected}) +## @deftypefnx {Function File} {} assert (@var{observed}, @var{expected}, @var{tol}) +## +## Produce an error if the specified condition is not met. @code{assert} can +## be called in three different ways. +## +## @table @code +## @item assert (@var{cond}) +## @itemx assert (@var{cond}, @var{errmsg}, @dots{}) +## @itemx assert (@var{cond}, @var{msg_id}, @var{errmsg}, @dots{}) +## Called with a single argument @var{cond}, @code{assert} produces an +## error if @var{cond} is zero. When called with more than one argument the +## additional arguments are passed to the @code{error} function. +## +## @item assert (@var{observed}, @var{expected}) +## Produce an error if observed is not the same as expected. Note that +## @var{observed} and @var{expected} can be scalars, vectors, matrices, +## strings, cell arrays, or structures. +## +## @item assert (@var{observed}, @var{expected}, @var{tol}) +## Produce an error if observed is not the same as expected but equality +## comparison for numeric data uses a tolerance @var{tol}. +## If @var{tol} is positive then it is an absolute tolerance which will produce +## an error if @code{abs(@var{observed} - @var{expected}) > abs(@var{tol})}. +## If @var{tol} is negative then it is a relative tolerance which will produce +## an error if @code{abs(@var{observed} - @var{expected}) > +## abs(@var{tol} * @var{expected})}. If @var{expected} is zero @var{tol} will +## always be interpreted as an absolute tolerance. +## @end table +## @seealso{test, fail, error} +## @end deftypefn + +## FIXME: Output throttling: don't print out the entire 100x100 matrix, +## but instead give a summary; don't print out the whole list, just +## say what the first different element is, etc. To do this, make +## the message generation type specific. + +function assert (cond, varargin) + + in = deblank (argn(1,:)); + for i = 2:rows (argn) + in = cstrcat (in, ",", deblank (argn(i,:))); + endfor + in = cstrcat ("(", in, ")"); + + if (nargin == 1 || (nargin > 1 && islogical (cond) && ischar (varargin{1}))) + if ((! isnumeric (cond) && ! islogical (cond)) || ! all (cond(:))) + if (nargin == 1) + ## Say which elements failed? + error ("assert %s failed", in); + else + error (varargin{:}); + endif + endif + else + if (nargin < 2 || nargin > 3) + print_usage (); + endif + + expected = varargin{1}; + if (nargin < 3) + tol = 0; + else + tol = varargin{2}; + endif + + if (exist ("argn") == 0) + argn = " "; + endif + + coda = ""; + iserror = 0; + + + if (ischar (expected)) + iserror = (! ischar (cond) || ! strcmp (cond, expected)); + + elseif (iscell (expected)) + if (! iscell (cond) || any (size (cond) != size (expected))) + iserror = 1; + else + try + for i = 1:length (expected(:)) + assert (cond{i}, expected{i}, tol); + endfor + catch + iserror = 1; + end_try_catch + endif + + elseif (isstruct (expected)) + if (! isstruct (cond) || any (size (cond) != size (expected)) + || rows (fieldnames (cond)) != rows (fieldnames (expected))) + iserror = 1; + else + try + #empty = numel (cond) == 0; + empty = isempty (cond); + normal = (numel (cond) == 1); + for [v, k] = cond + if (! isfield (expected, k)) + error (); + endif + if (empty) + v = {}; + elseif (normal) + v = {v}; + else + v = v(:)'; + endif + assert (v, {expected.(k)}, tol); + endfor + catch + iserror = 1; + end_try_catch + endif + + elseif (ndims (cond) != ndims (expected) + || any (size (cond) != size (expected))) + iserror = 1; + coda = "Dimensions don't match"; + + else + if (nargin < 3) + ## Without explicit tolerance, be more strict. + if (! strcmp (class (cond), class (expected))) + iserror = 1; + coda = cstrcat ("Class ", class (cond), " != ", class (expected)); + elseif (isnumeric (cond)) + if (issparse (cond) != issparse (expected)) + if (issparse (cond)) + iserror = 1; + coda = "sparse != non-sparse"; + else + iserror = 1; + coda = "non-sparse != sparse"; + endif + elseif (iscomplex (cond) != iscomplex (expected)) + if (iscomplex (cond)) + iserror = 1; + coda = "complex != real"; + else + iserror = 1; + coda = "real != complex"; + endif + endif + endif + endif + + if (! iserror) + ## Numeric. + A = cond(:); + B = expected(:); + ## Check exceptional values. + if (any (isna (A) != isna (B))) + iserror = 1; + coda = "NAs don't match"; + elseif (any (isnan (A) != isnan (B))) + iserror = 1; + coda = "NaNs don't match"; + ## Try to avoid problems comparing strange values like Inf+NaNi. + elseif (any (isinf (A) != isinf (B)) + || any (A(isinf (A) & ! isnan (A)) != B(isinf (B) & ! isnan (B)))) + iserror = 1; + coda = "Infs don't match"; + else + ## Check normal values. + A = A(isfinite (A)); + B = B(isfinite (B)); + if (tol == 0) + err = any (A != B); + errtype = "values do not match"; + elseif (tol >= 0) + err = max (abs (A - B)); + errtype = "maximum absolute error %g exceeds tolerance %g"; + else + abserr = max (abs (A(B == 0))); + A = A(B != 0); + B = B(B != 0); + relerr = max (abs (A - B) ./ abs (B)); + err = max ([abserr; relerr]); + errtype = "maximum relative error %g exceeds tolerance %g"; + endif + if (err > abs (tol)) + iserror = 1; + coda = sprintf (errtype, err, abs (tol)); + endif + endif + endif + + endif + + if (! iserror) + return; + endif + + ## Pretty print the "expected but got" info, trimming leading and + ## trailing "\n". + str = disp (expected); + idx = find (str != "\n"); + if (! isempty (idx)) + str = str(idx(1):idx(end)); + endif + str2 = disp (cond); + idx = find (str2 != "\n"); + if (! isempty (idx)) + str2 = str2 (idx(1):idx(end)); + endif + msg = cstrcat ("assert ", in, " expected\n", str, "\nbut got\n", str2); + if (! isempty (coda)) + msg = cstrcat (msg, "\n", coda); + endif + error ("%s", msg); + endif + +endfunction + + +## empty input +%!assert ([]) +%!assert (zeros (3,0), zeros (3,0)) +%!error assert (zeros (3,0), zeros (0,2)) +%!error assert (zeros (3,0), []) +%!error assert (zeros (2,0,2), zeros (2,0)) + +## conditions +%!assert (isempty ([])) +%!assert (1) +%!error assert (0) +%!assert (ones(3,1)) +%!assert (ones(1,3)) +%!assert (ones(3,4)) +%!error assert ([1,0,1]) +%!error assert ([1;1;0]) +%!error assert ([1,0;1,1]) + +## scalars +%!error assert (3, [3,3; 3,3]) +%!error assert ([3,3; 3,3], 3) +%!assert (3, 3) +%!assert (3+eps, 3, eps) +%!assert (3, 3+eps, eps) +%!error assert (3+2*eps, 3, eps) +%!error assert (3, 3+2*eps, eps) + +## vectors +%!assert ([1,2,3],[1,2,3]); +%!assert ([1;2;3],[1;2;3]); +%!error assert ([2;2;3],[1;2;3]); +%!error assert ([1,2,3],[1;2;3]); +%!error assert ([1,2],[1,2,3]); +%!error assert ([1;2;3],[1;2]); +%!assert ([1,2;3,4],[1,2;3,4]); +%!error assert ([1,4;3,4],[1,2;3,4]) +%!error assert ([1,3;2,4;3,5],[1,2;3,4]) + +## must give a small tolerance for floating point errors on relative +%!assert (100+100*eps, 100, -2*eps) +%!assert (100, 100+100*eps, -2*eps) +%!error assert (100+300*eps, 100, -2*eps) +%!error assert (100, 100+300*eps, -2*eps) +%!error assert (3, [3,3]) +%!error assert (3, 4) + +## test relative vs. absolute tolerances +%!test assert (0.1+eps, 0.1, 2*eps); # accept absolute +%!error assert (0.1+eps, 0.1, -2*eps); # fail relative +%!test assert (100+100*eps, 100, -2*eps); # accept relative +%!error assert (100+100*eps, 100, 2*eps); # fail absolute + +## exceptional values +%!assert ([NaN, NA, Inf, -Inf, 1+eps, eps], [NaN, NA, Inf, -Inf, 1, 0], eps) +%!error assert (NaN, 1) +%!error assert (NA, 1) +%!error assert (-Inf, Inf) + +## strings +%!assert ("dog", "dog") +%!error assert ("dog", "cat") +%!error assert ("dog", 3) +%!error assert (3, "dog") + +## structures +%!shared x,y +%! x.a = 1; x.b=[2, 2]; +%! y.a = 1; y.b=[2, 2]; +%!assert (x, y) +%!test y.b=3; +%!error assert (x, y) +%!error assert (3, x) +%!error assert (x, 3) +%!test +%! # Empty structures +%! x = resize (x, 0, 1); +%! y = resize (y, 0, 1); +%! assert (x, y); + +## cell arrays +%!test +%! x = {[3], [1,2,3]; 100+100*eps, "dog"}; +%! y = x; +%! assert (x, y); +%! y = x; y(1,1) = [2]; +%! fail ("assert (x, y)"); +%! y = x; y(1,2) = [0, 2, 3]; +%! fail ("assert (x, y)"); +%! y = x; y(2,1) = 101; +%! fail ("assert (x, y)"); +%! y = x; y(2,2) = "cat"; +%! fail ("assert (x, y)"); + +%% Test input validation +%!error assert +%!error assert (1,2,3,4) + diff --git a/octave_packages/m/testfun/demo.m b/octave_packages/m/testfun/demo.m new file mode 100644 index 0000000..0fc6868 --- /dev/null +++ b/octave_packages/m/testfun/demo.m @@ -0,0 +1,154 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} demo @var{name} +## @deftypefnx {Command} {} demo @var{name} @var{n} +## @deftypefnx {Function File} {} demo ('@var{name}') +## @deftypefnx {Function File} {} demo ('@var{name}', @var{n}) +## +## Run example code block @var{n} associated with the function @var{name}. +## If @var{n} is not specified, all examples are run. +## +## Examples are stored in the script file, or in a file with the same +## name but no extension located on Octave's load path. To keep examples +## separate from regular script code, all lines are prefixed by @code{%!}. Each +## example must also be introduced by the keyword 'demo' flush left to the +## prefix with no intervening spaces. The remainder of the example can +## contain arbitrary Octave code. For example: +## +## @example +## @group +## %!demo +## %! t=0:0.01:2*pi; x = sin (t); +## %! plot (t,x) +## %! %------------------------------------------------- +## %! % the figure window shows one cycle of a sine wave +## @end group +## @end example +## +## Note that the code is displayed before it is executed, so a simple +## comment at the end suffices for labeling what is being shown. It is +## generally not necessary to use @code{disp} or @code{printf} within the demo. +## +## Demos are run in a function environment with no access to external +## variables. This means that every demo must have separate initialization +## code. Alternatively, all demos can be combined into a single large demo +## with the code +## +## @example +## %! input("Press to continue: ","s"); +## @end example +## +## @noindent +## between the sections, but this is discouraged. Other techniques +## to avoid multiple initialization blocks include using multiple plots +## with a new @code{figure} command between each plot, or using @code{subplot} +## to put multiple plots in the same window. +## +## Also, because demo evaluates within a function context, you cannot +## define new functions inside a demo. If you must have function blocks, +## rather than just anonymous functions or inline functions, you will have to +## use @code{eval(example('function',n))} to see them. Because eval only +## evaluates one line, or one statement if the statement crosses +## multiple lines, you must wrap your demo in "if 1 endif" +## with the 'if' on the same line as 'demo'. For example: +## +## @example +## @group +## %!demo if 1 +## %! function y=f(x) +## %! y=x; +## %! endfunction +## %! f(3) +## %! endif +## @end group +## @end example +## +## @seealso{test, example} +## @end deftypefn + +## FIXME: modify subplot so that gnuplot_has_multiplot == 0 causes it to +## use the current figure window but pause if not plotting in the +## first subplot. + +function demo (name, n) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin < 2) + n = 0; + elseif (ischar (n)) + n = str2double (n); + endif + + [code, idx] = test (name, "grabdemo"); + if (isempty (idx)) + warning ("no demo available for %s", name); + return; + elseif (n >= length (idx)) + warning ("only %d demos available for %s", length (idx) - 1, name); + return; + endif + + if (n > 0) + doidx = n; + else + doidx = 1:length(idx)-1; + endif + for i = 1:length (doidx) + ## Pause between demos + if (i > 1) + input ("Press to continue: ", "s"); + endif + + ## Process each demo without failing + try + block = code(idx(doidx(i)):idx(doidx(i)+1)-1); + ## FIXME: need to check for embedded test functions, which cause + ## segfaults, until issues with subfunctions in functions are resolved. + embed_func = regexp (block, '^\s*function ', 'once', 'lineanchors'); + if (isempty (embed_func)) + ## Use an environment without variables + eval (cstrcat ("function __demo__()\n", block, "\nendfunction")); + ## Display the code that will be executed before executing it + printf ("%s example %d:%s\n\n", name, doidx(i), block); + __demo__; + else + error (["Functions embedded in %!demo blocks are not allowed.\n", ... + "Use the %!function/%!endfunction syntax instead to define shared functions for testing.\n"]); + endif + catch + ## Let the programmer know which demo failed. + printf ("%s example %d: failed\n%s\n", name, doidx(i), lasterr ()); + end_try_catch + clear __demo__; + endfor + +endfunction + +%!demo +%! t=0:0.01:2*pi; x = sin(t); +%! plot (t,x) +%! %------------------------------------------------- +%! % the figure window shows one cycle of a sine wave + +%!error demo (); +%!error demo (1, 2, 3); diff --git a/octave_packages/m/testfun/example.m b/octave_packages/m/testfun/example.m new file mode 100644 index 0000000..15f5256 --- /dev/null +++ b/octave_packages/m/testfun/example.m @@ -0,0 +1,104 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} example @var{name} +## @deftypefnx {Command} {} example @var{name} @var{n} +## @deftypefnx {Function File} {} example ('@var{name}') +## @deftypefnx {Function File} {} example ('@var{name}', @var{n}) +## @deftypefnx {Function File} {[@var{s}, @var{idx}] =} example (@dots{}) +## +## Display the code for example @var{n} associated with the function +## '@var{name}', but do not run it. If @var{n} is not specified, all examples +## are displayed. +## +## When called with output arguments, the examples are returned in the form of +## a string @var{s}, with @var{idx} indicating the ending position of the +## various examples. +## +## See @code{demo} for a complete explanation. +## @seealso{demo, test} +## @end deftypefn + +function [code_r, idx_r] = example (name, n) + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (nargin < 2) + n = 0; + elseif (ischar (n)) + n = str2double (n); + endif + + [code, idx] = test (name, "grabdemo"); + if (nargout > 0) + if (n > 0) + if (n <= length (idx)) + code_r = code(idx(n):idx(n+1)-1); + idx_r = [1, length(code_r)+1]; + else + code_r = ""; + idx_r = []; + endif + else + code_r = code; + idx_r = idx; + endif + else + if (n > 0) + doidx = n; + else + doidx = 1:length(idx)-1; + endif + if (isempty (idx)) + warning ("no example available for %s", name); + return; + elseif (n >= length(idx)) + warning ("only %d examples available for %s", length(idx)-1, name); + return; + endif + + for i = 1:length (doidx) + block = code(idx(doidx(i)):idx(doidx(i)+1)-1); + printf ("%s example %d:%s\n\n", name, doidx(i), block); + endfor + endif + +endfunction + + +%!## warning: don't modify the demos without modifying the tests! +%!demo +%! example ('example'); +%!demo +%! t=0:0.01:2*pi; x = sin(t); +%! plot (t,x) + +%!assert (example('example',1), "\n example ('example');"); +%!test +%! [code, idx] = example ('example'); +%! assert (code, ... +%! "\n example ('example');\n t=0:0.01:2*pi; x = sin(t);\n plot (t,x)") +%! assert (idx, [1, 23, 63]); + +%% Test input validation +%!error example +%!error example ('example', 3, 5) + diff --git a/octave_packages/m/testfun/fail.m b/octave_packages/m/testfun/fail.m new file mode 100644 index 0000000..dc90867 --- /dev/null +++ b/octave_packages/m/testfun/fail.m @@ -0,0 +1,144 @@ +## Copyright (C) 2005-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . +## +## Original version by Paul Kienzle distributed as free software in the +## public domain. + +## -*- texinfo -*- +## @deftypefn {Function File} {} fail (@var{code}) +## @deftypefnx {Function File} {} fail (@var{code}, @var{pattern}) +## @deftypefnx {Function File} {} fail (@var{code}, 'warning', @var{pattern}) +## +## Return true if @var{code} fails with an error message matching +## @var{pattern}, otherwise produce an error. Note that @var{code} +## is a string and if @var{code} runs successfully, the error produced is: +## +## @example +## expected error but got none +## @end example +## +## If the code fails with a different error, the message produced is: +## +## @example +## @group +## expected +## but got +## @end group +## @end example +## +## The angle brackets are not part of the output. +## +## Called with three arguments, the behavior is similar to +## @code{fail(@var{code}, @var{pattern})}, but produces an error if no +## warning is given during code execution or if the code fails. +## @seealso{assert} +## @end deftypefn + +## Author: Paul Kienzle + +function ret = fail (code, pattern, warning_pattern) + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + ## sort out arguments + test_warning = (nargin > 1 && strcmp (pattern, "warning")); + if (nargin == 3) + pattern = warning_pattern; + elseif (nargin == 1 || (nargin == 2 && test_warning)) + pattern = ""; + endif + + ## match any nonempty message + if (isempty (pattern)) + pattern = "."; + endif + + ## allow assert(fail()) + if (nargout) + ret = 1; + endif + + if (test_warning) + ## Perform the warning test. + ## Clear old warnings. + lastwarn (); + ## Make sure warnings are turned on. + state = warning ("query", "quiet"); + warning ("on", "quiet"); + try + ## printf("lastwarn before %s: %s\n",code,lastwarn); + evalin ("caller", sprintf ("%s;", code)); + ## printf("lastwarn after %s: %s\n",code,lastwarn); + ## Retrieve new warnings. + err = lastwarn (); + warning (state.state, "quiet"); + if (isempty (err)) + msg = sprintf ("expected warning <%s> but got none", pattern); + else + ## Transform "warning: ...\n" to "...". + err([1:9, end]) = []; + if (! isempty (regexp (err, pattern, "once"))) + return; + endif + msg = sprintf ("expected warning <%s>\nbut got <%s>", pattern, err); + endif + catch + warning (state.state, "quiet"); + err = lasterr; + ## Transform "error: ...\n", to "...". + err([1:7, end]) = []; + msg = sprintf ("expected warning <%s> but got error <%s>", pattern, err); + end_try_catch + + else + ## Perform the error test. + try + evalin ("caller", sprintf ("%s;", code)); + msg = sprintf ("expected error <%s> but got none", pattern); + catch + err = lasterr (); + if (strcmp (err(1:7), "error:")) + err([1:6, end]) = []; # transform "error: ...\n", to "..." + endif + if (! isempty (regexp (err, pattern, "once"))) + return; + endif + msg = sprintf ("expected error <%s>\nbut got <%s>", pattern, err); + end_try_catch + endif + + ## If we get here, then code didn't fail or error didn't match. + error (msg); + +endfunction + + +%!fail ('[1,2]*[2,3]', 'nonconformant') +%!fail ("fail('[1,2]*[2;3]', 'nonconformant')", "expected error but got none") +%!fail ("fail('[1,2]*[2,3]','usage:')", "expected error \nbut got.*nonconformant") +%!fail ("warning('test warning')", 'warning','test warning'); + +##% !fail ("warning('next test')",'warning','next test'); ## only allowed one warning test?!? + +%% Test that fail() itself will generate an error +%!error fail ("1"); +%!error fail ('a*[2;3]', 'nonconformant') +%!error fail ('a*[2,3]', 'usage:') +%!error fail ("warning('warning failure')", 'warning', 'success') diff --git a/octave_packages/m/testfun/rundemos.m b/octave_packages/m/testfun/rundemos.m new file mode 100644 index 0000000..bed5e13 --- /dev/null +++ b/octave_packages/m/testfun/rundemos.m @@ -0,0 +1,89 @@ +## Copyright (C) 2008-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} rundemos () +## @deftypefnx {Function File} {} rundemos (@var{directory}) +## Execute built-in demos for all function files in the specified directory. +## If no directory is specified, operate on all directories in Octave's +## search path for functions. +## @seealso{runtests, path} +## @end deftypefn + +## Author: jwe + +function rundemos (directory) + + if (nargin == 0) + dirs = strsplit (path (), pathsep ()); + elseif (nargin == 1) + if (is_absolute_filename (directory)) + dirs = {directory}; + else + directory = regexprep (directory, ['\',filesep(),'$'], ""); + fullname = find_dir_in_path (directory); + if (! isempty (fullname)) + dirs = {fullname}; + else + error ("rundemos: DIRECTORY argument must be a valid pathname"); + endif + endif + else + print_usage (); + endif + + for i = 1:numel (dirs) + d = dirs{i}; + run_all_demos (d); + endfor + +endfunction + +function run_all_demos (directory) + dirinfo = dir (directory); + flist = {dirinfo.name}; + for i = 1:numel (flist) + f = flist{i}; + if (length (f) > 2 && strcmp (f((end-1):end), ".m")) + f = fullfile (directory, f); + if (has_demos (f)) + try + demo (f); + catch + printf ("error: %s\n\n", lasterror().message) + end_try_catch + if (i != numel (flist)) + input ("Press to continue: ", "s"); + endif + endif + endif + endfor +endfunction + +function retval = has_demos (f) + fid = fopen (f); + if (f < 0) + error ("rundemos: fopen failed: %s", f); + else + str = fscanf (fid, "%s"); + fclose (fid); + retval = findstr (str, "%!demo"); + endif +endfunction + +%!error rundemos ("foo", 1); diff --git a/octave_packages/m/testfun/runtests.m b/octave_packages/m/testfun/runtests.m new file mode 100644 index 0000000..8d7ab78 --- /dev/null +++ b/octave_packages/m/testfun/runtests.m @@ -0,0 +1,108 @@ +## Copyright (C) 2010-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} runtests () +## @deftypefnx {Function File} {} runtests (@var{directory}) +## Execute built-in tests for all function files in the specified directory. +## If no directory is specified, operate on all directories in Octave's +## search path for functions. +## @seealso{rundemos, path} +## @end deftypefn + +## Author: jwe + +function runtests (directory) + + if (nargin == 0) + dirs = strsplit (path (), pathsep ()); + elseif (nargin == 1) + if (is_absolute_filename (directory)) + dirs = {directory}; + else + directory = regexprep (directory, ['\',filesep(),'$'], ""); + fullname = find_dir_in_path (directory); + if (! isempty (fullname)) + dirs = {fullname}; + else + error ("runtests: DIRECTORY argument must be a valid pathname"); + endif + endif + else + print_usage (); + endif + + for i = 1:numel (dirs) + d = dirs{i}; + run_all_tests (d); + endfor + +endfunction + +function run_all_tests (directory) + dirinfo = dir (directory); + flist = {dirinfo.name}; + no_tests = {}; + printf ("Processing files in %s:\n\n", directory); + fflush (stdout); + for i = 1:numel (flist) + f = flist{i}; + if (length (f) > 2 && strcmp (f((end-1):end), ".m")) + ff = fullfile (directory, f); + if (has_tests (ff)) + print_test_file_name (f); + [p, n, xf, sk] = test (ff, "quiet"); + print_pass_fail (n, p); + fflush (stdout); + else + no_tests{end+1} = f; + endif + endif + endfor + if (! isempty (no_tests)) + printf ("\nThe following files in %s have no tests:\n\n", directory); + printf ("%s", list_in_columns (no_tests)); + endif +endfunction + +function retval = has_tests (f) + fid = fopen (f); + if (fid >= 0) + str = fread (fid, "*char")'; + fclose (fid); + retval = ! isempty (regexp (str, '^%!(test|assert|error|warning)', "lineanchors")); + else + error ("runtests: fopen failed: %s", f); + endif +endfunction + +function print_pass_fail (n, p) + if (n > 0) + printf (" PASS %4d/%-4d", p, n); + nfail = n - p; + if (nfail > 0) + printf (" FAIL %d", nfail); + endif + endif + puts ("\n"); +endfunction + +function print_test_file_name (nm) + filler = repmat (".", 1, 55-length (nm)); + printf (" %s %s", nm, filler); +endfunction diff --git a/octave_packages/m/testfun/speed.m b/octave_packages/m/testfun/speed.m new file mode 100644 index 0000000..22b23f3 --- /dev/null +++ b/octave_packages/m/testfun/speed.m @@ -0,0 +1,444 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} speed (@var{f}, @var{init}, @var{max_n}, @var{f2}, @var{tol}) +## @deftypefnx {Function File} {[@var{order}, @var{n}, @var{T_f}, @var{T_f2}] =} speed (@dots{}) +## +## Determine the execution time of an expression (@var{f}) for various input +## values (@var{n}). The @var{n} are log-spaced from 1 to @var{max_n}. For +## each @var{n}, an initialization expression (@var{init}) is computed to +## create any data needed for the test. If a second expression (@var{f2}) is +## given then the execution times of the two expressions are compared. When +## called without output arguments the results are printed to stdout and +## displayed graphically. +## +## @table @code +## @item @var{f} +## The code expression to evaluate. +## +## @item @var{max_n} +## The maximum test length to run. The default value is 100. Alternatively, +## use @code{[min_n, max_n]} or specify the @var{n} exactly with +## @code{[n1, n2, @dots{}, nk]}. +## +## @item @var{init} +## Initialization expression for function argument values. Use @var{k} +## for the test number and @var{n} for the size of the test. This should +## compute values for all variables used by @var{f}. Note that @var{init} will +## be evaluated first for @math{k = 0}, so things which are constant throughout +## the test series can be computed once. The default value is +## @code{@var{x} = randn (@var{n}, 1)}. +## +## @item @var{f2} +## An alternative expression to evaluate, so that the speed of two +## expressions can be directly compared. The default is @code{[]}. +## +## @item @var{tol} +## Tolerance used to compare the results of expression @var{f} and expression +## @var{f2}. If @var{tol} is positive, the tolerance is an absolute one. +## If @var{tol} is negative, the tolerance is a relative one. The default is +## @code{eps}. If @var{tol} is @code{Inf}, then no comparison will be made. +## +## @item @var{order} +## The time complexity of the expression @math{O(a*n^p)}. This +## is a structure with fields @code{a} and @code{p}. +## +## @item @var{n} +## The values @var{n} for which the expression was calculated @strong{AND} +## the execution time was greater than zero. +## +## @item @var{T_f} +## The nonzero execution times recorded for the expression @var{f} in seconds. +## +## @item @var{T_f2} +## The nonzero execution times recorded for the expression @var{f2} in seconds. +## If required, the mean time ratio is simply @code{mean (T_f ./ T_f2)}. +## +## @end table +## +## The slope of the execution time graph shows the approximate +## power of the asymptotic running time @math{O(n^p)}. This +## power is plotted for the region over which it is approximated +## (the latter half of the graph). The estimated power is not +## very accurate, but should be sufficient to determine the +## general order of an algorithm. It should indicate if, for +## example, the implementation is unexpectedly @math{O(n^2)} +## rather than @math{O(n)} because it extends a vector each +## time through the loop rather than pre-allocating storage. +## In the current version of Octave, the following is not the +## expected @math{O(n)}. +## +## @example +## speed ("for i = 1:n, y@{i@} = x(i); endfor", "", [1000, 10000]) +## @end example +## +## @noindent +## But it is if you preallocate the cell array @code{y}: +## +## @example +## @group +## speed ("for i = 1:n, y@{i@} = x(i); endfor", ... +## "x = rand (n, 1); y = cell (size (x));", [1000, 10000]) +## @end group +## @end example +## +## An attempt is made to approximate the cost of individual +## operations, but it is wildly inaccurate. You can improve the +## stability somewhat by doing more work for each @code{n}. For +## example: +## +## @example +## speed ("airy(x)", "x = rand (n, 10)", [10000, 100000]) +## @end example +## +## When comparing two different expressions (@var{f}, @var{f2}), the slope +## of the line on the speedup ratio graph should be larger than 1 if the new +## expression is faster. Better algorithms have a shallow slope. Generally, +## vectorizing an algorithm will not change the slope of the execution +## time graph, but will shift it relative to the original. For +## example: +## +## @example +## @group +## speed ("sum (x)", "", [10000, 100000], ... +## "v = 0; for i = 1:length (x), v += x(i); endfor") +## @end group +## @end example +## +## The following is a more complex example. If there was an original version +## of @code{xcorr} using for loops and a second version using an FFT, then +## one could compare the run speed for various lags as follows, or for a fixed +## lag with varying vector lengths as follows: +## +## @example +## @group +## speed ("xcorr (x, n)", "x = rand (128, 1);", 100, +## "xcorr_orig (x, n)", -100*eps) +## speed ("xcorr (x, 15)", "x = rand (20+n, 1);", 100, +## "xcorr_orig (x, n)", -100*eps) +## @end group +## @end example +## +## Assuming one of the two versions is in xcorr_orig, this +## would compare their speed and their output values. Note that the +## FFT version is not exact, so one must specify an acceptable tolerance on +## the comparison @code{100*eps}. In this case, the comparison should be +## computed relatively, as @code{abs ((@var{x} - @var{y}) ./ @var{y})} rather +## than absolutely as @code{abs (@var{x} - @var{y})}. +## +## Type @kbd{example ("speed")} to see some real examples or +## @kbd{demo ("speed")} to run them. +## @end deftypefn + +## FIXME: consider two dimensional speedup surfaces for functions like kron. +function [__order, __test_n, __tnew, __torig] = speed (__f1, __init, __max_n = 100, __f2 = "", __tol = eps) + + if (nargin < 1 || nargin > 6) + print_usage (); + endif + + if (nargin < 2 || isempty (__init)) + __init = "x = randn (n, 1)"; + endif + + if (isempty (__max_n)) + __max_n = 100; + endif + + __numtests = 15; + + ## Let user specify range of n. + if (isscalar (__max_n)) + __min_n = 1; + assert (__max_n > __min_n); + __test_n = logspace (0, log10 (__max_n), __numtests); + elseif (length (__max_n) == 2) + [__min_n, __max_n] = deal (__max_n(1), __max_n(2)); + assert (__min_n >= 1); + assert (__max_n > __min_n); + __test_n = logspace (log10 (__min_n), log10 (__max_n), __numtests); + else + assert (all (__max_n > 0)); + __test_n = __max_n; + endif + ## Force n to be an integer. + __test_n = unique (round (__test_n)); + assert (__test_n >= 1); + + __torig = __tnew = zeros (size (__test_n)); + + ## Print and plot the data if no output is requested. + do_display = (nargout == 0); + + if (do_display) + disp (cstrcat ("testing ", __f1, "\ninit: ", __init)); + endif + + ## Add semicolon closure to all code fragments in case user has not done so. + __init = cstrcat (__init, ";"); + __f1 = cstrcat (__f1, ";"); + if (! isempty (__f2)) + __f2 = cstrcat (__f2, ";"); + endif + + ## Make sure the functions are freshly loaded by evaluating them at + ## test_n(1); first have to initialize the args though. + n = 1; + k = 0; + eval (__init); + eval (__f1); + if (! isempty (__f2)) + eval (__f2); + endif + + ## Run the tests. + for k = 1:length (__test_n) + n = __test_n(k); + eval (__init); + + if (do_display) + printf ("n%i = %i ", k, n); + fflush (stdout); + endif + + eval (cstrcat ("__t = time();", __f1, "__v1=ans; __t = time()-__t;")); + if (__t < 0.25) + eval (cstrcat ("__t2 = time();", __f1, "__t2 = time()-__t2;")); + eval (cstrcat ("__t3 = time();", __f1, "__t3 = time()-__t3;")); + __t = min ([__t, __t2, __t3]); + endif + __tnew(k) = __t; + + if (! isempty (__f2)) + eval (cstrcat ("__t = time();", __f2, "__v2=ans; __t = time()-__t;")); + if (__t < 0.25) + eval (cstrcat ("__t2 = time();", __f2, "__t2 = time()-__t2;")); + eval (cstrcat ("__t3 = time();", __f2, "__t3 = time()-__t3;")); + __t = min ([__t, __t2, __t3]); + endif + __torig(k) = __t; + if (! isinf(__tol)) + assert (__v1, __v2, __tol); + endif + endif + + endfor + + ## Drop times of zero. + if (isempty (__f2)) + zidx = (__tnew < 100*eps); + __test_n(zidx) = []; + __tnew(zidx) = []; + else + zidx = (__tnew < 100*eps | __torig < 100*eps); + __test_n(zidx) = []; + __tnew(zidx) = []; + __torig(zidx) = []; + endif + + if (isempty (__test_n)) + error (["speed: All running times were zero.\n", + "error: speed: Choose larger MAX_N or do more work per function evaluation"]); + endif + + ## Approximate time complexity and return it if requested. + tailidx = ceil (length (__test_n)/2):length (__test_n); + p = polyfit (log (__test_n(tailidx)), log (__tnew(tailidx)), 1); + if (nargout > 0) + __order.p = p(1); + __order.a = exp (p(2)); + endif + + if (do_display) + figure; + ## Strip semicolon added to code fragments before displaying + __init(end) = ""; + __f1(end) = ""; + if (! isempty (__f2)) + __f2(end) = ""; + endif + endif + + if (do_display && isempty (__f2)) + + loglog (__test_n, __tnew*1000, "*-g;execution time;"); + xlabel ("test length"); + ylabel ("best execution time (ms)"); + title ({__f1, cstrcat("init: ", __init)}); + + elseif (do_display) + + subplot (1, 2, 1); + semilogx (__test_n, __torig./__tnew, + cstrcat ("-*r;", strrep (__f1, ";", "."), " / ", + strrep (__f2, ";", "."), ";"), + __test_n, __tnew./__torig, + cstrcat ("-*g;", strrep (__f2, ";", "."), " / ", + strrep (__f1, ";", "."), ";")); + title ("Speedup Ratio"); + xlabel ("test length"); + ylabel ("speedup ratio"); + + subplot (1, 2, 2); + loglog (__test_n, __tnew*1000, + cstrcat ("*-g;", strrep (__f1, ";", "."), ";"), + __test_n, __torig*1000, + cstrcat ("*-r;", strrep (__f2,";","."), ";")); + title ({"Execution Times", cstrcat("init: ", __init)}); + xlabel ("test length"); + ylabel ("best execution time (ms)"); + + ratio = mean (__torig ./ __tnew); + printf ("\n\nMean runtime ratio = %.3g for '%s' vs '%s'\n", + ratio, __f2, __f1); + + endif + + if (do_display) + + ## Plot time complexity approximation (using milliseconds). + figure; # Open second plot window + + order = round (10*p(1))/10; + if (order >= 0.1) + order = sprintf ("O(n^%g)", order); + else + order = "O(1)"; + endif + v = polyval (p, log (__test_n(tailidx))); + + loglog (__test_n(tailidx), exp(v)*1000, sprintf ("b;%s;", order)); + title ({"Time Complexity", __f1}); + xlabel ("test length"); + + ## Get base time to 1 digit of accuracy. + dt = exp (p(2)); + dt = floor (dt/10^floor(log10(dt)))*10^floor(log10(dt)); + if (log10 (dt) >= -0.5) + time = sprintf ("%g s", dt); + elseif (log10 (dt) >= -3.5) + time = sprintf ("%g ms", dt*1e3); + elseif (log10 (dt) >= -6.5) + time = sprintf ("%g us", dt*1e6); + else + time = sprintf ("%g ns", dt*1e9); + endif + + ## Display nicely formatted complexity. + printf ("\nFor %s:\n", __f1); + printf (" asymptotic power: %s\n", order); + printf (" approximate time per operation: %s\n", time); + + endif + +endfunction + + +%% FIXME: Demos with declared functions do not work. See bug #31815. +%% A workaround has been hacked by not declaring the functions +%% but using eval to create them in the proper context. +%% Unfortunately, we can't remove them from the user's workspace +%% because of another bug (#34497). +%!demo +%! fstr_build_orig = cstrcat ( +%! "function x = build_orig (n)\n", +%! " ## extend the target vector on the fly\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); +%! fstr_build = cstrcat ( +%! "function x = build (n)\n", +%! " ## preallocate the target vector\n", +%! " x = zeros (1, n*100);\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); +%! +%! disp ("-----------------------"); +%! disp (fstr_build_orig); +%! disp ("-----------------------"); +%! disp (fstr_build); +%! disp ("-----------------------"); +%! +%! ## Eval functions strings to create them in the current context +%! eval (fstr_build_orig); +%! eval (fstr_build); +%! +%! disp ("Preallocated vector test.\nThis takes a little while..."); +%! speed("build (n)", "", 1000, "build_orig (n)"); +%! clear -f build build_orig +%! disp ("Note how much faster it is to pre-allocate a vector."); +%! disp ("Notice the peak speedup ratio."); + +%!demo +%! fstr_build_orig = cstrcat ( +%! "function x = build_orig (n)\n", +%! " for i=0:n-1, x([1:100]+i*100) = 1:100; endfor\n", +%! "endfunction"); +%! fstr_build = cstrcat ( +%! "function x = build (n)\n", +%! " idx = [1:100]';\n", +%! " x = idx(:,ones(1,n));\n", +%! " x = reshape (x, 1, n*100);\n", +%! "endfunction"); +%! +%! disp ("-----------------------"); +%! disp (fstr_build_orig); +%! disp ("-----------------------"); +%! disp (fstr_build); +%! disp ("-----------------------"); +%! +%! ## Eval functions strings to create them in the current context +%! eval (fstr_build_orig); +%! eval (fstr_build); +%! +%! disp ("Vectorized test.\nThis takes a little while..."); +%! speed("build (n)", "", 1000, "build_orig (n)"); +%! clear -f build build_orig +%! disp ("-----------------------"); +%! disp ("This time, the for loop is done away with entirely."); +%! disp ("Notice how much bigger the speedup is than in example 1."); + +%!test +%! [order, n, T_f1, T_f2] = speed ("airy (x)", "x = rand (n, 10)", [100, 1000]); +%! assert (isstruct (order)); +%! assert (size (order), [1, 1]); +%! assert (fieldnames (order), {"p"; "a"}); +%! assert (isnumeric (n)); +%! assert (length (n) > 10); +%! assert (isnumeric (T_f1)); +%! assert (size (T_f1), size (n)); +%! assert (isnumeric (T_f2)); +%! assert (length (T_f2) > 10); + +%% This test is known to fail on operating systems with low resolution timers such as MinGW +%!xtest +%! [order, n, T_f1, T_f2] = speed ("sum (x)", "", [100, 1000], "v = 0; for i = 1:length (x), v += x(i); endfor"); +%! assert (isstruct (order)); +%! assert (size (order), [1, 1]); +%! assert (fieldnames (order), {"p"; "a"}); +%! assert (isnumeric (n)); +%! assert (length (n) > 10); +%! assert (isnumeric (T_f1)); +%! assert (size (T_f1), size (n)); +%! assert (isnumeric (T_f2)); +%! assert (length (T_f2) > 10); + +%% Test input validation +%!error speed (); +%!error speed (1, 2, 3, 4, 5, 6, 7); + diff --git a/octave_packages/m/testfun/test.m b/octave_packages/m/testfun/test.m new file mode 100644 index 0000000..b22e31e --- /dev/null +++ b/octave_packages/m/testfun/test.m @@ -0,0 +1,840 @@ +## Copyright (C) 2005-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Command} {} test @var{name} +## @deftypefnx {Command} {} test @var{name} quiet|normal|verbose +## @deftypefnx {Function File} {} test ('@var{name}', 'quiet|normal|verbose', @var{fid}) +## @deftypefnx {Function File} {} test ([], 'explain', @var{fid}) +## @deftypefnx {Function File} {@var{success} =} test (@dots{}) +## @deftypefnx {Function File} {[@var{n}, @var{max}] =} test (@dots{}) +## @deftypefnx {Function File} {[@var{code}, @var{idx}] =} test ('@var{name}', 'grabdemo') +## +## Perform tests from the first file in the loadpath matching @var{name}. +## @code{test} can be called as a command or as a function. Called with +## a single argument @var{name}, the tests are run interactively and stop +## after the first error is encountered. +## +## With a second argument the tests which are performed and the amount of +## output is selected. +## +## @table @asis +## @item 'quiet' +## Don't report all the tests as they happen, just the errors. +## +## @item 'normal' +## Report all tests as they happen, but don't do tests which require +## user interaction. +## +## @item 'verbose' +## Do tests which require user interaction. +## @end table +## +## The argument @var{fid} can be used to allow batch processing. Errors +## can be written to the already open file defined by @var{fid}, and +## hopefully when Octave crashes this file will tell you what was happening +## when it did. You can use @code{stdout} if you want to see the results as +## they happen. You can also give a file name rather than an @var{fid}, in +## which case the contents of the file will be replaced with the log from +## the current test. +## +## Called with a single output argument @var{success}, @code{test} returns +## true if all of the tests were successful. Called with two output arguments +## @var{n} and @var{max}, the number of successful tests and the total number +## of tests in the file @var{name} are returned. +## +## If the second argument is the string 'grabdemo', the contents of the demo +## blocks are extracted but not executed. Code for all code blocks is +## concatenated and returned as @var{code} with @var{idx} being a vector of +## positions of the ends of the demo blocks. +## +## If the second argument is 'explain', then @var{name} is ignored and an +## explanation of the line markers used is written to the file @var{fid}. +## @seealso{assert, fail, error, demo, example} +## @end deftypefn + +## FIXME: * Consider using keyword fail rather then error? This allows us +## to make a functional form of error blocks, which means we +## can include them in test sections which means that we can use +## octave flow control for both kinds of tests. + +function [__ret1, __ret2, __ret3, __ret4] = test (__name, __flag, __fid) + ## Information from test will be introduced by "key". + persistent __signal_fail = "!!!!! "; + persistent __signal_empty = "????? "; + persistent __signal_block = " ***** "; + persistent __signal_file = ">>>>> "; + persistent __signal_skip = "----- "; + + __xfail = 0; + __xskip = 0; + + if (nargin < 2 || isempty (__flag)) + __flag = "quiet"; + endif + if (nargin < 3) + __fid = []; + endif + if (nargin < 1 || nargin > 3 + || (! ischar (__name) && ! isempty (__name)) || ! ischar (__flag)) + print_usage (); + endif + if (isempty (__name) && (nargin != 3 || ! strcmp (__flag, "explain"))) + print_usage (); + endif + __batch = (! isempty (__fid)); + + ## Decide if error messages should be collected. + __close_fid = 0; + if (__batch) + if (ischar (__fid)) + __fid = fopen (__fid, "wt"); + if (__fid < 0) + error ("test: could not open log file"); + endif + __close_fid = 1; + endif + fprintf (__fid, "%sprocessing %s\n", __signal_file, __name); + fflush (__fid); + else + __fid = stdout; + endif + + if (strcmp (__flag, "normal")) + __grabdemo = 0; + __rundemo = 0; + __verbose = __batch; + elseif (strcmp (__flag, "quiet")) + __grabdemo = 0; + __rundemo = 0; + __verbose = 0; + elseif (strcmp (__flag, "verbose")) + __grabdemo = 0; + __rundemo = 1; + __verbose = 1; + elseif (strcmp (__flag, "grabdemo")) + __grabdemo = 1; + __rundemo = 0; + __verbose = 0; + __demo_code = ""; + __demo_idx = []; + elseif (strcmp (__flag, "explain")) + fprintf (__fid, "# %s new test file\n", __signal_file); + fprintf (__fid, "# %s no tests in file\n", __signal_empty); + fprintf (__fid, "# %s test had an unexpected result\n", __signal_fail); + fprintf (__fid, "# %s code for the test\n", __signal_block); + fprintf (__fid, "# Search for the unexpected results in the file\n"); + fprintf (__fid, "# then page back to find the file name which caused it.\n"); + fprintf (__fid, "# The result may be an unexpected failure (in which\n"); + fprintf (__fid, "# case an error will be reported) or an unexpected\n"); + fprintf (__fid, "# success (in which case no error will be reported).\n"); + fflush (__fid); + if (__close_fid) + fclose(__fid); + endif + return; + else + error ("test: unknown flag '%s'", __flag); + endif + + ## Locate the file to test. + __file = file_in_loadpath (__name, "all"); + if (isempty (__file)) + __file = file_in_loadpath (cstrcat (__name, ".m"), "all"); + endif + if (isempty (__file)) + __file = file_in_loadpath (cstrcat (__name, ".cc"), "all"); + endif + if (iscell (__file)) + ## If repeats, return first in path. + if (isempty (__file)) + __file = ""; + else + __file = __file{1}; + endif + endif + if (isempty (__file)) + if (__grabdemo) + __ret1 = ""; + __ret2 = []; + else + if (exist (__name) == 3) + fprintf (__fid, "%s%s source code with tests for dynamically linked function not found\n", __signal_empty, __name); + else + fprintf (__fid, "%s%s does not exist in path\n", __signal_empty, __name); + endif + fflush (__fid); + if (nargout > 0) + __ret1 = __ret2 = 0; + endif + endif + if (__close_fid) + fclose(__fid); + endif + return; + endif + + ## Grab the test code from the file. + __body = __extract_test_code (__file); + + if (isempty (__body)) + if (__grabdemo) + __ret1 = ""; + __ret2 = []; + else + fprintf (__fid, "%s%s has no tests available\n", __signal_empty, __file); + fflush (__fid); + if (nargout > 0) + __ret1 = __ret2 = 0; + endif + endif + if (__close_fid) + fclose(__fid); + endif + return; + else + ## Add a dummy comment block to the end for ease of indexing. + if (__body (length(__body)) == "\n") + __body = sprintf ("\n%s#", __body); + else + __body = sprintf ("\n%s\n#", __body); + endif + endif + + ## Chop it up into blocks for evaluation. + __lineidx = find (__body == "\n"); + __blockidx = __lineidx(find (! isspace (__body(__lineidx+1))))+1; + + ## Ready to start tests ... if in batch mode, tell us what is happening. + if (__verbose) + disp (cstrcat (__signal_file, __file)); + endif + + ## Assume all tests will pass. + __all_success = 1; + + ## Process each block separately, initially with no shared variables. + __tests = __successes = 0; + __shared = " "; + __shared_r = " "; + __clear = ""; + for __i = 1:length(__blockidx)-1 + + ## Extract the block. + __block = __body(__blockidx(__i):__blockidx(__i+1)-2); + + ## Let the user/logfile know what is happening. + if (__verbose) + fprintf (__fid, "%s%s\n", __signal_block, __block); + fflush (__fid); + endif + + ## Split __block into __type and __code. + __idx = find (! isletter (__block)); + if (isempty (__idx)) + __type = __block; + __code = ""; + else + __type = __block(1:__idx(1)-1); + __code = __block(__idx(1):length(__block)); + endif + + ## Assume the block will succeed. + __success = 1; + __msg = []; + +### DEMO + + ## If in __grabdemo mode, then don't process any other block type. + ## So that the other block types don't have to worry about + ## this __grabdemo mode, the demo block processor grabs all block + ## types and skips those which aren't demo blocks. + + __isdemo = strcmp (__type, "demo"); + if (__grabdemo || __isdemo) + __istest = 0; + + if (__grabdemo && __isdemo) + if (isempty(__demo_code)) + __demo_code = __code; + __demo_idx = [1, length(__demo_code)+1]; + else + __demo_code = cstrcat(__demo_code, __code); + __demo_idx = [__demo_idx, length(__demo_code)+1]; + endif + + elseif (__rundemo && __isdemo) + try + ## process the code in an environment without variables + eval (sprintf ("function __test__()\n%s\nendfunction", __code)); + __test__; + input ("Press to continue: ", "s"); + catch + __success = 0; + __msg = sprintf ("%sdemo failed\n%s", __signal_fail, lasterr ()); + end_try_catch + clear __test__; + + endif + ## Code already processed. + __code = ""; + +### SHARED + + elseif (strcmp (__type, "shared")) + __istest = 0; + + ## Separate initialization code from variables. + __idx = find (__code == "\n"); + if (isempty (__idx)) + __vars = __code; + __code = ""; + else + __vars = __code (1:__idx(1)-1); + __code = __code (__idx(1):length(__code)); + endif + + ## Strip comments off the variables. + __idx = find (__vars == "%" | __vars == "#"); + if (! isempty (__idx)) + __vars = __vars(1:__idx(1)-1); + endif + + ## Assign default values to variables. + try + __vars = deblank (__vars); + if (! isempty (__vars)) + eval (cstrcat (strrep (__vars, ",", "=[];"), "=[];")); + __shared = __vars; + __shared_r = cstrcat ("[ ", __vars, "] = "); + else + __shared = " "; + __shared_r = " "; + endif + catch + ## Couldn't declare, so don't initialize. + __code = ""; + __success = 0; + __msg = sprintf ("%sshared variable initialization failed\n", + __signal_fail); + end_try_catch + + ## Clear shared function definitions. + eval (__clear, ""); + __clear = ""; + + ## Initialization code will be evaluated below. + +### FUNCTION + + elseif (strcmp (__type, "function")) + __istest = 0; + persistent __fn = 0; + __name_position = function_name (__block); + if (isempty (__name_position)) + __success = 0; + __msg = sprintf ("%stest failed: missing function name\n", + __signal_fail); + else + __name = __block(__name_position(1):__name_position(2)); + __code = __block; + try + eval(__code); ## Define the function + __clear = sprintf ("%sclear %s;\n", __clear, __name); + catch + __success = 0; + __msg = sprintf ("%stest failed: syntax error\n%s", + __signal_fail, lasterr ()); + end_try_catch + endif + __code = ""; + +### ENDFUNCTION + + elseif (strcmp (__type, "endfunction")) + ## endfunction simply declares the end of a previous function block. + ## There is no processing to be done here, just skip to next block. + __istest = 0; + __code = ""; + +### ASSERT/FAIL + + elseif (strcmp (__type, "assert") || strcmp (__type, "fail")) + __istest = 1; + ## Put the keyword back on the code. + __code = __block; + ## The code will be evaluated below as a test block. + +### ERROR/WARNING + + elseif (strcmp (__type, "error") || strcmp(__type, "warning")) + __istest = 1; + __warning = strcmp (__type, "warning"); + [__pattern, __id, __code] = getpattern (__code); + if (__id) + __patstr = ["id=",__id]; + else + __patstr = ["<",__pattern,">"]; + endif + try + eval (sprintf ("function __test__(%s)\n%s\nendfunction", + __shared, __code)); + catch + __success = 0; + __msg = sprintf ("%stest failed: syntax error\n%s", + __signal_fail, lasterr ()); + end_try_catch + + if (__success) + __success = 0; + __warnstate = warning ("query", "quiet"); + warning ("on", "quiet"); + try + eval (sprintf ("__test__(%s);", __shared)); + if (! __warning) + __msg = sprintf ("%sexpected %s but got no error\n", + __signal_fail, __patstr); + else + if (! isempty (__id)) + [~, __err] = lastwarn; + __mismatch = ! strcmp (__err, __id); + else + __err = trimerr (lastwarn, "warning"); + __mismatch = isempty (regexp (__err, __pattern, "once")); + endif + warning (__warnstate.state, "quiet"); + if (isempty (__err)) + __msg = sprintf ("%sexpected %s but got no warning\n", + __signal_fail, __patstr); + elseif (__mismatch) + __msg = sprintf ("%sexpected %s but got %s\n", + __signal_fail, __patstr, __err); + else + __success = 1; + endif + endif + + catch + if (! isempty (__id)) + [~, __err] = lasterr; + __mismatch = ! strcmp (__err, __id); + else + __err = trimerr (lasterr, "error"); + __mismatch = isempty (regexp (__err, __pattern, "once")); + endif + warning (__warnstate.state, "quiet"); + if (__warning) + __msg = sprintf ("%sexpected warning %s but got error %s\n", + __signal_fail, __patstr, __err); + elseif (__mismatch) + __msg = sprintf ("%sexpected %s but got %s\n", + __signal_fail, __patstr, __err); + else + __success = 1; + endif + end_try_catch + clear __test__; + endif + ## Code already processed. + __code = ""; + +### TESTIF + + elseif (strcmp (__type, "testif")) + __e = regexp (__code, '.$', 'lineanchors', 'once'); + ## Strip comment any comment from testif line before looking for features + __feat_line = strtok (__code(1:__e), '#%'); + __feat = regexp (__feat_line, '\w+', 'match'); + __have_feat = strfind (octave_config_info ("DEFS"), __feat); + if (any (cellfun ("isempty", __have_feat))) + __xskip++; + __istest = 0; + __code = ""; # Skip the code. + __msg = sprintf ("%sskipped test\n", __signal_skip); + else + __istest = 1; + __code = __code(__e + 1 : end); + endif + +### TEST + + elseif (strcmp (__type, "test") || strcmp (__type, "xtest")) + __istest = 1; + ## Code will be evaluated below. + +### Comment block. + + elseif (strcmp (__block(1:1), "#")) + __istest = 0; + __code = ""; # skip the code + +### Unknown block. + + else + __istest = 1; + __success = 0; + __msg = sprintf ("%sunknown test type!\n", __signal_fail); + __code = ""; # skip the code + endif + + ## evaluate code for test, shared, and assert. + if (! isempty(__code)) + try + ## FIXME: need to check for embedded test functions, which cause + ## segfaults, until issues with subfunctions in functions are resolved. + embed_func = regexp (__code, '^\s*function ', 'once', 'lineanchors'); + if (isempty (embed_func)) + eval (sprintf ("function %s__test__(%s)\n%s\nendfunction", + __shared_r,__shared, __code)); + eval (sprintf ("%s__test__(%s);", __shared_r, __shared)); + else + error (["Functions embedded in %!test blocks are not allowed.\n", ... + "Use the %!function/%!endfunction syntax instead to define shared functions for testing.\n"]); + endif + catch + if (strcmp (__type, "xtest")) + __msg = sprintf ("%sknown failure\n%s", __signal_fail, lasterr ()); + __xfail++; + else + __msg = sprintf ("%stest failed\n%s", __signal_fail, lasterr ()); + __success = 0; + endif + if (isempty (lasterr ())) + error ("empty error text, probably Ctrl-C --- aborting"); + endif + end_try_catch + clear __test__; + endif + + ## All done. Remember if we were successful and print any messages. + if (! isempty (__msg)) + ## Make sure the user knows what caused the error. + if (! __verbose) + fprintf (__fid, "%s%s\n", __signal_block, __block); + fflush (__fid); + endif + fputs (__fid, __msg); + fputs (__fid, "\n"); + fflush (__fid); + ## Show the variable context. + if (! strcmp (__type, "error") && ! strcmp (__type, "testif") + && ! all (__shared == " ")) + fputs (__fid, "shared variables "); + eval (sprintf ("fdisp(__fid,bundle(%s));", __shared)); + fflush (__fid); + endif + endif + if (__success == 0) + __all_success = 0; + ## Stop after one error if not in batch mode. + if (! __batch) + if (nargout > 0) + __ret1 = __ret2 = 0; + endif + if (__close_fid) + fclose(__fid); + endif + return; + endif + endif + __tests += __istest; + __successes += __success * __istest; + endfor + eval (__clear, ""); + + if (nargout == 0) + if (__tests || __xfail || __xskip) + if (__xfail) + printf ("PASSES %d out of %d tests (%d expected failures)\n", + __successes, __tests, __xfail); + else + printf ("PASSES %d out of %d tests\n", __successes, __tests); + endif + if (__xskip) + printf ("Skipped %d tests due to missing features\n", __xskip); + endif + else + printf ("%s%s has no tests available\n", __signal_empty, __file); + endif + elseif (__grabdemo) + __ret1 = __demo_code; + __ret2 = __demo_idx; + elseif (nargout == 1) + __ret1 = __all_success; + else + __ret1 = __successes; + __ret2 = __tests; + __ret3 = __xfail; + __ret4 = __xskip; + endif +endfunction + +## Create structure with fieldnames the name of the input variables. +function s = varstruct (varargin) + for i = 1:nargin + s.(deblank (argn(i,:))) = varargin{i}; + endfor +endfunction + +## Find [start,end] of fn in 'function [a,b] = fn'. +function pos = function_name (def) + pos = []; + + ## Find the end of the name. + right = find (def == "(", 1); + if (isempty (right)) + return; + endif + right = find (def(1:right-1) != " ", 1, "last"); + + ## Find the beginning of the name. + left = max ([find(def(1:right)==" ", 1, "last"), ... + find(def(1:right)=="=", 1, "last")]); + if (isempty (left)) + return; + endif + left++; + + ## Return the end points of the name. + pos = [left, right]; +endfunction + +## Strip from ' code'. +## Also handles 'id=ID code' +function [pattern, id, rest] = getpattern (str) + pattern = "."; + id = []; + rest = str; + str = trimleft (str); + if (! isempty (str) && str(1) == "<") + close = index (str, ">"); + if (close) + pattern = str(2:close-1); + rest = str(close+1:end); + endif + elseif (strncmp (str, "id=", 3)) + [id, rest] = strtok (str(4:end)); + endif +endfunction + +## Strip '.*prefix:' from '.*prefix: msg\n' and strip trailing blanks. +function msg = trimerr (msg, prefix) + idx = index (msg, cstrcat (prefix, ":")); + if (idx > 0) + msg(1:idx+length(prefix)) = []; + endif + msg = trimleft (deblank (msg)); +endfunction + +## Strip leading blanks from string. +function str = trimleft (str) + idx = find (isspace (str)); + leading = find (idx == 1:length(idx)); + if (! isempty (leading)) + str = str(leading(end)+1:end); + endif +endfunction + +## Make a structure out of the named variables +## (based on Etienne Grossmann's tar function). +function s = bundle (varargin) + for i = 1:nargin + s.(deblank (argn(i,:))) = varargin{i}; + endfor +endfunction + +function body = __extract_test_code (nm) + fid = fopen (nm, "rt"); + body = []; + if (fid >= 0) + while (! feof (fid)) + ln = fgetl (fid); + if (length (ln) >= 2 && strcmp (ln(1:2), "%!")) + body = [body, "\n"]; + if (length(ln) > 2) + body = cstrcat (body, ln(3:end)); + endif + endif + endwhile + fclose (fid); + endif +endfunction + +### Test for test for missing features +%!testif OCTAVE_SOURCE +%! ## This test should be run +%! assert (true); + +### Disable this test to avoid spurious skipped test for "make check" +% !testif HAVE_FOOBAR +% ! ## missing feature. Fail if this test is run +% ! error("Failed missing feature test"); + +### Test for a known failure +%!xtest error("This test is known to fail") + +### example from toeplitz +%!shared msg1,msg2 +%! msg1="C must be a vector"; +%! msg2="C and R must be vectors"; +%!fail ('toeplitz([])', msg1); +%!fail ('toeplitz([1,2;3,4])', msg1); +%!fail ('toeplitz([1,2],[])', msg2); +%!fail ('toeplitz([1,2],[1,2;3,4])', msg2); +%!fail ('toeplitz ([1,2;3,4],[1,2])', msg2); +% !fail ('toeplitz','usage: toeplitz'); # usage doesn't generate an error +% !fail ('toeplitz(1, 2, 3)', 'usage: toeplitz'); +%!test assert (toeplitz ([1,2,3], [1,4]), [1,4; 2,1; 3,2]); +%!demo toeplitz ([1,2,3,4],[1,5,6]) + +### example from kron +%!#error kron # FIXME suppress these until we can handle output +%!#error kron(1,2,3) +%!test assert (isempty (kron ([], rand(3, 4)))) +%!test assert (isempty (kron (rand (3, 4), []))) +%!test assert (isempty (kron ([], []))) +%!shared A, B +%!test +%! A = [1, 2, 3; 4, 5, 6]; +%! B = [1, -1; 2, -2]; +%!assert (size (kron (zeros (3, 0), A)), [ 3*rows(A), 0 ]) +%!assert (size (kron (zeros (0, 3), A)), [ 0, 3*columns(A) ]) +%!assert (size (kron (A, zeros (3, 0))), [ 3*rows(A), 0 ]) +%!assert (size (kron (A, zeros (0, 3))), [ 0, 3*columns(A) ]) +%!assert (kron (pi, e), pi*e) +%!assert (kron (pi, A), pi*A) +%!assert (kron (A, e), e*A) +%!assert (kron ([1, 2, 3], A), [ A, 2*A, 3*A ]) +%!assert (kron ([1; 2; 3], A), [ A; 2*A; 3*A ]) +%!assert (kron ([1, 2; 3, 4], A), [ A, 2*A; 3*A, 4*A ]) +%!test +%! res = [1,-1,2,-2,3,-3; 2,-2,4,-4,6,-6; 4,-4,5,-5,6,-6; 8,-8,10,-10,12,-12]; +%! assert (kron (A, B), res) + +### an extended demo from specgram +%!#demo +%! ## Speech spectrogram +%! [x, Fs] = auload(file_in_loadpath("sample.wav")); # audio file +%! step = fix(5*Fs/1000); # one spectral slice every 5 ms +%! window = fix(40*Fs/1000); # 40 ms data window +%! fftn = 2^nextpow2(window); # next highest power of 2 +%! [S, f, t] = specgram(x, fftn, Fs, window, window-step); +%! S = abs(S(2:fftn*4000/Fs,:)); # magnitude in range 0 test("test", 'bogus'); # incorrect args, generates error() +%!error garbage # usage on nonexistent function should be + +%!error test("test", 'bogus'); # test without pattern + +%!test +%! lastwarn(); # clear last warning just in case + +%!warning warning('warning message'); + +%!## test of shared variables +%!shared a # create a shared variable +%!test a=3; # assign to a shared variable +%!test assert(a,3) # variable should equal 3 +%!shared b,c # replace shared variables +%!test assert (!exist("a")); # a no longer exists +%!test assert (isempty(b)); # variables start off empty +%!shared a,b,c # recreate a shared variable +%!test assert (isempty(a)); # value is empty even if it had a previous value +%!test a=1; b=2; c=3; # give values to all variables +%!test assert ([a,b,c],[1,2,3]); # test all of them together +%!test c=6; # update a value +%!test assert([a, b, c],[1, 2, 6]); # show that the update sticks +%!shared # clear all shared variables +%!test assert(!exist("a")) # show that they are cleared +%!shared a,b,c # support for initializer shorthand +%! a=1; b=2; c=4; + +%!function x = __test_a(y) +%! x = 2*y; +%!endfunction +%!assert(__test_a(2),4); # Test a test function + +%!function __test_a (y) +%! x = 2*y; +%!endfunction +%!test +%! __test_a(2); # Test a test function with no return value + +%!function [x,z] = __test_a (y) +%! x = 2*y; +%! z = 3*y; +%!endfunction +%!test # Test a test function with multiple returns +%! [x,z] = __test_a(3); +%! assert(x,6); +%! assert(z,9); + +%!## test of assert block +%!assert (isempty([])) # support for test assert shorthand + +%!## demo blocks +%!demo # multiline demo block +%! t=[0:0.01:2*pi]; x=sin(t); +%! plot(t,x); +%! % you should now see a sine wave in your figure window +%!demo a=3 # single line demo blocks work too + +%!## this is a comment block. it can contain anything. +%!## +%! it is the "#" as the block type that makes it a comment +%! and it stays as a comment even through continuation lines +%! which means that it works well with commenting out whole tests + +% !# failure tests. All the following should fail. These tests should +% !# be disabled unless you are developing test() since users don't +% !# like to be presented with expected failures. I use % ! to disable. +% !test error("---------Failure tests. Use test('test','verbose',1)"); +% !test assert([a,b,c],[1,3,6]); # variables have wrong values +% !bogus # unknown block type +% !error toeplitz([1,2,3]); # correct usage +% !test syntax errors) # syntax errors fail properly +% !shared garbage in # variables must be comma separated +% !error syntax++error # error test fails on syntax errors +% !error "succeeds."; # error test fails if code succeeds +% !error error("message") # error pattern must match +% !demo with syntax error # syntax errors in demo fail properly +% !shared a,b,c +% !demo # shared variables not available in demo +% ! assert(exist("a")) +% !error +% ! test('/etc/passwd'); +% ! test("nonexistent file"); +% ! ## These don't signal an error, so the test for an error fails. Note +% ! ## that the call doesn't reference the current fid (it is unavailable), +% ! ## so of course the informational message is not printed in the log. diff --git a/octave_packages/m/time/addtodate.m b/octave_packages/m/time/addtodate.m new file mode 100644 index 0000000..4264371 --- /dev/null +++ b/octave_packages/m/time/addtodate.m @@ -0,0 +1,125 @@ +## Copyright (C) 2008-2012 Bill Denney +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{d} =} addtodate (@var{d}, @var{q}, @var{f}) +## Add @var{q} amount of time (with units @var{f}) to the serial datenum, +## @var{d}. +## +## @var{f} must be one of "year", "month", "day", "hour", "minute", "second", +## or "millisecond". +## @seealso{datenum, datevec, etime} +## @end deftypefn + +## Author: Bill Denney + +function d = addtodate (d, q, f) + + persistent mult = struct ("day", 1, "hour", 1/24, "minute", 1/1440, ... + "second", 1/86400, "millisecond", 1/86400000); + + if (nargin != 3) + print_usage (); + elseif (! (ischar (f) && isrow (f))) + error ("addtodate: F must be a single character string"); + endif + + if (isscalar (d) && ! isscalar (q)) + ## expand d to size of q to make later addition easier. + d = repmat (d, size (q)); + endif + + ## in case the user gives f as a plural, remove the 's' + if ("s" == f(end)) + f(end) = []; + endif + + if (any (strcmpi ({"year" "month"}, f))) + dtmp = datevec (d); + if (strcmpi ("year", f)) + dtmp(:,1) += q(:); + elseif (strcmpi ("month", f)) + dtmp(:,2) += q(:); + ## adjust the years and months if the date rolls over a year + dtmp(:,1) += floor ((dtmp(:,2)-1)/12); + dtmp(:,2) = mod (dtmp(:,2)-1, 12) + 1; + endif + dnew = datenum (dtmp); + ## make the output the right shape + if (numel (d) == numel (dnew)) + d = reshape (dnew, size (d)); + else + d = reshape (dnew, size (q)); + endif + elseif (any (strcmpi ({"day" "hour" "minute" "second", "millisecond"}, f))) + d += q .* mult.(f); + else + error ("addtodate: Invalid time unit: %s", f); + endif + +endfunction + + +## tests +%!shared d +%! d = datenum (2008, 1, 1); +## Identity +%!assert (addtodate (d, 0, "year"), d) +%!assert (addtodate (d, 0, "month"), d) +%!assert (addtodate (d, 0, "day"), d) +%!assert (addtodate (d, 0, "hour"), d) +%!assert (addtodate (d, 0, "minute"), d) +%!assert (addtodate (d, 0, "second"), d) +%!assert (addtodate (d, 0, "millisecond"), d) +## Add one of each +## leap year +%!assert (addtodate (d, 1, "year"), d+366) +%!assert (addtodate (d, 1, "month"), d+31) +%!assert (addtodate (d, 1, "day"), d+1) +%!assert (addtodate (d, 1, "hour"), d+1/24) +%!assert (addtodate (d, 1, "minute"), d+1/1440) +%!assert (addtodate (d, 1, "second"), d+1/86400) +%!assert (addtodate (d, 1, "millisecond"), d+1/86400000) +## substract one of each +%!assert (addtodate (d, -1, "year"), d-365) +%!assert (addtodate (d, -1, "month"), d-31) +%!assert (addtodate (d, -1, "day"), d-1) +%!assert (addtodate (d, -1, "hour"), d-1/24) +%!assert (addtodate (d, -1, "minute"), d-1/1440) +%!assert (addtodate (d, -1, "second"), d-1/86400) +%!assert (addtodate (d, -1, "millisecond"), d-1/86400000) +## rollover +%!assert (addtodate (d, 12, "month"), d+366) +%!assert (addtodate (d, 13, "month"), d+366+31) +## multiple inputs and output orientation +%!assert (addtodate ([d d], [1 13], "month"), [d+31 d+366+31]) +%!assert (addtodate ([d;d], [1;13], "month"), [d+31;d+366+31]) +%!assert (addtodate (d, [1;13], "month"), [d+31;d+366+31]) +%!assert (addtodate (d, [1 13], "month"), [d+31 d+366+31]) +%!assert (addtodate ([d;d+1], 1, "month"), [d+31;d+1+31]) +%!assert (addtodate ([d d+1], 1, "month"), [d+31 d+1+31]) + +%% Test input validation +%!error addtodate () +%!error addtodate (1) +%!error addtodate (1,2) +%!error addtodate (1,2,3,4) +%!error addtodate (1,2,3) +%!error addtodate (1,2,"month"') +%!error addtodate (1,2,"abc") + diff --git a/octave_packages/m/time/asctime.m b/octave_packages/m/time/asctime.m new file mode 100644 index 0000000..468e865 --- /dev/null +++ b/octave_packages/m/time/asctime.m @@ -0,0 +1,54 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} asctime (@var{tm_struct}) +## Convert a time structure to a string using the following +## format: "ddd mmm mm HH:MM:SS yyyy". For example: +## +## @example +## @group +## asctime (localtime (time ())) +## @result{} "Mon Feb 17 01:15:06 1997" +## @end group +## @end example +## +## This is equivalent to @code{ctime (time ())}. +## @seealso{ctime, localtime, time} +## @end deftypefn + +## Author: jwe + +function retval = asctime (tm_struct) + + if (nargin != 1) + print_usage (); + endif + + retval = strftime ("%a %b %d %H:%M:%S %Y\n", tm_struct); + +endfunction + + +%!test +%! t = time (); +%! assert(strcmp (asctime (localtime (t)), ctime (t))); + +%!error asctime (); +%!error asctime (1, 2); + diff --git a/octave_packages/m/time/calendar.m b/octave_packages/m/time/calendar.m new file mode 100644 index 0000000..a78451e --- /dev/null +++ b/octave_packages/m/time/calendar.m @@ -0,0 +1,104 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{c} =} calendar () +## @deftypefnx {Function File} {@var{c} =} calendar (@var{d}) +## @deftypefnx {Function File} {@var{c} =} calendar (@var{y}, @var{m}) +## @deftypefnx {Function File} {} calendar (@dots{}) +## Return the current monthly calendar in a 6x7 matrix. +## +## If @var{d} is specified, return the calendar for the month containing +## the date @var{d}, which must be a serial date number or a date string. +## +## If @var{y} and @var{m} are specified, return the calendar for year @var{y} +## and month @var{m}. +## +## If no output arguments are specified, print the calendar on the screen +## instead of returning a matrix. +## @seealso{datenum, datestr} +## @end deftypefn + +## Author: pkienzle +## Created: 25 July 2004 +## Adapted-By: William Poetra Yoga Hadisoeseno + +function varargout = calendar (varargin) + + switch (nargin) + case 0 + v = clock (); + y = v(1); + m = v(2); + d = v(3); + case 1 + v = datevec (varargin{1}); + y = v(1); + m = v(2); + d = v(3); + case 2 + y = varargin{1}; + m = varargin{2}; + d = []; + otherwise + print_usage (); + endswitch + + c = zeros (7, 6); + dayone = datenum (y, m, 1); + ndays = eomday (y, m); + c(weekday (dayone) - 1 + [1:ndays]) = 1:ndays; + + if (nargout > 0) + varargout{1} = c'; + else + ## Layout the calendar days, 6 columns per day, 7 days per row. + str = sprintf (" %2d %2d %2d %2d %2d %2d %2d\n", c); + + ## Print an asterisk before the specified date + if (! isempty (d)) + pos = weekday (dayone) + d - 1; + idx = 6*pos + fix (pos / 7.1) - ifelse (d < 10, 1, 2); + str(idx) = "*"; + endif + + ## Display the calendar. + s.year = y - 1900; + s.mon = m - 1; + puts (strftime (" %b %Y\n", s)); + puts (" S M Tu W Th F S\n"); + puts (str); + endif + +endfunction + + +## demos +%!demo +%! ## Calendar for current month +%! calendar () +%!demo +%! calendar (1957, 10) + +## tests +%!assert ((calendar(2000,2))'(2:31), [0:29]) +%!assert ((calendar(1957,10))'(2:33), [0:31]) + +%% Test input validation +%!error calendar (1,2,3) + diff --git a/octave_packages/m/time/clock.m b/octave_packages/m/time/clock.m new file mode 100644 index 0000000..22e89e7 --- /dev/null +++ b/octave_packages/m/time/clock.m @@ -0,0 +1,61 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} clock () +## Return the current local date and time as a date vector. The date vector +## contains the following fields: current year, month (1-12), day (1-31), +## hour (0-23), minute (0-59), and second (0-61). The seconds field has +## a fractional part after the decimal point for extended accuracy. +## +## For example: +## +## @example +## @group +## fix (clock ()) +## @result{} [ 1993, 8, 20, 4, 56, 1 ] +## @end group +## @end example +## +## The function clock is more accurate on systems that have the +## @code{gettimeofday} function. +## @seealso{now, date, datevec} +## @end deftypefn + +## Author: jwe + +function retval = clock () + + tm = localtime (time ()); + + retval = zeros (1, 6); + + retval(1) = tm.year + 1900; + retval(2) = tm.mon + 1; + retval(3) = tm.mday; + retval(4) = tm.hour; + retval(5) = tm.min; + retval(6) = tm.sec + tm.usec / 1e6; + +endfunction + +%!test +%! t1 = clock; +%! t2 = str2num (strftime ("[%Y, %m, %d, %H, %M, %S]", localtime (time ()))); +%! assert(etime (t1, t2) < 1); + diff --git a/octave_packages/m/time/ctime.m b/octave_packages/m/time/ctime.m new file mode 100644 index 0000000..51f6010 --- /dev/null +++ b/octave_packages/m/time/ctime.m @@ -0,0 +1,54 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} ctime (@var{t}) +## Convert a value returned from @code{time} (or any other non-negative +## integer), to the local time and return a string of the same form as +## @code{asctime}. The function @code{ctime (time)} is equivalent to +## @code{asctime (localtime (time))}. For example: +## +## @example +## @group +## ctime (time ()) +## @result{} "Mon Feb 17 01:15:06 1997" +## @end group +## @end example +## @seealso{asctime, time, localtime} +## @end deftypefn + +## Author: jwe + +function retval = ctime (t) + + if (nargin != 1) + print_usage (); + endif + + retval = asctime (localtime (t)); + +endfunction + + +%!test +%! t = time (); +%! assert(strcmp (asctime (localtime (t)), ctime (t))); + +%!error ctime (); +%!error ctime (1, 2); + diff --git a/octave_packages/m/time/date.m b/octave_packages/m/time/date.m new file mode 100644 index 0000000..c1354e7 --- /dev/null +++ b/octave_packages/m/time/date.m @@ -0,0 +1,43 @@ +## Copyright (C) 1995-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} date () +## Return the current date as a character string in the form DD-MMM-YYYY@. +## +## For example: +## +## @example +## @group +## date () +## @result{} "20-Aug-1993" +## @end group +## @end example +## @seealso{now, clock, datestr, localtime} +## @end deftypefn + +## Author: jwe + +function retval = date () + + retval = strftime ("%d-%b-%Y", localtime (time ())); + +endfunction + +%!assert(strcmp (date (), strftime ("%d-%b-%Y", localtime (time ())))); + diff --git a/octave_packages/m/time/datenum.m b/octave_packages/m/time/datenum.m new file mode 100644 index 0000000..c50f3c0 --- /dev/null +++ b/octave_packages/m/time/datenum.m @@ -0,0 +1,185 @@ +## Copyright (C) 2006-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{days} =} datenum (@var{datevec}) +## @deftypefnx {Function File} {@var{days} =} datenum (@var{year}, @var{month}, @var{day}) +## @deftypefnx {Function File} {@var{days} =} datenum (@var{year}, @var{month}, @var{day}, @var{hour}) +## @deftypefnx {Function File} {@var{days} =} datenum (@var{year}, @var{month}, @var{day}, @var{hour}, @var{minute}) +## @deftypefnx {Function File} {@var{days} =} datenum (@var{year}, @var{month}, @var{day}, @var{hour}, @var{minute}, @var{second}) +## @deftypefnx {Function File} {@var{days} =} datenum ("datestr") +## @deftypefnx {Function File} {@var{days} =} datenum ("datestr", @var{p}) +## @deftypefnx {Function File} {[@var{days}, @var{secs}] =} datenum (@dots{}) +## Return the date/time input as a serial day number, with Jan 1, 0000 +## defined as day 1. +## +## The integer part, @code{floor (@var{days})} counts the number of +## complete days in the date input. +## +## The fractional part, @code{rem (@var{days}, 1)} corresponds to the time +## on the given day. +## +## The input may be a date vector (see @code{datevec}), +## datestr (see @code{datestr}), or directly specified as input. +## +## When processing input datestrings, @var{p} is the year at the start of the +## century to which two-digit years will be referenced. If not specified, it +## defaults to the current year minus 50. +## +## The optional output @var{secs} holds the time on the specified day with +## greater precision than @var{days}. +## +## Notes: +## +## @itemize +## @item +## Years can be negative and/or fractional. +## +## @item +## Months below 1 are considered to be January. +## +## @item +## Days of the month start at 1. +## +## @item +## Days beyond the end of the month go into subsequent months. +## +## @item +## Days before the beginning of the month go to the previous month. +## +## @item +## Days can be fractional. +## @end itemize +## +## @strong{Caution:} this function does not attempt to handle Julian +## calendars so dates before Octave 15, 1582 are wrong by as much +## as eleven days. Also, be aware that only Roman Catholic countries +## adopted the calendar in 1582. It took until 1924 for it to be +## adopted everywhere. See the Wikipedia entry on the Gregorian +## calendar for more details. +## +## @strong{Warning:} leap seconds are ignored. A table of leap seconds +## is available on the Wikipedia entry for leap seconds. +## @seealso{datestr, datevec, now, clock, date} +## @end deftypefn + +## Algorithm: Peter Baum (http://vsg.cape.com/~pbaum/date/date0.htm) +## Author: pkienzle + +function [days, secs] = datenum (year, month = [], day = [], hour = 0, minute = 0, second = 0) + + ## Days until start of month assuming year starts March 1. + persistent monthstart = [306; 337; 0; 31; 61; 92; 122; 153; 184; 214; 245; 275]; + + if (nargin == 0 || nargin > 6 || + (nargin > 2 && (ischar (year) || iscellstr (year)))) + print_usage (); + endif + + if (ischar (year) || iscellstr (year)) + [year, month, day, hour, minute, second] = datevec (year, month); + else + if (nargin == 1) + nc = columns (year); + if (nc > 6 || nc < 3) + error ("datenum: expected date vector containing [YEAR, MONTH, DAY, HOUR, MINUTE, SECOND]"); + endif + if (nc >= 6) second = year(:,6); endif + if (nc >= 5) minute = year(:,5); endif + if (nc >= 4) hour = year(:,4); endif + day = year(:,3); + month = year(:,2); + year = year(:,1); + endif + endif + + month(month<1) = 1; ## For compatibility. Otherwise allow negative months. + + ## Set start of year to March by moving Jan. and Feb. to previous year. + ## Correct for months > 12 by moving to subsequent years. + year += fix ((month-14)/12); + + ## Lookup number of days since start of the current year. + if (numel (month) == 1 || numel (day) == 1) + ## Allow month or day to be scalar while other values may be vectors or + ## matrices. + day += monthstart (mod (month-1,12) + 1) + 60; + if (numel (month) > 1) + day = reshape (day, size (month)); + endif + else + day += reshape (monthstart (mod (month-1,12) + 1), size (day)) + 60; + endif + + ## Add number of days to the start of the current year. Correct + ## for leap year every 4 years except centuries not divisible by 400. + day += 365*year + floor (year/4) - floor (year/100) + floor (year/400); + + ## Add fraction representing current second of the day. + days = day + (hour + (minute + second/60)/60)/24; + + ## Output seconds if asked so that etime can be more accurate + if (isargout (2)) + secs = day*86400 + hour*3600 + minute*60 + second; + endif + +endfunction + + +%!shared part +%! part = 0.514623842592593; +%!assert (datenum (2001,5,19), 730990) +%!assert (datenum ([1417,6,12]), 517712) +%!assert (datenum ([2001,5,19;1417,6,12]), [730990;517712]) +%!assert (datenum (2001,5,19,12,21,3.5), 730990+part, eps) +%!assert (datenum ([1417,6,12,12,21,3.5]), 517712+part, eps) +## Test vector inputs +%!test +%! t = [2001,5,19,12,21,3.5; 1417,6,12,12,21,3.5]; +%! n = [730990; 517712] + part; +%! assert (datenum (t), n, 2*eps); +%! ## Check that vectors can have either orientation +%! t = t'; +%! n = n'; +%! assert (datenum (t(1,:), t(2,:), t(3,:), t(4,:), t(5,:), t(6,:)), n, 2*eps); + +## Test mixed vectors and scalars +%!assert (datenum([2008;2009], 1, 1), [datenum(2008, 1, 1);datenum(2009, 1, 1)]); +%!assert (datenum(2008, [1;2], 1), [datenum(2008, 1, 1);datenum(2008, 2, 1)]); +%!assert (datenum(2008, 1, [1;2]), [datenum(2008, 1, 1);datenum(2008, 1, 2)]); +%!assert (datenum([2008;2009], [1;2], 1), [datenum(2008, 1, 1);datenum(2009, 2, 1)]); +%!assert (datenum([2008;2009], 1, [1;2]), [datenum(2008, 1, 1);datenum(2009, 1, 2)]); +%!assert (datenum(2008, [1;2], [1;2]), [datenum(2008, 1, 1);datenum(2008, 2, 2)]); +## And the other orientation +%!assert (datenum([2008 2009], 1, 1), [datenum(2008, 1, 1) datenum(2009, 1, 1)]); +%!assert (datenum(2008, [1 2], 1), [datenum(2008, 1, 1) datenum(2008, 2, 1)]); +%!assert (datenum(2008, 1, [1 2]), [datenum(2008, 1, 1) datenum(2008, 1, 2)]); +%!assert (datenum([2008 2009], [1 2], 1), [datenum(2008, 1, 1) datenum(2009, 2, 1)]); +%!assert (datenum([2008 2009], 1, [1 2]), [datenum(2008, 1, 1) datenum(2009, 1, 2)]); +%!assert (datenum(2008, [1 2], [1 2]), [datenum(2008, 1, 1) datenum(2008, 2, 2)]); +## Test string and cellstr inputs +%!assert (datenum ("5/19/2001"), 730990) +%!assert (datenum ({"5/19/2001"}), 730990) +%!assert (datenum (char ("5/19/2001", "6/6/1944")), [730990; 710189]) +%!assert (datenum ({"5/19/2001", "6/6/1944"}), [730990; 710189]) + +%% Test input validation +%!error datenum () +%!error datenum (1,2,3,4,5,6,7) +%!error datenum ([1, 2]) +%!error datenum ([1,2,3,4,5,6,7]) diff --git a/octave_packages/m/time/datestr.m b/octave_packages/m/time/datestr.m new file mode 100644 index 0000000..a1eeb1d --- /dev/null +++ b/octave_packages/m/time/datestr.m @@ -0,0 +1,337 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{str} =} datestr (@var{date}) +## @deftypefnx {Function File} {@var{str} =} datestr (@var{date}, @var{f}) +## @deftypefnx {Function File} {@var{str} =} datestr (@var{date}, @var{f}, @var{p}) +## Format the given date/time according to the format @code{f} and return +## the result in @var{str}. @var{date} is a serial date number (see +## @code{datenum}) or a date vector (see @code{datevec}). The value of +## @var{date} may also be a string or cell array of strings. +## +## @var{f} can be an integer which corresponds to one of the codes in +## the table below, or a date format string. +## +## @var{p} is the year at the start of the century in which two-digit years +## are to be interpreted in. If not specified, it defaults to the current +## year minus 50. +## +## For example, the date 730736.65149 (2000-09-07 15:38:09.0934) would be +## formatted as follows: +## +## @multitable @columnfractions 0.1 0.45 0.35 +## @headitem Code @tab Format @tab Example +## @item 0 @tab dd-mmm-yyyy HH:MM:SS @tab 07-Sep-2000 15:38:09 +## @item 1 @tab dd-mmm-yyyy @tab 07-Sep-2000 +## @item 2 @tab mm/dd/yy @tab 09/07/00 +## @item 3 @tab mmm @tab Sep +## @item 4 @tab m @tab S +## @item 5 @tab mm @tab 09 +## @item 6 @tab mm/dd @tab 09/07 +## @item 7 @tab dd @tab 07 +## @item 8 @tab ddd @tab Thu +## @item 9 @tab d @tab T +## @item 10 @tab yyyy @tab 2000 +## @item 11 @tab yy @tab 00 +## @item 12 @tab mmmyy @tab Sep00 +## @item 13 @tab HH:MM:SS @tab 15:38:09 +## @item 14 @tab HH:MM:SS PM @tab 03:38:09 PM +## @item 15 @tab HH:MM @tab 15:38 +## @item 16 @tab HH:MM PM @tab 03:38 PM +## @item 17 @tab QQ-YY @tab Q3-00 +## @item 18 @tab QQ @tab Q3 +## @item 19 @tab dd/mm @tab 13/03 +## @item 20 @tab dd/mm/yy @tab 13/03/95 +## @item 21 @tab mmm.dd.yyyy HH:MM:SS @tab Mar.03.1962 13:53:06 +## @item 22 @tab mmm.dd.yyyy @tab Mar.03.1962 +## @item 23 @tab mm/dd/yyyy @tab 03/13/1962 +## @item 24 @tab dd/mm/yyyy @tab 12/03/1962 +## @item 25 @tab yy/mm/dd @tab 95/03/13 +## @item 26 @tab yyyy/mm/dd @tab 1995/03/13 +## @item 27 @tab QQ-YYYY @tab Q4-2132 +## @item 28 @tab mmmyyyy @tab Mar2047 +## @item 29 @tab yyyymmdd @tab 20470313 +## @item 30 @tab yyyymmddTHHMMSS @tab 20470313T132603 +## @item 31 @tab yyyy-mm-dd HH:MM:SS @tab 1047-03-13 13:26:03 +## @end multitable +## +## If @var{f} is a format string, the following symbols are recognized: +## +## @multitable @columnfractions 0.1 0.7 0.2 +## @headitem Symbol @tab Meaning @tab Example +## @item yyyy @tab Full year @tab 2005 +## @item yy @tab Two-digit year @tab 2005 +## @item mmmm @tab Full month name @tab December +## @item mmm @tab Abbreviated month name @tab Dec +## @item mm @tab Numeric month number (padded with zeros) @tab 01, 08, 12 +## @item m @tab First letter of month name (capitalized) @tab D +## @item dddd @tab Full weekday name @tab Sunday +## @item ddd @tab Abbreviated weekday name @tab Sun +## @item dd @tab Numeric day of month (padded with zeros) @tab 11 +## @item d @tab First letter of weekday name (capitalized) @tab S +## @item HH @tab Hour of day, padded with zeros if PM is set @tab 09:00 +## @item @tab and not padded with zeros otherwise @tab 9:00 AM +## @item MM @tab Minute of hour (padded with zeros) @tab 10:05 +## @item SS @tab Second of minute (padded with zeros) @tab 10:05:03 +## @item FFF @tab Milliseconds of second (padded with zeros) @tab 10:05:03.012 +## @item AM @tab Use 12-hour time format @tab 11:30 AM +## @item PM @tab Use 12-hour time format @tab 11:30 PM +## @end multitable +## +## If @var{f} is not specified or is @code{-1}, then use 0, 1 or 16, +## depending on whether the date portion or the time portion of +## @var{date} is empty. +## +## If @var{p} is nor specified, it defaults to the current year minus 50. +## +## If a matrix or cell array of dates is given, a column vector of date strings +## is returned. +## +## @seealso{datenum, datevec, date, now, clock} +## @end deftypefn + +## FIXME: parse arbitrary code strings. +## e.g., for Wednesday 2001-03-05 09:04:06 AM, use +## yy 01 +## yyyy 2001 +## m M +## mm 03 +## mmm Mar +## d W +## dd 05 +## ddd Wed +## HH 09 +## MM 04 +## SS 06 +## PM AM +## FIXME: Vectorize. It is particularly easy since all the codes are +## fixed width. Just generate the parts in separate arrays and +## concatenate. + +## Author: pkienzle +## Created: 10 October 2001 (CVS) +## Adapted-By: William Poetra Yoga Hadisoeseno + +function retval = datestr (date, f = [], p = []) + + persistent dateform names_mmmm names_m names_d; + + if (isempty (dateform)) + dateform = cell (32, 1); + dateform{1} = "dd-mmm-yyyy HH:MM:SS"; + dateform{2} = "dd-mmm-yyyy"; + dateform{3} = "mm/dd/yy"; + dateform{4} = "mmm"; + dateform{5} = "m"; + dateform{6} = "mm"; + dateform{7} = "mm/dd"; + dateform{8} = "dd"; + dateform{9} = "ddd"; + dateform{10} = "d"; + dateform{11} = "yyyy"; + dateform{12} = "yy"; + dateform{13} = "mmmyy"; + dateform{14} = "HH:MM:SS"; + dateform{15} = "HH:MM:SS PM"; + dateform{16} = "HH:MM"; + dateform{17} = "HH:MM PM"; + dateform{18} = "QQ-YY"; + dateform{19} = "QQ"; + dateform{20} = "dd/mm"; + dateform{21} = "dd/mm/yy"; + dateform{22} = "mmm.dd,yyyy HH:MM:SS"; + dateform{23} = "mmm.dd,yyyy"; + dateform{24} = "mm/dd/yyyy"; + dateform{25} = "dd/mm/yyyy"; + dateform{26} = "yy/mm/dd"; + dateform{27} = "yyyy/mm/dd"; + dateform{28} = "QQ-YYYY"; + dateform{29} = "mmmyyyy"; + dateform{30} = "yyyy-mm-dd"; + dateform{31} = "yyyymmddTHHMMSS"; + dateform{32} = "yyyy-mm-dd HH:MM:SS"; + + names_m = {"J", "F", "M", "A", "M", "J", "J", "A", "S", "O", "N", "D"}; + names_d = {"S", "M", "T", "W", "T", "F", "S"}; + endif + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + ## Guess input type. We might be wrong. + if (ischar (date) || iscellstr (date) || columns (date) != 6) + v = datevec (date, p); + else + v = []; + if (columns (date) == 6) + ## Make sure that the input really is a datevec. + maxdatevec = [Inf, 12, 31, 23, 59, 60]; + if (any (max (date, 1) > maxdatevec) || + any (date(:,1:5) != floor (date(:,1:5)))) + v = datevec (date, p); + endif + endif + if (isempty (v)) + v = date; + endif + endif + + retval = []; + for i = 1 : rows (v) + + if (isempty (f)) + if (v(i,4:6) == 0) + f = 1; + elseif (v(i,1:3) == [-1, 12, 31]) + f = 16; + else + f = 0; + endif + endif + + if (isnumeric (f)) + df = dateform{f + 1}; + else + df = f; + endif + + df_orig = df; + df = strrep (df, 'AM', "%p"); + df = strrep (df, 'PM', "%p"); + if (strcmp (df, df_orig)) + ## PM not set. + df = strrep (df, "HH", "%H"); + else + df = strrep (df, "HH", sprintf ("%2d", v(i,4))); + endif + + df = regexprep (df, '[Yy][Yy][Yy][Yy]', "%Y"); + + df = regexprep (df, '[Yy][Yy]', "%y"); + + df = regexprep (df, '[Dd][Dd][Dd][Dd]', "%A"); + + df = regexprep (df, '[Dd][Dd][Dd]', "%a"); + + df = regexprep (df, '[Dd][Dd]', "%d"); + + wday = weekday (datenum (v(i,1), v(i,2), v(i,3))); + tmp = names_d{wday}; + df = regexprep (df, '([^%])[Dd]', sprintf ("$1%s", tmp)); + df = regexprep (df, '^[Dd]', sprintf ("%s", tmp)); + + df = strrep (df, "mmmm", "%B"); + + df = strrep (df, "mmm", "%b"); + + df = strrep (df, "mm", "%m"); + + tmp = names_m{v(i,2)}; + pos = regexp (df, '[^%]m') + 1; + df(pos) = tmp; + df = regexprep (df, '^m', tmp); + + df = strrep (df, "MM", "%M"); + + df = regexprep (df, '[Ss][Ss]', "%S"); + + df = strrep (df, "FFF", sprintf ("%03d", 1000 * (v(i,6) - fix (v(i,6))))); + + df = strrep (df, 'QQ', sprintf ("Q%d", fix ((v(i,2) + 2) / 3))); + + vi = v(i,:); + tm.year = vi(1) - 1900; + tm.mon = vi(2) - 1; + tm.mday = vi(3); + tm.hour = vi(4); + tm.min = vi(5); + sec = vi(6); + tm.sec = fix (sec); + tm.usec = fix ((sec - tm.sec) * 1e6); + tm.wday = wday - 1; + ## FIXME -- Do we need YDAY and DST? How should they be computed? + ## We don't want to use "localtime (mktime (tm))" because that + ## doesn't correctly handle dates before 1970-01-01 on some systems. + ## tm.yday = ?; + ## tm.isdst = ?; + + str = strftime (df, tm); + + retval = [retval; str]; + + endfor + +endfunction + + +## demos +%!demo +%! ## Current date and time in default format +%! datestr (now ()) +%!demo +%! ## Current date (integer portion of datenum) +%! datestr (fix (now ())) +%!demo +%! ## Current time (fractional portion of datenum) +%! datestr (rem (now (), 1)) + +%!shared testtime +%! testtime = [2005.0000, 12.0000, 18.0000, 2.0000, 33.0000, 17.3822]; +%!assert (datestr (testtime,0), "18-Dec-2005 02:33:17") +%!assert (datestr (testtime,1), "18-Dec-2005") +%!assert (datestr (testtime,2), "12/18/05") +%!assert (datestr (testtime,3), "Dec") +%!assert (datestr (testtime,4), "D") +%!assert (datestr (testtime,5), "12") +%!assert (datestr (testtime,6), "12/18") +%!assert (datestr (testtime,7), "18") +%!assert (datestr (testtime,8), "Sun") +%!assert (datestr (testtime,9), "S") +%!assert (datestr (testtime,10), "2005") +%!assert (datestr (testtime,11), "05") +%!assert (datestr (testtime,12), "Dec05") +%!assert (datestr (testtime,13), "02:33:17") +%!assert (datestr (testtime,14), " 2:33:17 AM") +%!assert (datestr (testtime,15), "02:33") +%!assert (datestr (testtime,16), " 2:33 AM") +%!assert (datestr (testtime,17), "Q4-05") +%!assert (datestr (testtime,18), "Q4") +%!assert (datestr (testtime,19), "18/12") +%!assert (datestr (testtime,20), "18/12/05") +%!assert (datestr (testtime,21), "Dec.18,2005 02:33:17") +%!assert (datestr (testtime,22), "Dec.18,2005") +%!assert (datestr (testtime,23), "12/18/2005") +%!assert (datestr (testtime,24), "18/12/2005") +%!assert (datestr (testtime,25), "05/12/18") +%!assert (datestr (testtime,26), "2005/12/18") +%!assert (datestr (testtime,27), "Q4-2005") +%!assert (datestr (testtime,28), "Dec2005") +%!assert (datestr (testtime,29), "2005-12-18") +%!assert (datestr (testtime,30), "20051218T023317") +%!assert (datestr (testtime,31), "2005-12-18 02:33:17") +%!assert (datestr (testtime+[0 0 3 0 0 0], "dddd"), "Wednesday") +## Test possible bug where input is a vector of datenums that is exactly 6 wide +%!assert (datestr ([1944, 6, 6, 6, 30, 0], 0), "06-Jun-1944 06:30:00") +## Test fractional millisecond time extension +%!assert (datestr (testtime, "HH:MM:SS:FFF"), "02:33:17:382") + +%% Test input validation +%!error datestr () +%!error datestr (1, 2, 3, 4) diff --git a/octave_packages/m/time/datetick.m b/octave_packages/m/time/datetick.m new file mode 100644 index 0000000..e684657 --- /dev/null +++ b/octave_packages/m/time/datetick.m @@ -0,0 +1,305 @@ +## Copyright (C) 2008-2012 David Bateman +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} datetick () +## @deftypefnx {Function File} {} datetick (@var{form}) +## @deftypefnx {Function File} {} datetick (@var{axis}, @var{form}) +## @deftypefnx {Function File} {} datetick (@dots{}, "keeplimits") +## @deftypefnx {Function File} {} datetick (@dots{}, "keepticks") +## @deftypefnx {Function File} {} datetick (@dots{ax}, @dots{}) +## Add date formatted tick labels to an axis. The axis the apply the +## ticks to is determined by @var{axis} that can take the values "x", +## "y" or "z". The default value is "x". The formatting of the labels is +## determined by the variable @var{form}, that can either be a string in +## the format needed by @code{dateform}, or a positive integer that can +## be accepted by @code{datestr}. +## @seealso{datenum, datestr} +## @end deftypefn + +function datetick (varargin) + + [h, varargin, nargin] = __plt_get_axis_arg__ ("datetick", varargin{:}); + + oldh = gca (); + unwind_protect + axes (h); + __datetick__ (varargin{:}); + unwind_protect_cleanup + axes (oldh); + end_unwind_protect + +endfunction + +%!demo +%! yr = 1900:10:2000; +%! pop = [76.094, 92.407, 106.461, 123.077 131.954, 151.868, 179.979, ... +%! 203.984, 227.225, 249.623, 282.224]; +%! plot (datenum (yr, 1, 1), pop); +%! title ("US population (millions)"); +%! xlabel ("Year"); +%! datetick ("x", "YYYY"); + +%!demo +%! yr =1988:2:2002; +%! yr =datenum(yr,1,1); +%! pr = [12.1 13.3 12.6 13.1 13.3 14.1 14.4 15.2]; +%! plot(yr,pr); +%! xlabel('year') +%! ylabel('average price') +%! ax=gca; +%! set(ax,'xtick',datenum(1990:5:2005,1,1)) +%! datetick(2,'keepticks') +%! set(ax,'ytick',12:16) + +## Remove from test statistics. No real tests possible. +%!assert (1) + +function __datetick__ (varargin) + + keeplimits = false; + keepticks = false; + idx = []; + for i = 1 : nargin + arg = varargin {i}; + if (ischar (arg)) + if (strcmpi (arg, "keeplimits")) + keeplimits = true; + idx = [idx, i]; + elseif (strcmpi (arg, "keepticks")) + keepticks = true; + idx = [idx, i]; + endif + endif + endfor + + varargin(idx) = []; + nargin = length (varargin); + form = []; + ax = "x"; + + if (nargin != 0) + arg = varargin{1}; + if (ischar (arg) && (strcmp (arg, "x") || strcmp (arg, "y") + || strcmp (arg, "z"))) + ax = arg; + if (nargin > 1) + form = varargin{2}; + varargin(1:2) = []; + else + varargin(1) = []; + endif + else + form = arg; + varargin(1) = []; + endif + endif + + ## Don't publish the existence of this variable for use with dateaxis + if (length (varargin) > 0) + startdate = varargin{1}; + else + startdate = []; + endif + + if (! isempty (form)) + if (isnumeric (form)) + if (! isscalar (form) || floor (form) != form || form < 0) + error ("datetick: expecting FORM argument to be a positive integer"); + endif + elseif (! ischar (form)) + error ("datetick: expecting valid date format string"); + endif + endif + + if (keepticks) + ticks = get (gca (), strcat (ax, "tick")); + else + ## Need to do our own axis tick position calculation as + ## year, etc, don't fallback on nice datenum values. + objs = findall (gca()); + xmax = NaN; + xmin = NaN; + for i = 1 : length (objs) + fld = get (objs (i)); + if (isfield (fld, strcat (ax, "data"))) + xdata = getfield (fld, strcat (ax, "data"))(:); + xmin = min (xmin, min (xdata)); + xmax = max (xmax, max (xdata)); + endif + endfor + + if (isnan (xmin) || isnan (xmax)) + xmin = 0; + xmax = 1; + elseif (xmin == xmax) + xmax = xmin + 1; + endif + + N = 3; + if (xmax - xmin < N) + ## Day scale or less + if (xmax - xmin < N / 24 / 60 / 60) + scl = 1 / 24 / 60 / 60; + elseif (xmax - xmin < N / 24 / 6) + scl = 1 / 24 / 60; + else + scl = 1 / 24; + endif + sep = __calc_tick_sep__ (xmin / scl , xmax / scl); + xmin = sep * floor (xmin / scl / sep); + xmax = sep * ceil (xmax / scl / sep); + nticks = (xmax - xmin) / sep + 1; + xmin *= scl; + xmax *= scl; + else + [ymin, mmin, dmin] = datevec (xmin); + [ymax, mmax, dmax] = datevec (xmax); + minyear = ymin + (mmin - 1) / 12 + (dmin - 1) / 12 / 30; + maxyear = ymax + (mmax - 1) / 12 + (dmax - 1) / 12 / 30; + minmonth = mmin + (dmin - 1) / 30; + maxmonth = (ymax - ymin) * 12 + mmax + (dmax - 1) / 30; + + if (maxmonth - minmonth < N) + sep = __calc_tick_sep__ (xmin, xmax); + xmin = sep * floor (xmin / sep); + xmax = sep * ceil (xmax / sep); + nticks = (xmax - xmin) / sep + 1; + elseif (maxyear - minyear < N) + sep = __calc_tick_sep__ (minmonth , maxmonth); + xmin = datenum (ymin, sep * floor (minmonth / sep), 1); + xmax = datenum (ymin, sep * ceil (maxmonth / sep), 1); + nticks = ceil (maxmonth / sep) - floor (minmonth / sep) + 1; + else + sep = __calc_tick_sep__ (minyear , maxyear); + xmin = datenum (sep * floor (minyear / sep), 1, 1); + xmax = datenum (sep * ceil (maxyear / sep), 1, 1); + nticks = ceil (maxyear / sep) - floor (minyear / sep) + 1; + endif + endif + ticks = xmin + [0 : nticks - 1] / (nticks - 1) * (xmax - xmin); + endif + + if (isempty (form)) + r = max(ticks) - min(ticks); + if r < 10/60/24 + ## minutes and seconds + form = 13; + elseif r < 2 + ## hours + form = 15; + elseif r < 15 + ## days + form = 8; + elseif r < 365 + ## FIXME -- FORM should be 19 for European users who use dd/mm + ## instead of mm/dd. How can that be determined automatically? + ## months + form = 6; + elseif r < 90*12 + ## quarters + form = 27; + else + ## years + form = 10; + endif + endif + + if (length (ticks) == 6) + ## Careful that its not treated as a datevec + if (! isempty (startdate)) + sticks = strvcat (datestr (ticks(1:end-1) - ticks(1) + startdate, form), + datestr (ticks(end) - ticks(1) + startdate, form)); + else + sticks = strvcat (datestr (ticks(1:end-1), form), + datestr (ticks(end), form)); + endif + else + if (! isempty (startdate)) + sticks = datestr (ticks - ticks(1) + startdate, form); + else + sticks = datestr (ticks, form); + endif + endif + + sticks = mat2cell (sticks, ones (rows (sticks), 1), columns (sticks)); + + if (keepticks) + if (keeplimits) + set (gca(), strcat (ax, "ticklabel"), sticks); + else + set (gca(), strcat (ax, "ticklabel"), sticks, strcat (ax, "lim"), + [min(ticks), max(ticks)]); + endif + else + if (keeplimits) + set (gca(), strcat (ax, "tick"), ticks, strcat (ax, "ticklabel"), sticks); + else + set (gca(), strcat (ax, "tick"), ticks, strcat (ax, "ticklabel"), sticks, + strcat (ax, "lim"), [min(ticks), max(ticks)]); + endif + endif +endfunction + +function [a, b] = __magform__ (x) + if (x == 0) + a = 0; + b = 0; + else + l = log10 (abs (x)); + r = fmod (l, 1); + a = 10 .^ r; + b = fix (l - r); + if (a < 1) + a *= 10; + b -= 1; + endif + if (x < 0) + a = -a; + endif + endif +endfunction + +## A translation from Tom Holoryd's python code at +## http://kurage.nimh.nih.gov/tomh/tics.py +function sep = __calc_tick_sep__ (lo, hi) + persistent sqrt_2 = sqrt (2.0); + persistent sqrt_10 = sqrt (10.0); + persistent sqrt_50 = sqrt (50.0); + + ticint = 5; + + ## Reference: Lewart, C. R., "Algorithms SCALE1, SCALE2, and + ## SCALE3 for Determination of Scales on Computer Generated + ## Plots", Communications of the ACM, 10 (1973), 639-640. + ## Also cited as ACM Algorithm 463. + + [a, b] = __magform__ ((hi - lo) / ticint); + + if (a < sqrt_2) + x = 1; + elseif (a < sqrt_10) + x = 2; + elseif (a < sqrt_50) + x = 5; + else + x = 10; + endif + sep = x * 10 .^ b; +endfunction + diff --git a/octave_packages/m/time/datevec.m b/octave_packages/m/time/datevec.m new file mode 100644 index 0000000..3f46614 --- /dev/null +++ b/octave_packages/m/time/datevec.m @@ -0,0 +1,304 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{v} =} datevec (@var{date}) +## @deftypefnx {Function File} {@var{v} =} datevec (@var{date}, @var{f}) +## @deftypefnx {Function File} {@var{v} =} datevec (@var{date}, @var{p}) +## @deftypefnx {Function File} {@var{v} =} datevec (@var{date}, @var{f}, @var{p}) +## @deftypefnx {Function File} {[@var{y}, @var{m}, @var{d}, @var{h}, @var{mi}, @var{s}] =} datevec (@dots{}) +## Convert a serial date number (see @code{datenum}) or date string (see +## @code{datestr}) into a date vector. +## +## A date vector is a row vector with six members, representing the year, +## month, day, hour, minute, and seconds respectively. +## +## @var{f} is the format string used to interpret date strings +## (see @code{datestr}). +## +## @var{p} is the year at the start of the century to which two-digit years +## will be referenced. If not specified, it defaults to the current year +## minus 50. +## @seealso{datenum, datestr, clock, now, date} +## @end deftypefn + +## Algorithm: Peter Baum (http://vsg.cape.com/~pbaum/date/date0.htm) + +## Author: pkienzle +## Modified: bdenney +## Created: 10 October 2001 (CVS) +## Adapted-By: William Poetra Yoga Hadisoeseno + +## The function __date_str2vec__ is based on datesplit by Bill Denney. + +function [y, m, d, h, mi, s] = datevec (date, f = [], p = []) + + persistent std_formats nfmt; + + if (isempty (std_formats)) + std_formats = cell (); + nfmt = 0; + ## These formats are specified by Matlab to be parsed + ## The '# XX' refers to the datestr numerical format code + std_formats{++nfmt} = "dd-mmm-yyyy HH:MM:SS"; # 0 + std_formats{++nfmt} = "dd-mmm-yyyy"; # 1 + std_formats{++nfmt} = "mm/dd/yy"; # 2 + std_formats{++nfmt} = "mm/dd"; # 6 + std_formats{++nfmt} = "HH:MM:SS"; # 13 + std_formats{++nfmt} = "HH:MM:SS PM"; # 14 + std_formats{++nfmt} = "HH:MM"; # 15 + std_formats{++nfmt} = "HH:MM PM"; # 16 + std_formats{++nfmt} = "mm/dd/yyyy"; # 23 + + ## These are other formats that Octave tries + std_formats{++nfmt} = "mmm-dd-yyyy HH:MM:SS"; + std_formats{++nfmt} = "mmm-dd-yyyy"; + std_formats{++nfmt} = "dd mmm yyyy HH:MM:SS"; + std_formats{++nfmt} = "dd mmm yyyy"; + std_formats{++nfmt} = "mmm dd yyyy HH:MM:SS"; + std_formats{++nfmt} = "mmm dd yyyy"; + std_formats{++nfmt} = "dd.mmm.yyyy HH:MM:SS"; + std_formats{++nfmt} = "dd.mmm.yyyy"; + std_formats{++nfmt} = "mmm.dd.yyyy HH:MM:SS"; + std_formats{++nfmt} = "mmm.dd.yyyy"; + std_formats{++nfmt} = "mmmyy"; # 12 + std_formats{++nfmt} = "mm/dd/yyyy HH:MM"; + endif + + if (nargin < 1 || nargin > 3) + print_usage (); + endif + + if (ischar (date)) + date = cellstr (date); + endif + + if (isnumeric (f)) + p = f; + f = []; + endif + + if (isempty (f)) + f = -1; + endif + + if (isempty (p)) + p = (localtime (time ())).year + 1900 - 50; + endif + + if (iscell (date)) + + nd = numel (date); + + y = m = d = h = mi = s = zeros (nd, 1); + + if (f == -1) + for k = 1:nd + found = false; + for l = 1:nfmt + [f, rY, ry, fy, fm, fd, fh, fmi, fs] = __date_vfmt2sfmt__ (std_formats{l}); + [found y(k) m(k) d(k) h(k) mi(k) s(k)] = __date_str2vec__ (date{k}, p, f, rY, ry, fy, fm, fd, fh, fmi, fs); + if (found) + break; + endif + endfor + if (! found) + error ("datevec: none of the standard formats match the DATE string"); + endif + endfor + else + ## Decipher the format string just once for speed. + [f, rY, ry, fy, fm, fd, fh, fmi, fs] = __date_vfmt2sfmt__ (f); + for k = 1:nd + [found y(k) m(k) d(k) h(k) mi(k) s(k)] = __date_str2vec__ (date{k}, p, f, rY, ry, fy, fm, fd, fh, fmi, fs); + if (! found) + error ("datevec: DATE not parsed correctly with given format"); + endif + endfor + endif + + else # datenum input + + date = date(:); + + ## Move day 0 from midnight -0001-12-31 to midnight 0000-3-1 + z = floor (date) - 60; + ## Calculate number of centuries; K1 = 0.25 is to avoid rounding problems. + a = floor ((z - 0.25) / 36524.25); + ## Days within century; K2 = 0.25 is to avoid rounding problems. + b = z - 0.25 + a - floor (a / 4); + ## Calculate the year (year starts on March 1). + y = floor (b / 365.25); + ## Calculate day in year. + c = fix (b - floor (365.25 * y)) + 1; + ## Calculate month in year. + m = fix ((5 * c + 456) / 153); + d = c - fix ((153 * m - 457) / 5); + ## Move to Jan 1 as start of year. + ++y(m > 12); + m(m > 12) -= 12; + + ## Convert hour-minute-seconds. Attempt to account for precision of + ## datenum format. + + fracd = date - floor (date); + tmps = abs (eps*86400*date); + tmps(tmps == 0) = 1; + srnd = 2 .^ floor (- log2 (tmps)); + s = round (86400 * fracd .* srnd) ./ srnd; + h = floor (s / 3600); + s = s - 3600 * h; + mi = floor (s / 60); + s = s - 60 * mi; + + endif + + if (nargout <= 1) + y = [y, m, d, h, mi, s]; + endif + +endfunction + +function [f, rY, ry, fy, fm, fd, fh, fmi, fs] = __date_vfmt2sfmt__ (f) + + ## Play safe with percent signs. + f = strrep (f, "%", "%%"); + + if (! isempty (strfind (f, "PM")) || ! isempty (strfind (f, "AM"))) + ampm = true; + else + ampm = false; + endif + + ## Date part. + f = regexprep (f, '[Yy][Yy][Yy][Yy]', "%Y"); + f = regexprep (f, '[Yy][Yy]', "%y"); + f = strrep (f, "mmmm", "%B"); + f = strrep (f, "mmm", "%b"); + f = strrep (f, "mm", "%m"); + f = regexprep (f, '[Dd][Dd][Dd][Dd]', "%A"); + f = regexprep (f, '[Dd][Dd][Dd]', "%a"); + f = regexprep (f, '[Dd][Dd]', "%d"); + + ## Time part. + if (ampm) + f = strrep (f, "HH", "%I"); + f = strrep (f, "PM", "%p"); + f = strrep (f, "AM", "%p"); + else + f = strrep (f, "HH", "%H"); + endif + f = strrep (f, "MM", "%M"); + f = regexprep (f, '[Ss][Ss]', "%S"); + + rY = rindex (f, "%Y"); + ry = rindex (f, "%y"); + + ## Check whether we need to give default values. + ## Possible error when string contains "%%". + fy = rY || ry; + fm = index (f, "%m") || index (f, "%b") || index (f, "%B"); + fd = index (f, "%d") || index (f, "%a") || index (f, "%A"); + fh = index (f, "%H") || index (f, "%I"); + fmi = index (f, "%M"); + fs = index (f, "%S"); + +endfunction + +function [found, y, m, d, h, mi, s] = __date_str2vec__ (ds, p, f, rY, ry, fy, fm, fd, fh, fmi, fs) + + idx = strfind (f, "FFF"); + if (! isempty (idx)) + ## Kludge to handle FFF millisecond format since strptime does not + f(idx:idx+2) = []; + [~, nc] = strptime (ds, f); + if (nc > 0) + msec = ds(nc:min(nc+2, end)); + f = [f(1:idx-1) msec f(idx:end)]; + [tm, nc] = strptime (ds, f); + tm.usec = 1000 * str2double (msec); + endif + else + [tm, nc] = strptime (ds, f); + endif + + if (nc == columns (ds) + 1) + found = true; + y = tm.year + 1900; m = tm.mon + 1; d = tm.mday; + h = tm.hour; mi = tm.min; s = tm.sec + tm.usec / 1e6; + if (rY < ry) + if (y > 1999) + y -= 2000; + else + y -= 1900; + endif + y += p - mod (p, 100); + if (y < p) + y += 100; + endif + endif + if (! fy && ! fm && ! fd) + tmp = localtime (time ()); + y = tmp.year + 1900; + m = tmp.mon + 1; + d = tmp.mday; + elseif (! fy && fm && fd) + tmp = localtime (time ()); + y = tmp.year + 1900; + elseif (fy && fm && ! fd) + d = 1; + endif + if (! fh && ! fmi && ! fs) + h = mi = s = 0; + elseif (fh && fmi && ! fs) + s = 0; + endif + else + y = m = d = h = mi = s = 0; + found = false; + endif + +endfunction + + +%!demo +%! ## Current date and time +%! datevec (now ()) + +%!shared nowvec +%! nowvec = datevec (now); # Some tests could fail around midnight! +%!# tests for standard formats: 0, 1, 2, 6, 13, 14, 15, 16, 23 +%!assert (datevec ("07-Sep-2000 15:38:09"), [2000,9,7,15,38,9]) +%!assert (datevec ("07-Sep-2000"), [2000,9,7,0,0,0]) +%!assert (datevec ("09/07/00"), [2000,9,7,0,0,0]) +%!assert (datevec ("09/13"), [nowvec(1),9,13,0,0,0]) +%!assert (datevec ("15:38:09"), [nowvec(1:3),15,38,9]) +%!assert (datevec ("3:38:09 PM"), [nowvec(1:3),15,38,9]) +%!assert (datevec ("15:38"), [nowvec(1:3),15,38,0]) +%!assert (datevec ("03:38 PM"), [nowvec(1:3),15,38,0]) +%!assert (datevec ("03/13/1962"), [1962,3,13,0,0,0]) + +%% Test millisecond format FFF +%!assert (datevec ("15:38:21.25", "HH:MM:SS.FFF"), [nowvec(1:3),15,38,21.025]) + +# Other tests +%!assert (datenum (datevec ([-1e4:1e4])), [-1e4:1e4]') +%!test +%! t = linspace (-2e5, 2e5, 10993); +%! assert (all (abs (datenum (datevec (t)) - t') < 1e-5)); + diff --git a/octave_packages/m/time/eomday.m b/octave_packages/m/time/eomday.m new file mode 100644 index 0000000..7611cb5 --- /dev/null +++ b/octave_packages/m/time/eomday.m @@ -0,0 +1,65 @@ +## Copyright (C) 2004-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {@var{e} =} eomday (@var{y}, @var{m}) +## Return the last day of the month @var{m} for the year @var{y}. +## @seealso{weekday, datenum, datevec, is_leap_year, calendar} +## @end deftypefn + +## Author: pkienzle +## Created: 25 July 2004 +## Adapted-By: William Poetra Yoga Hadisoeseno + +function e = eomday (y, m) + + if (nargin != 2) + print_usage (); + endif + + eom = [31, 28, 31, 30 ,31, 30, 31, 31, 30, 31, 30, 31]; + e = reshape (eom(m), size (m)); + e += (m == 2) & (mod (y, 4) == 0 & (mod (y, 100) != 0 | mod (y, 400) == 0)); + +endfunction + + +%!demo +%! ## Find leap years in the 20th century +%! y = 1900:1999; +%! e = eomday (y, repmat (2, [1, 100])); +%! y(find (e == 29)) + +# tests +%!assert (eomday ([-4:4],2), [29,28,28,28,29,28,28,28,29]) +%!assert (eomday ([-901,901],2), [28,28]) +%!assert (eomday ([-100,100],2), [28,28]) +%!assert (eomday ([-900,900],2), [28,28]) +%!assert (eomday ([-400,400],2), [29,29]) +%!assert (eomday ([-800,800],2), [29,29]) +%!assert (eomday (2001,1:12), [31,28,31,30,31,30,31,31,30,31,30,31]) +%!assert (eomday (1:3,1:3), [31,28,31]) +%!assert (eomday (1:2000,2)', datevec(datenum(1:2000,3,0))(:,3)) +%!assert ([1900:1999](find(eomday(1900:1999,2*ones(1,100))==29)), [1904,1908,1912,1916,1920,1924,1928,1932,1936,1940,1944,1948,1952,1956,1960,1964,1968,1972,1976,1980,1984,1988,1992,1996]) +%!assert (eomday ([2004;2005], [2;2]), [29;28]) + +%% Test input validation +%!error eomday () +%!error eomday (1) +%!error eomday (1,2,3) + diff --git a/octave_packages/m/time/etime.m b/octave_packages/m/time/etime.m new file mode 100644 index 0000000..e131fcd --- /dev/null +++ b/octave_packages/m/time/etime.m @@ -0,0 +1,79 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} etime (@var{t2}, @var{t1}) +## Return the difference in seconds between two time values returned from +## @code{clock} (@math{@var{t2} - @var{t1}}). For example: +## +## @example +## @group +## t0 = clock (); +## # many computations later@dots{} +## elapsed_time = etime (clock (), t0); +## @end group +## @end example +## +## @noindent +## will set the variable @code{elapsed_time} to the number of seconds since +## the variable @code{t0} was set. +## @seealso{tic, toc, clock, cputime, addtodate} +## @end deftypefn + +## Author: jwe + +function secs = etime (t2, t1) + + if (nargin != 2) + print_usage (); + endif + + [~, s2] = datenum (t2); + [~, s1] = datenum (t1); + + secs = s2 - s1; + +endfunction + + +%!assert (etime ([1900,12,31,23,59,59],[1901,1,1,0,0,0]),-1) +%!assert (etime ([1900,2,28,23,59,59],[1900,3,1,0,0,0]),-1) +%!assert (etime ([2000,2,28,23,59,59],[2000,3,1,0,0,0]),-86401) +%!assert (etime ([1996,2,28,23,59,59],[1996,3,1,0,0,0]),-86401) +%!test +%! t1 = [1900,12,31,23,59,59; 1900,2,28,23,59,59]; +%! t2 = [1901,1,1,0,0,0; 1900,3,1,0,0,0]; +%! assert(etime(t2, t1), [1;1]); + +%!test +%! t1 = [1993, 8, 20, 4, 56, 1]; +%! t2 = [1993, 8, 21, 4, 56, 1]; +%! t3 = [1993, 8, 20, 5, 56, 1]; +%! t4 = [1993, 8, 20, 4, 57, 1]; +%! t5 = [1993, 8, 20, 4, 56, 14]; +%! +%! assert (etime (t2, t1), 86400); +%! assert (etime (t3, t1), 3600); +%! assert (etime (t4, t1), 60); +%! assert (etime (t5, t1), 13); + +%% Test input validation +%!error etime (); +%!error etime (1); +%!error etime (1, 2, 3); + diff --git a/octave_packages/m/time/is_leap_year.m b/octave_packages/m/time/is_leap_year.m new file mode 100644 index 0000000..1fbddd6 --- /dev/null +++ b/octave_packages/m/time/is_leap_year.m @@ -0,0 +1,60 @@ +## Copyright (C) 1996-2012 John W. Eaton +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {} is_leap_year () +## @deftypefnx {Function File} {} is_leap_year (@var{year}) +## Return true if @var{year} is a leap year and false otherwise. If no +## year is specified, @code{is_leap_year} uses the current year. +## For example: +## +## @example +## @group +## is_leap_year (2000) +## @result{} 1 +## @end group +## @end example +## @seealso{weekday, eomday, calendar} +## @end deftypefn + +## Author: jwe + +function retval = is_leap_year (year) + + if (nargin > 1) + print_usage (); + endif + + if (nargin == 0) + t = clock (); + year = t(1); + endif + + retval = (rem (year, 4) == 0 & rem (year, 100) != 0) | (rem (year, 400) == 0); + +endfunction + + +%!assert (is_leap_year (2000), true) +%!assert (is_leap_year (1976), true) +%!assert (is_leap_year (1000), false) +%!assert (is_leap_year (1800), false) +%!assert (is_leap_year (1600), true) + +%!error is_leap_year (1, 2); + diff --git a/octave_packages/m/time/now.m b/octave_packages/m/time/now.m new file mode 100644 index 0000000..84ab028 --- /dev/null +++ b/octave_packages/m/time/now.m @@ -0,0 +1,61 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {t =} now () +## Return the current local date/time as a serial day number +## (see @code{datenum}). +## +## The integral part, @code{floor (now)} corresponds to the number of days +## between today and Jan 1, 0000. +## +## The fractional part, @code{rem (now, 1)} corresponds to the current +## time. +## @seealso{clock, date, datenum} +## @end deftypefn + +## Author: pkienzle +## Created: 10 October 2001 (CVS) +## Adapted-By: William Poetra Yoga Hadisoeseno + +function t = now () + + if (nargin != 0) + print_usage (); + endif + + t = datenum (clock ()); + + ## The following doesn't work (e.g., one hour off on 2005-10-04): + ## + ## seconds since 1970-1-1 corrected by seconds from GMT to local time + ## divided by 86400 sec/day plus day num for 1970-1-1 + ## t = (time - mktime(gmtime(0)))/86400 + 719529; + ## + ## mktime(gmtime(0)) does indeed return the offset from Greenwich to the + ## local time zone, but we need to account for daylight savings time + ## changing by an hour the offset from CUT for part of the year. + +endfunction + + +%!assert (isnumeric (now ())); +%!assert (now () > 0); +%!assert (now () <= now ()); + +%!error now (1); diff --git a/octave_packages/m/time/weekday.m b/octave_packages/m/time/weekday.m new file mode 100644 index 0000000..cc1eae0 --- /dev/null +++ b/octave_packages/m/time/weekday.m @@ -0,0 +1,124 @@ +## Copyright (C) 2000-2012 Paul Kienzle +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave is distributed in the hope that it will be useful, but +## WITHOUT ANY WARRANTY; without even the implied warranty of +## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +## General Public License for more details. +## +## You should have received a copy of the GNU General Public License +## along with Octave; see the file COPYING. If not, see +## . + +## -*- texinfo -*- +## @deftypefn {Function File} {[@var{n}, @var{s}] =} weekday (@var{d}) +## @deftypefnx {Function File} {[@var{n}, @var{s}] =} weekday (@var{d}, @var{format}) +## Return the day of the week as a number in @var{n} and as a string in @var{s}. +## The days of the week are numbered 1--7 with the first day being Sunday. +## +## @var{d} is a serial date number or a date string. +## +## If the string @var{format} is not present or is equal to "short" then +## @var{s} will contain the abbreviated name of the weekday. If @var{format} +## is "long" then @var{s} will contain the full name. +## +## Table of return values based on @var{format}: +## +## @multitable @columnfractions .06 .13 .16 +## @headitem @var{n} @tab "short" @tab "long" +## @item 1 @tab Sun @tab Sunday +## @item 2 @tab Mon @tab Monday +## @item 3 @tab Tue @tab Tuesday +## @item 4 @tab Wed @tab Wednesday +## @item 5 @tab Thu @tab Thursday +## @item 6 @tab Fri @tab Friday +## @item 7 @tab Sat @tab Saturday +## @end multitable +## +## @seealso{eomday, is_leap_year, calendar, datenum, datevec} +## @end deftypefn + +## Author: pkienzle +## Created: 10 October 2001 (CVS) +## Adapted-By: William Poetra Yoga Hadisoeseno + +function [d, s] = weekday (d, format = "short") + + if (nargin < 1 || nargin > 2) + print_usage (); + endif + + if (iscellstr (d) || isnumeric (d)) + endsize = size (d); + elseif (ischar (d)) + endsize = [rows(d), 1]; + endif + if (ischar (d) || iscellstr (d)) + ## Make sure the date is numeric + d = datenum (d); + endif + ## Find the offset from a known Sunday (2008-Jan-6), mod 7. + d = floor (reshape (mod (d - 733048, 7), endsize)); + ## Make Saturdays a 7 and not a 0. + d(!d) = 7; + + if (isargout (2)) + if (strcmpi (format, "long")) + names = {"Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" ... + "Friday" "Saturday"}; + else + names = {"Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat"}; + endif + s = strvcat (names(d)); + endif + +endfunction + + +%!demo +%! ## Current weekday +%! [n, s] = weekday (now ()) +%!demo +%! ## Weekday from datenum input +%! [n, s] = weekday (728647) +%!demo +%! ## Weekday of new millennium from datestr input +%! [n, s] = weekday ('1-Jan-2000') + +# tests +%!assert (weekday (728647), 2) +## Test vector inputs for both directions +%!assert (weekday ([728647 728648]), [2 3]) +%!assert (weekday ([728647;728648]), [2;3]) +## Test a full week before our reference day +%!assert (weekday ("19-Dec-1994"), 2) +%!assert (weekday ("20-Dec-1994"), 3) +%!assert (weekday ("21-Dec-1994"), 4) +%!assert (weekday ("22-Dec-1994"), 5) +%!assert (weekday ("23-Dec-1994"), 6) +%!assert (weekday ("24-Dec-1994"), 7) +%!assert (weekday ("25-Dec-1994"), 1) +## Test our reference day +%!assert (weekday ("6-Jan-2008"), 1) +## Test a full week after our reference day +%!assert (weekday ("1-Feb-2008"), 6) +%!assert (weekday ("2-Feb-2008"), 7) +%!assert (weekday ("3-Feb-2008"), 1) +%!assert (weekday ("4-Feb-2008"), 2) +%!assert (weekday ("5-Feb-2008"), 3) +%!assert (weekday ("6-Feb-2008"), 4) +%!assert (weekday ("7-Feb-2008"), 5) +## Test fractional dates +%!assert (weekday (728647.1), 2) +## Test "long" option +%!test +%! [n, s] = weekday ("25-Dec-1994", "long"); +%! assert (n, 1); +%! assert (s, "Sunday"); + -- 2.44.0